{-# 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)