Rules non-exhaustive pattern match

{-# OPTIONS_GHC -Wall #-}

import Data.List (find)

newtype UserAgent = UserAgent String deriving (Show, Eq, Ord)

newtype AcceptLanguage = AcceptLanguage String deriving (Show, Eq, Ord)

newtype Country = Country String deriving (Show, Eq, Ord)

data Rule = UserAgentRule UserAgent | AcceptLanguageRule AcceptLanguage | CountryAndUserAgentRule Country UserAgent

deriving (Show, Eq, Ord)

rules :: [Rule]

rules = [

UserAgentRule (UserAgent "firefox")

, UserAgentRule (UserAgent "Android 4.2.2; GT-I9505")

, CountryAndUserAgentRule (Country "qa") (UserAgent "Android 6.0.1; SM-G900F")

]

data Visitor = Visitor Country UserAgent AcceptLanguage

deriving (Show, Eq, Ord)

isAMatch :: Visitor -> Rule -> Bool

isAMatch (Visitor vCountry vUserAgent vAcceptLanguage) rule = case rule of

UserAgentRule rUserAgent -> vUserAgent == rUserAgent

-- AcceptLanguageRule rAcceptLanguage -> vAcceptLanguage == rAcceptLanguage

CountryAndUserAgentRule rCountry rUserAgent -> vCountry == rCountry && vUserAgent == rUserAgent

findRule :: Visitor -> Maybe Rule

findRule visitor = find (isAMatch visitor) rules

main :: IO ()

main = do

let visitor1 = Visitor (Country "qa") (UserAgent "Android 6.0.1; SM-G900F") (AcceptLanguage "en")

print (findRule visitor1)

let visitor2 = Visitor (Country "aa") (UserAgent "Android 6.0.1; SM-AAAA") (AcceptLanguage "en")

print (findRule visitor2)