{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE TemplateHaskell           #-}

module Web.UAParser
    ( -- * Parsing browser (user agent)
      parseUA
    , parseUALenient
    , UAResult (..)
    , uarVersion

      -- * Parsing OS
    , parseOS
    , parseOSLenient
    , OSResult (..)
    , osrVersion

      -- * Parsing Dev
    , parseDev
    , parseDevLenient
    , DevResult (..)
    ) where

-------------------------------------------------------------------------------
import           Control.Applicative
import           Control.Monad
import           Data.Aeson
import           Data.ByteString.Char8 (ByteString)
import           Data.Data
import           Data.Default
import           Data.FileEmbed
import           Data.Maybe
import           Data.Monoid           as M
import           Data.Text             (Text)
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import           Data.Yaml
import           GHC.Generics
import           Text.Regex.PCRE.Light
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- UA Parser
-------------------------------------------------------------------------------
uaConfig :: UAConfig
uaConfig :: UAConfig
uaConfig = (ParseException -> UAConfig)
-> (UAConfig -> UAConfig)
-> Either ParseException UAConfig
-> UAConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> UAConfig
forall a. HasCallStack => [Char] -> a
error ([Char] -> UAConfig)
-> (ParseException -> [Char]) -> ParseException -> UAConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> [Char]
forall a. Show a => a -> [Char]
show) UAConfig -> UAConfig
forall a. a -> a
id (Either ParseException UAConfig -> UAConfig)
-> Either ParseException UAConfig -> UAConfig
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseException UAConfig
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' $(embedFile "deps/uap-core/regexes.yaml")
{-# NOINLINE uaConfig #-}


-------------------------------------------------------------------------------
-- | Parser that, upon failure to match a pattern returns a result of
-- family "Other" with all other fields blank. This is mainly for
-- compatibility with the uap-core test suite
parseUALenient :: ByteString -> UAResult
parseUALenient :: ByteString -> UAResult
parseUALenient = UAResult -> Maybe UAResult -> UAResult
forall a. a -> Maybe a -> a
fromMaybe UAResult
forall a. Default a => a
def (Maybe UAResult -> UAResult)
-> (ByteString -> Maybe UAResult) -> ByteString -> UAResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UAResult
parseUA


-------------------------------------------------------------------------------
-- | Parse a given User-Agent string
parseUA :: ByteString -> Maybe UAResult
parseUA :: ByteString -> Maybe UAResult
parseUA ByteString
bs = [Maybe UAResult] -> Maybe UAResult
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe UAResult] -> Maybe UAResult)
-> [Maybe UAResult] -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ (UAParser -> Maybe UAResult) -> [UAParser] -> [Maybe UAResult]
forall a b. (a -> b) -> [a] -> [b]
map UAParser -> Maybe UAResult
go [UAParser]
uaParsers
    where
      UAConfig{[DevParser]
[OSParser]
[UAParser]
devParsers :: UAConfig -> [DevParser]
osParsers :: UAConfig -> [OSParser]
uaParsers :: UAConfig -> [UAParser]
devParsers :: [DevParser]
osParsers :: [OSParser]
uaParsers :: [UAParser]
..} = UAConfig
uaConfig

      go :: UAParser -> Maybe UAResult
go UAParser{Maybe Text
Regex
uaV3Rep :: UAParser -> Maybe Text
uaV2Rep :: UAParser -> Maybe Text
uaV1Rep :: UAParser -> Maybe Text
uaFamRep :: UAParser -> Maybe Text
uaRegex :: UAParser -> Regex
uaV3Rep :: Maybe Text
uaV2Rep :: Maybe Text
uaV1Rep :: Maybe Text
uaFamRep :: Maybe Text
uaRegex :: Regex
..} = (UnicodeException -> Maybe UAResult)
-> ([Text] -> Maybe UAResult)
-> Either UnicodeException [Text]
-> Maybe UAResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe UAResult -> UnicodeException -> Maybe UAResult
forall a b. a -> b -> a
const Maybe UAResult
forall a. Maybe a
Nothing) ((UAResult -> UAResult) -> Maybe UAResult -> Maybe UAResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UAResult -> UAResult
normalize (Maybe UAResult -> Maybe UAResult)
-> ([Text] -> Maybe UAResult) -> [Text] -> Maybe UAResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe UAResult
mkRes)
                      (Either UnicodeException [Text] -> Maybe UAResult)
-> ([ByteString] -> Either UnicodeException [Text])
-> [ByteString]
-> Maybe UAResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either UnicodeException Text)
-> [ByteString] -> Either UnicodeException [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either UnicodeException Text
T.decodeUtf8' ([ByteString] -> Maybe UAResult)
-> Maybe [ByteString] -> Maybe UAResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
uaRegex ByteString
bs []
        where
          normalize :: UAResult -> UAResult
normalize (UAResult Text
f Maybe Text
v1 Maybe Text
v2 Maybe Text
v3) = Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult Text
f (Maybe Text -> Maybe Text
forall a. (Eq a, IsString a) => Maybe a -> Maybe a
normalizeMaybeText Maybe Text
v1) (Maybe Text -> Maybe Text
forall a. (Eq a, IsString a) => Maybe a -> Maybe a
normalizeMaybeText Maybe Text
v2) (Maybe Text -> Maybe Text
forall a. (Eq a, IsString a) => Maybe a -> Maybe a
normalizeMaybeText Maybe Text
v3)
          normalizeMaybeText :: Maybe a -> Maybe a
normalizeMaybeText (Just a
"") = Maybe a
forall a. Maybe a
Nothing
          normalizeMaybeText Maybe a
x         = Maybe a
x
          mkRes :: [Text] -> Maybe UAResult
mkRes caps :: [Text]
caps@(Text
_:Text
f:Text
v1:Text
v2:Text
v3:[Text]
_) = UAResult -> Maybe UAResult
forall a. a -> Maybe a
Just (UAResult -> Maybe UAResult) -> UAResult -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v2)) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v3))
          mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
v1,Text
v2]      = UAResult -> Maybe UAResult
forall a. a -> Maybe a
Just (UAResult -> Maybe UAResult) -> UAResult -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v2)) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
v1]         = UAResult -> Maybe UAResult
forall a. a -> Maybe a
Just (UAResult -> Maybe UAResult) -> UAResult -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes caps :: [Text]
caps@[Text
_,Text
f]            = UAResult -> Maybe UAResult
forall a. a -> Maybe a
Just (UAResult -> Maybe UAResult) -> UAResult -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes caps :: [Text]
caps@[Text
f]              = UAResult -> Maybe UAResult
forall a. a -> Maybe a
Just (UAResult -> Maybe UAResult) -> UAResult -> Maybe UAResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes [Text]
_                     = Maybe UAResult
forall a. Maybe a
Nothing

          repV1 :: [Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
2) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
uaV1Rep)
          repV2 :: [Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
3) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
uaV2Rep)
          repV3 :: [Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
4) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
uaV3Rep)

          repF :: [Text] -> Text -> Text
repF [Text]
caps Text
x = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
x ([Text] -> Text -> Text
makeReplacements [Text]
caps) Maybe Text
uaFamRep



-------------------------------------------------------------------------------
-- | Results datatype for the parsed User-Agent
data UAResult = UAResult {
      UAResult -> Text
uarFamily :: Text
    , UAResult -> Maybe Text
uarV1     :: Maybe Text
    , UAResult -> Maybe Text
uarV2     :: Maybe Text
    , UAResult -> Maybe Text
uarV3     :: Maybe Text
    } deriving (Int -> UAResult -> ShowS
[UAResult] -> ShowS
UAResult -> [Char]
(Int -> UAResult -> ShowS)
-> (UAResult -> [Char]) -> ([UAResult] -> ShowS) -> Show UAResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UAResult] -> ShowS
$cshowList :: [UAResult] -> ShowS
show :: UAResult -> [Char]
$cshow :: UAResult -> [Char]
showsPrec :: Int -> UAResult -> ShowS
$cshowsPrec :: Int -> UAResult -> ShowS
Show, ReadPrec [UAResult]
ReadPrec UAResult
Int -> ReadS UAResult
ReadS [UAResult]
(Int -> ReadS UAResult)
-> ReadS [UAResult]
-> ReadPrec UAResult
-> ReadPrec [UAResult]
-> Read UAResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UAResult]
$creadListPrec :: ReadPrec [UAResult]
readPrec :: ReadPrec UAResult
$creadPrec :: ReadPrec UAResult
readList :: ReadS [UAResult]
$creadList :: ReadS [UAResult]
readsPrec :: Int -> ReadS UAResult
$creadsPrec :: Int -> ReadS UAResult
Read, UAResult -> UAResult -> Bool
(UAResult -> UAResult -> Bool)
-> (UAResult -> UAResult -> Bool) -> Eq UAResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UAResult -> UAResult -> Bool
$c/= :: UAResult -> UAResult -> Bool
== :: UAResult -> UAResult -> Bool
$c== :: UAResult -> UAResult -> Bool
Eq, Typeable, Typeable UAResult
DataType
Constr
Typeable UAResult
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UAResult -> c UAResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UAResult)
-> (UAResult -> Constr)
-> (UAResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UAResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UAResult))
-> ((forall b. Data b => b -> b) -> UAResult -> UAResult)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UAResult -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UAResult -> r)
-> (forall u. (forall d. Data d => d -> u) -> UAResult -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UAResult -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UAResult -> m UAResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UAResult -> m UAResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UAResult -> m UAResult)
-> Data UAResult
UAResult -> DataType
UAResult -> Constr
(forall b. Data b => b -> b) -> UAResult -> UAResult
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UAResult -> c UAResult
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UAResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UAResult -> u
forall u. (forall d. Data d => d -> u) -> UAResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UAResult -> m UAResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UAResult -> m UAResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UAResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UAResult -> c UAResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UAResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UAResult)
$cUAResult :: Constr
$tUAResult :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UAResult -> m UAResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UAResult -> m UAResult
gmapMp :: (forall d. Data d => d -> m d) -> UAResult -> m UAResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UAResult -> m UAResult
gmapM :: (forall d. Data d => d -> m d) -> UAResult -> m UAResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UAResult -> m UAResult
gmapQi :: Int -> (forall d. Data d => d -> u) -> UAResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UAResult -> u
gmapQ :: (forall d. Data d => d -> u) -> UAResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UAResult -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UAResult -> r
gmapT :: (forall b. Data b => b -> b) -> UAResult -> UAResult
$cgmapT :: (forall b. Data b => b -> b) -> UAResult -> UAResult
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UAResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UAResult)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UAResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UAResult)
dataTypeOf :: UAResult -> DataType
$cdataTypeOf :: UAResult -> DataType
toConstr :: UAResult -> Constr
$ctoConstr :: UAResult -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UAResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UAResult
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UAResult -> c UAResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UAResult -> c UAResult
$cp1Data :: Typeable UAResult
Data, (forall x. UAResult -> Rep UAResult x)
-> (forall x. Rep UAResult x -> UAResult) -> Generic UAResult
forall x. Rep UAResult x -> UAResult
forall x. UAResult -> Rep UAResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UAResult x -> UAResult
$cfrom :: forall x. UAResult -> Rep UAResult x
Generic)


-------------------------------------------------------------------------------
-- | Construct a browser version-string from 'UAResult'
uarVersion :: UAResult -> Text
uarVersion :: UAResult -> Text
uarVersion UAResult{Maybe Text
Text
uarV3 :: Maybe Text
uarV2 :: Maybe Text
uarV1 :: Maybe Text
uarFamily :: Text
uarV3 :: UAResult -> Maybe Text
uarV2 :: UAResult -> Maybe Text
uarV1 :: UAResult -> Maybe Text
uarFamily :: UAResult -> Text
..} =
    Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text])
-> ([Maybe Text] -> [Maybe Text]) -> [Maybe Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Bool) -> [Maybe Text] -> [Maybe Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe Text] -> Text) -> [Maybe Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text
uarV1, Maybe Text
uarV2, Maybe Text
uarV3]


-------------------------------------------------------------------------------
instance Default UAResult where
    def :: UAResult
def = Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAResult
UAResult Text
"Other" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- OS Parser
-------------------------------------------------------------------------------
-- | Parser that, upon failure to match a pattern returns a result of
-- family "Other" with all other fields blank. This is mainly for
-- compatibility with the uap-core test suite
parseOSLenient :: ByteString -> OSResult
parseOSLenient :: ByteString -> OSResult
parseOSLenient = OSResult -> Maybe OSResult -> OSResult
forall a. a -> Maybe a -> a
fromMaybe OSResult
forall a. Default a => a
def (Maybe OSResult -> OSResult)
-> (ByteString -> Maybe OSResult) -> ByteString -> OSResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe OSResult
parseOS


-------------------------------------------------------------------------------
-- | Parse OS from given User-Agent string
parseOS :: ByteString -> Maybe OSResult
parseOS :: ByteString -> Maybe OSResult
parseOS ByteString
bs = [Maybe OSResult] -> Maybe OSResult
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe OSResult] -> Maybe OSResult)
-> [Maybe OSResult] -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ (OSParser -> Maybe OSResult) -> [OSParser] -> [Maybe OSResult]
forall a b. (a -> b) -> [a] -> [b]
map OSParser -> Maybe OSResult
go [OSParser]
osParsers
    where
      UAConfig{[DevParser]
[OSParser]
[UAParser]
devParsers :: [DevParser]
uaParsers :: [UAParser]
osParsers :: [OSParser]
devParsers :: UAConfig -> [DevParser]
osParsers :: UAConfig -> [OSParser]
uaParsers :: UAConfig -> [UAParser]
..} = UAConfig
uaConfig

      go :: OSParser -> Maybe OSResult
go OSParser{Maybe Text
Regex
osRep4 :: OSParser -> Maybe Text
osRep3 :: OSParser -> Maybe Text
osRep2 :: OSParser -> Maybe Text
osRep1 :: OSParser -> Maybe Text
osFamRep :: OSParser -> Maybe Text
osRegex :: OSParser -> Regex
osRep4 :: Maybe Text
osRep3 :: Maybe Text
osRep2 :: Maybe Text
osRep1 :: Maybe Text
osFamRep :: Maybe Text
osRegex :: Regex
..} = (UnicodeException -> Maybe OSResult)
-> ([Text] -> Maybe OSResult)
-> Either UnicodeException [Text]
-> Maybe OSResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe OSResult -> UnicodeException -> Maybe OSResult
forall a b. a -> b -> a
const Maybe OSResult
forall a. Maybe a
Nothing) [Text] -> Maybe OSResult
mkRes
                      (Either UnicodeException [Text] -> Maybe OSResult)
-> ([ByteString] -> Either UnicodeException [Text])
-> [ByteString]
-> Maybe OSResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either UnicodeException Text)
-> [ByteString] -> Either UnicodeException [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either UnicodeException Text
T.decodeUtf8' ([ByteString] -> Maybe OSResult)
-> Maybe [ByteString] -> Maybe OSResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
osRegex ByteString
bs []
         where
         mkRes :: [Text] -> Maybe OSResult
mkRes caps :: [Text]
caps@(Text
_:Text
f:Text
v1:Text
v2:Text
v3:Text
v4:[Text]
_) = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v2)) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v3)) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v4))
         mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
v1,Text
v2,Text
v3]      = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v2)) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v3)) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
         mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
v1,Text
v2]         = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v2)) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
         mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
v1]            = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v1)) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
         mkRes caps :: [Text]
caps@[Text
_,Text
f]               = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
         mkRes caps :: [Text]
caps@[Text
f]                 = OSResult -> Maybe OSResult
forall a. a -> Maybe a
Just (OSResult -> Maybe OSResult) -> OSResult -> Maybe OSResult
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
         mkRes [Text]
_                   = Maybe OSResult
forall a. Maybe a
Nothing

         repF :: [Text] -> Text -> Text
repF [Text]
caps Text
x = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
x ([Text] -> Text -> Text
makeReplacements [Text]
caps) Maybe Text
osFamRep

         repV1 :: [Text] -> Maybe Text -> Maybe Text
repV1 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
2) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
osRep1)
         repV2 :: [Text] -> Maybe Text -> Maybe Text
repV2 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
3) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
osRep2)
         repV3 :: [Text] -> Maybe Text -> Maybe Text
repV3 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
4) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
osRep3)
         repV4 :: [Text] -> Maybe Text -> Maybe Text
repV4 [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
5) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
osRep4)

-------------------------------------------------------------------------------
-- | Result type for 'parseOS'
data OSResult = OSResult {
      OSResult -> Text
osrFamily :: Text
    , OSResult -> Maybe Text
osrV1     :: Maybe Text
    , OSResult -> Maybe Text
osrV2     :: Maybe Text
    , OSResult -> Maybe Text
osrV3     :: Maybe Text
    , OSResult -> Maybe Text
osrV4     :: Maybe Text
    } deriving (Int -> OSResult -> ShowS
[OSResult] -> ShowS
OSResult -> [Char]
(Int -> OSResult -> ShowS)
-> (OSResult -> [Char]) -> ([OSResult] -> ShowS) -> Show OSResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OSResult] -> ShowS
$cshowList :: [OSResult] -> ShowS
show :: OSResult -> [Char]
$cshow :: OSResult -> [Char]
showsPrec :: Int -> OSResult -> ShowS
$cshowsPrec :: Int -> OSResult -> ShowS
Show,ReadPrec [OSResult]
ReadPrec OSResult
Int -> ReadS OSResult
ReadS [OSResult]
(Int -> ReadS OSResult)
-> ReadS [OSResult]
-> ReadPrec OSResult
-> ReadPrec [OSResult]
-> Read OSResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OSResult]
$creadListPrec :: ReadPrec [OSResult]
readPrec :: ReadPrec OSResult
$creadPrec :: ReadPrec OSResult
readList :: ReadS [OSResult]
$creadList :: ReadS [OSResult]
readsPrec :: Int -> ReadS OSResult
$creadsPrec :: Int -> ReadS OSResult
Read,OSResult -> OSResult -> Bool
(OSResult -> OSResult -> Bool)
-> (OSResult -> OSResult -> Bool) -> Eq OSResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OSResult -> OSResult -> Bool
$c/= :: OSResult -> OSResult -> Bool
== :: OSResult -> OSResult -> Bool
$c== :: OSResult -> OSResult -> Bool
Eq,Typeable,Typeable OSResult
DataType
Constr
Typeable OSResult
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OSResult -> c OSResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OSResult)
-> (OSResult -> Constr)
-> (OSResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OSResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OSResult))
-> ((forall b. Data b => b -> b) -> OSResult -> OSResult)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OSResult -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OSResult -> r)
-> (forall u. (forall d. Data d => d -> u) -> OSResult -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> OSResult -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OSResult -> m OSResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OSResult -> m OSResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OSResult -> m OSResult)
-> Data OSResult
OSResult -> DataType
OSResult -> Constr
(forall b. Data b => b -> b) -> OSResult -> OSResult
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OSResult -> c OSResult
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OSResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OSResult -> u
forall u. (forall d. Data d => d -> u) -> OSResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OSResult -> m OSResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OSResult -> m OSResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OSResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OSResult -> c OSResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OSResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OSResult)
$cOSResult :: Constr
$tOSResult :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OSResult -> m OSResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OSResult -> m OSResult
gmapMp :: (forall d. Data d => d -> m d) -> OSResult -> m OSResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OSResult -> m OSResult
gmapM :: (forall d. Data d => d -> m d) -> OSResult -> m OSResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OSResult -> m OSResult
gmapQi :: Int -> (forall d. Data d => d -> u) -> OSResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OSResult -> u
gmapQ :: (forall d. Data d => d -> u) -> OSResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OSResult -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OSResult -> r
gmapT :: (forall b. Data b => b -> b) -> OSResult -> OSResult
$cgmapT :: (forall b. Data b => b -> b) -> OSResult -> OSResult
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OSResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OSResult)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OSResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OSResult)
dataTypeOf :: OSResult -> DataType
$cdataTypeOf :: OSResult -> DataType
toConstr :: OSResult -> Constr
$ctoConstr :: OSResult -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OSResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OSResult
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OSResult -> c OSResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OSResult -> c OSResult
$cp1Data :: Typeable OSResult
Data,(forall x. OSResult -> Rep OSResult x)
-> (forall x. Rep OSResult x -> OSResult) -> Generic OSResult
forall x. Rep OSResult x -> OSResult
forall x. OSResult -> Rep OSResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OSResult x -> OSResult
$cfrom :: forall x. OSResult -> Rep OSResult x
Generic)

instance Default OSResult where
    def :: OSResult
def = Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSResult
OSResult Text
"Other" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- | Construct a version string from 'OSResult'
osrVersion :: OSResult -> Text
osrVersion :: OSResult -> Text
osrVersion OSResult{Maybe Text
Text
osrV4 :: Maybe Text
osrV3 :: Maybe Text
osrV2 :: Maybe Text
osrV1 :: Maybe Text
osrFamily :: Text
osrV4 :: OSResult -> Maybe Text
osrV3 :: OSResult -> Maybe Text
osrV2 :: OSResult -> Maybe Text
osrV1 :: OSResult -> Maybe Text
osrFamily :: OSResult -> Text
..} =
    Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text])
-> ([Maybe Text] -> [Maybe Text]) -> [Maybe Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Bool) -> [Maybe Text] -> [Maybe Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe Text] -> Text) -> [Maybe Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text
osrV1, Maybe Text
osrV2, Maybe Text
osrV3, Maybe Text
osrV4]


-------------------------------------------------------------------------------
-- Dev Parser
-------------------------------------------------------------------------------
-- | Parser that, upon failure to match a pattern returns a result of
-- family "Other" with all other fields blank. This is mainly for
-- compatibility with the uap-core test suite
parseDevLenient :: ByteString -> DevResult
parseDevLenient :: ByteString -> DevResult
parseDevLenient = DevResult -> Maybe DevResult -> DevResult
forall a. a -> Maybe a -> a
fromMaybe DevResult
forall a. Default a => a
def (Maybe DevResult -> DevResult)
-> (ByteString -> Maybe DevResult) -> ByteString -> DevResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe DevResult
parseDev


-------------------------------------------------------------------------------
parseDev :: ByteString -> Maybe DevResult
parseDev :: ByteString -> Maybe DevResult
parseDev ByteString
bs = [Maybe DevResult] -> Maybe DevResult
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe DevResult] -> Maybe DevResult)
-> [Maybe DevResult] -> Maybe DevResult
forall a b. (a -> b) -> a -> b
$ (DevParser -> Maybe DevResult) -> [DevParser] -> [Maybe DevResult]
forall a b. (a -> b) -> [a] -> [b]
map DevParser -> Maybe DevResult
go [DevParser]
devParsers
    where
      UAConfig{[DevParser]
[OSParser]
[UAParser]
osParsers :: [OSParser]
uaParsers :: [UAParser]
devParsers :: [DevParser]
devParsers :: UAConfig -> [DevParser]
osParsers :: UAConfig -> [OSParser]
uaParsers :: UAConfig -> [UAParser]
..} = UAConfig
uaConfig

      go :: DevParser -> Maybe DevResult
go DevParser{Maybe Text
Regex
devModelRep :: DevParser -> Maybe Text
devBrandRep :: DevParser -> Maybe Text
devFamRep :: DevParser -> Maybe Text
devRegex :: DevParser -> Regex
devModelRep :: Maybe Text
devBrandRep :: Maybe Text
devFamRep :: Maybe Text
devRegex :: Regex
..} = (UnicodeException -> Maybe DevResult)
-> ([Text] -> Maybe DevResult)
-> Either UnicodeException [Text]
-> Maybe DevResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe DevResult -> UnicodeException -> Maybe DevResult
forall a b. a -> b -> a
const Maybe DevResult
forall a. Maybe a
Nothing) [Text] -> Maybe DevResult
mkRes
                       (Either UnicodeException [Text] -> Maybe DevResult)
-> ([ByteString] -> Either UnicodeException [Text])
-> [ByteString]
-> Maybe DevResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either UnicodeException Text)
-> [ByteString] -> Either UnicodeException [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either UnicodeException Text
T.decodeUtf8' ([ByteString] -> Maybe DevResult)
-> Maybe [ByteString] -> Maybe DevResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
devRegex ByteString
bs []
        where
          mkRes :: [Text] -> Maybe DevResult
mkRes caps :: [Text]
caps@(Text
_:Text
f:Text
b:Text
m:[Text]
_) = DevResult -> Maybe DevResult
forall a. a -> Maybe a
Just (DevResult -> Maybe DevResult) -> DevResult -> Maybe DevResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> DevResult
mkDR ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repBrand [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
b)) ([Text] -> Maybe Text -> Maybe Text
repModel [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
m))
          mkRes caps :: [Text]
caps@[Text
_,Text
f,Text
b]   = DevResult -> Maybe DevResult
forall a. a -> Maybe a
Just (DevResult -> Maybe DevResult) -> DevResult -> Maybe DevResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> DevResult
mkDR ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repBrand [Text]
caps (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
b)) ([Text] -> Maybe Text -> Maybe Text
repModel [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes caps :: [Text]
caps@[Text
_,Text
f]     = DevResult -> Maybe DevResult
forall a. a -> Maybe a
Just (DevResult -> Maybe DevResult) -> DevResult -> Maybe DevResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> DevResult
mkDR ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repBrand [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repModel [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes caps :: [Text]
caps@[Text
f]       = DevResult -> Maybe DevResult
forall a. a -> Maybe a
Just (DevResult -> Maybe DevResult) -> DevResult -> Maybe DevResult
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> DevResult
mkDR ([Text] -> Text -> Text
repF [Text]
caps Text
f) ([Text] -> Maybe Text -> Maybe Text
repBrand [Text]
caps Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Maybe Text -> Maybe Text
repModel [Text]
caps Maybe Text
forall a. Maybe a
Nothing)
          mkRes [Text]
_         = Maybe DevResult
forall a. Maybe a
Nothing

          mkDR :: Text -> Maybe Text -> Maybe Text -> DevResult
mkDR Text
a Maybe Text
b Maybe Text
c = Text -> Maybe Text -> Maybe Text -> DevResult
DevResult (Text -> Text
T.strip Text
a) (Text -> Maybe Text
strip' (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
b) (Text -> Maybe Text
strip' (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
c)

          strip' :: Text -> Maybe Text
strip' Text
t  = case Text -> Text
T.strip Text
t of
                        Text
"" -> Maybe Text
forall a. Maybe a
Nothing
                        Text
t' -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t'

          --TODO: update other replacers to be like this if it works
          --TODO: some patterns don't capture so you should match on [f]
          repBrand :: [Text] -> Maybe Text -> Maybe Text
repBrand [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Text
x Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
devBrandRep)
          -- This technique is used in the python ua-parser. It isn't
          -- clear if there's a precedent in the spec but it clears up
          -- some remote edge cases (which may be test suite bugs TBH).
          repModel :: [Text] -> Maybe Text -> Maybe Text
repModel [Text]
caps Maybe Text
x = Maybe Text -> (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text
x Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text]
caps [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`at` Int
1) Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text -> Text
makeReplacements [Text]
caps (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
devModelRep)

          repF :: [Text] -> Text -> Text
repF [Text]
caps Text
x = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
x ([Text] -> Text -> Text
makeReplacements [Text]
caps) Maybe Text
devFamRep


-------------------------------------------------------------------------------
-- | Replace replacement placeholders with captures and remove any
-- that are unused. Goes up to $4 as per the spec
makeReplacements
    :: [Text]
    -- ^ Captures
    -> Text
    -- ^ Replacement text with 1-indexed replace points ($1, $2, $3 or $4)
    -> Text
makeReplacements :: [Text] -> Text -> Text
makeReplacements (Text
_:[Text]
cs) Text
t = [(Int, Text)] -> Text -> Text
forall a. Show a => [(a, Text)] -> Text -> Text
makeReplacements' ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
1..Int
4] :: [Int]) ([Text]
cs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
forall a. a -> [a]
repeat Text
"")) Text
t
  where makeReplacements' :: [(a, Text)] -> Text -> Text
makeReplacements' [] Text
acc = Text
acc
        makeReplacements' ((a
idx, Text
cap):[(a, Text)]
caps) Text
acc = let acc' :: Text
acc' = Text -> Text -> Text -> Text
T.replace (Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
M.<> a -> Text
forall a. Show a => a -> Text
showT a
idx) Text
cap Text
acc
                                        in [(a, Text)] -> Text -> Text
makeReplacements' [(a, Text)]
caps Text
acc'
makeReplacements [Text]
_ Text
t = Text
t


-------------------------------------------------------------------------------
showT :: Show a => a -> Text
showT :: a -> Text
showT = [Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show


-------------------------------------------------------------------------------
-- | Result type for 'parseDev'
data DevResult = DevResult {
      DevResult -> Text
drFamily :: Text
    , DevResult -> Maybe Text
drBrand  :: Maybe Text
    , DevResult -> Maybe Text
drModel  :: Maybe Text
    } deriving (Int -> DevResult -> ShowS
[DevResult] -> ShowS
DevResult -> [Char]
(Int -> DevResult -> ShowS)
-> (DevResult -> [Char])
-> ([DevResult] -> ShowS)
-> Show DevResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DevResult] -> ShowS
$cshowList :: [DevResult] -> ShowS
show :: DevResult -> [Char]
$cshow :: DevResult -> [Char]
showsPrec :: Int -> DevResult -> ShowS
$cshowsPrec :: Int -> DevResult -> ShowS
Show,ReadPrec [DevResult]
ReadPrec DevResult
Int -> ReadS DevResult
ReadS [DevResult]
(Int -> ReadS DevResult)
-> ReadS [DevResult]
-> ReadPrec DevResult
-> ReadPrec [DevResult]
-> Read DevResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DevResult]
$creadListPrec :: ReadPrec [DevResult]
readPrec :: ReadPrec DevResult
$creadPrec :: ReadPrec DevResult
readList :: ReadS [DevResult]
$creadList :: ReadS [DevResult]
readsPrec :: Int -> ReadS DevResult
$creadsPrec :: Int -> ReadS DevResult
Read,DevResult -> DevResult -> Bool
(DevResult -> DevResult -> Bool)
-> (DevResult -> DevResult -> Bool) -> Eq DevResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DevResult -> DevResult -> Bool
$c/= :: DevResult -> DevResult -> Bool
== :: DevResult -> DevResult -> Bool
$c== :: DevResult -> DevResult -> Bool
Eq,Typeable,Typeable DevResult
DataType
Constr
Typeable DevResult
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DevResult -> c DevResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DevResult)
-> (DevResult -> Constr)
-> (DevResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DevResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DevResult))
-> ((forall b. Data b => b -> b) -> DevResult -> DevResult)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DevResult -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DevResult -> r)
-> (forall u. (forall d. Data d => d -> u) -> DevResult -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DevResult -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DevResult -> m DevResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DevResult -> m DevResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DevResult -> m DevResult)
-> Data DevResult
DevResult -> DataType
DevResult -> Constr
(forall b. Data b => b -> b) -> DevResult -> DevResult
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DevResult -> c DevResult
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DevResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DevResult -> u
forall u. (forall d. Data d => d -> u) -> DevResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DevResult -> m DevResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DevResult -> m DevResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DevResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DevResult -> c DevResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DevResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DevResult)
$cDevResult :: Constr
$tDevResult :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DevResult -> m DevResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DevResult -> m DevResult
gmapMp :: (forall d. Data d => d -> m d) -> DevResult -> m DevResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DevResult -> m DevResult
gmapM :: (forall d. Data d => d -> m d) -> DevResult -> m DevResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DevResult -> m DevResult
gmapQi :: Int -> (forall d. Data d => d -> u) -> DevResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DevResult -> u
gmapQ :: (forall d. Data d => d -> u) -> DevResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DevResult -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DevResult -> r
gmapT :: (forall b. Data b => b -> b) -> DevResult -> DevResult
$cgmapT :: (forall b. Data b => b -> b) -> DevResult -> DevResult
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DevResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DevResult)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DevResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DevResult)
dataTypeOf :: DevResult -> DataType
$cdataTypeOf :: DevResult -> DataType
toConstr :: DevResult -> Constr
$ctoConstr :: DevResult -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DevResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DevResult
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DevResult -> c DevResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DevResult -> c DevResult
$cp1Data :: Typeable DevResult
Data,(forall x. DevResult -> Rep DevResult x)
-> (forall x. Rep DevResult x -> DevResult) -> Generic DevResult
forall x. Rep DevResult x -> DevResult
forall x. DevResult -> Rep DevResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DevResult x -> DevResult
$cfrom :: forall x. DevResult -> Rep DevResult x
Generic)


instance Default DevResult where
    def :: DevResult
def = Text -> Maybe Text -> Maybe Text -> DevResult
DevResult Text
"Other" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing


-------------------------------------------------------------------------------
-- Parser Config
-------------------------------------------------------------------------------

-- | User-Agent string parser data
data UAConfig = UAConfig {
      UAConfig -> [UAParser]
uaParsers  :: [UAParser]
    , UAConfig -> [OSParser]
osParsers  :: [OSParser]
    , UAConfig -> [DevParser]
devParsers :: [DevParser]
    } deriving (UAConfig -> UAConfig -> Bool
(UAConfig -> UAConfig -> Bool)
-> (UAConfig -> UAConfig -> Bool) -> Eq UAConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UAConfig -> UAConfig -> Bool
$c/= :: UAConfig -> UAConfig -> Bool
== :: UAConfig -> UAConfig -> Bool
$c== :: UAConfig -> UAConfig -> Bool
Eq,Int -> UAConfig -> ShowS
[UAConfig] -> ShowS
UAConfig -> [Char]
(Int -> UAConfig -> ShowS)
-> (UAConfig -> [Char]) -> ([UAConfig] -> ShowS) -> Show UAConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UAConfig] -> ShowS
$cshowList :: [UAConfig] -> ShowS
show :: UAConfig -> [Char]
$cshow :: UAConfig -> [Char]
showsPrec :: Int -> UAConfig -> ShowS
$cshowsPrec :: Int -> UAConfig -> ShowS
Show)


-------------------------------------------------------------------------------
data UAParser = UAParser {
      UAParser -> Regex
uaRegex  :: Regex
    , UAParser -> Maybe Text
uaFamRep :: Maybe Text
    , UAParser -> Maybe Text
uaV1Rep  :: Maybe Text
    , UAParser -> Maybe Text
uaV2Rep  :: Maybe Text
    , UAParser -> Maybe Text
uaV3Rep  :: Maybe Text
    } deriving (UAParser -> UAParser -> Bool
(UAParser -> UAParser -> Bool)
-> (UAParser -> UAParser -> Bool) -> Eq UAParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UAParser -> UAParser -> Bool
$c/= :: UAParser -> UAParser -> Bool
== :: UAParser -> UAParser -> Bool
$c== :: UAParser -> UAParser -> Bool
Eq,Int -> UAParser -> ShowS
[UAParser] -> ShowS
UAParser -> [Char]
(Int -> UAParser -> ShowS)
-> (UAParser -> [Char]) -> ([UAParser] -> ShowS) -> Show UAParser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UAParser] -> ShowS
$cshowList :: [UAParser] -> ShowS
show :: UAParser -> [Char]
$cshow :: UAParser -> [Char]
showsPrec :: Int -> UAParser -> ShowS
$cshowsPrec :: Int -> UAParser -> ShowS
Show)


-------------------------------------------------------------------------------
data OSParser = OSParser {
      OSParser -> Regex
osRegex  :: Regex
    , OSParser -> Maybe Text
osFamRep :: Maybe Text
    , OSParser -> Maybe Text
osRep1   :: Maybe Text
    , OSParser -> Maybe Text
osRep2   :: Maybe Text
    , OSParser -> Maybe Text
osRep3   :: Maybe Text
    , OSParser -> Maybe Text
osRep4   :: Maybe Text
    } deriving (OSParser -> OSParser -> Bool
(OSParser -> OSParser -> Bool)
-> (OSParser -> OSParser -> Bool) -> Eq OSParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OSParser -> OSParser -> Bool
$c/= :: OSParser -> OSParser -> Bool
== :: OSParser -> OSParser -> Bool
$c== :: OSParser -> OSParser -> Bool
Eq,Int -> OSParser -> ShowS
[OSParser] -> ShowS
OSParser -> [Char]
(Int -> OSParser -> ShowS)
-> (OSParser -> [Char]) -> ([OSParser] -> ShowS) -> Show OSParser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OSParser] -> ShowS
$cshowList :: [OSParser] -> ShowS
show :: OSParser -> [Char]
$cshow :: OSParser -> [Char]
showsPrec :: Int -> OSParser -> ShowS
$cshowsPrec :: Int -> OSParser -> ShowS
Show)


-------------------------------------------------------------------------------
data DevParser = DevParser {
      DevParser -> Regex
devRegex    :: Regex
    , DevParser -> Maybe Text
devFamRep   :: Maybe Text
    , DevParser -> Maybe Text
devBrandRep :: Maybe Text
    , DevParser -> Maybe Text
devModelRep :: Maybe Text
    } deriving (DevParser -> DevParser -> Bool
(DevParser -> DevParser -> Bool)
-> (DevParser -> DevParser -> Bool) -> Eq DevParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DevParser -> DevParser -> Bool
$c/= :: DevParser -> DevParser -> Bool
== :: DevParser -> DevParser -> Bool
$c== :: DevParser -> DevParser -> Bool
Eq,Int -> DevParser -> ShowS
[DevParser] -> ShowS
DevParser -> [Char]
(Int -> DevParser -> ShowS)
-> (DevParser -> [Char])
-> ([DevParser] -> ShowS)
-> Show DevParser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DevParser] -> ShowS
$cshowList :: [DevParser] -> ShowS
show :: DevParser -> [Char]
$cshow :: DevParser -> [Char]
showsPrec :: Int -> DevParser -> ShowS
$cshowsPrec :: Int -> DevParser -> ShowS
Show)


-------------------------------------------------------------------------------
parseRegex :: Object -> Parser Regex
parseRegex :: Object -> Parser Regex
parseRegex Object
v = do
  Text
pat <- Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"regex"
  Maybe Text
flag <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"regex_flag" :: Parser (Maybe Text)
  let flags :: [PCREOption]
flags = case Maybe Text
flag of
                Just Text
"i" -> [PCREOption
caseless]
                Maybe Text
_        -> []
  Regex -> Parser Regex
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [PCREOption] -> Regex
compile (Text -> ByteString
T.encodeUtf8 Text
pat) [PCREOption]
flags)


-------------------------------------------------------------------------------
instance FromJSON UAConfig where
    parseJSON :: Value -> Parser UAConfig
parseJSON (Object Object
v) =
      [UAParser] -> [OSParser] -> [DevParser] -> UAConfig
UAConfig
        ([UAParser] -> [OSParser] -> [DevParser] -> UAConfig)
-> Parser [UAParser]
-> Parser ([OSParser] -> [DevParser] -> UAConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [UAParser]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"user_agent_parsers"
        Parser ([OSParser] -> [DevParser] -> UAConfig)
-> Parser [OSParser] -> Parser ([DevParser] -> UAConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [OSParser]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"os_parsers"
        Parser ([DevParser] -> UAConfig)
-> Parser [DevParser] -> Parser UAConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [DevParser]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"device_parsers"
    parseJSON Value
_ = [Char] -> Parser UAConfig
forall a. HasCallStack => [Char] -> a
error [Char]
"Object expected when parsing JSON"


-------------------------------------------------------------------------------
instance FromJSON UAParser where
    parseJSON :: Value -> Parser UAParser
parseJSON (Object Object
v) =
      Regex
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAParser
UAParser (Regex
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> UAParser)
-> Parser Regex
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAParser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Regex
parseRegex Object
v
               Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> UAParser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> UAParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"family_replacement"
               Parser (Maybe Text -> Maybe Text -> Maybe Text -> UAParser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UAParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"v1_replacement"
               Parser (Maybe Text -> Maybe Text -> UAParser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UAParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"v2_replacement"
               Parser (Maybe Text -> UAParser)
-> Parser (Maybe Text) -> Parser UAParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"v3_replacement"
    parseJSON Value
_ = [Char] -> Parser UAParser
forall a. HasCallStack => [Char] -> a
error [Char]
"Object expected when parsing JSON"


-------------------------------------------------------------------------------
instance FromJSON OSParser where
    parseJSON :: Value -> Parser OSParser
parseJSON (Object Object
v) =
      Regex
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OSParser
OSParser (Regex
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> OSParser)
-> Parser Regex
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> OSParser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Regex
parseRegex Object
v
               Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> OSParser)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"os_replacement"
               Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> OSParser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> OSParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"os_v1_replacement"
               Parser (Maybe Text -> Maybe Text -> Maybe Text -> OSParser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> OSParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"os_v2_replacement"
               Parser (Maybe Text -> Maybe Text -> OSParser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> OSParser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"os_v3_replacement"
               Parser (Maybe Text -> OSParser)
-> Parser (Maybe Text) -> Parser OSParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"os_v4_replacement"
    parseJSON Value
_ = [Char] -> Parser OSParser
forall a. HasCallStack => [Char] -> a
error [Char]
"Object expected when parsing JSON"


-------------------------------------------------------------------------------
instance FromJSON DevParser where
    parseJSON :: Value -> Parser DevParser
parseJSON (Object Object
v) = do
      Regex
r <- Object -> Parser Regex
parseRegex Object
v
      Maybe Text
fam <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"device_replacement"
      Maybe Text
brandRep <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"brand_replacement"
      Maybe Text
modRep <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"model_replacement"
      DevParser -> Parser DevParser
forall (m :: * -> *) a. Monad m => a -> m a
return (DevParser :: Regex -> Maybe Text -> Maybe Text -> Maybe Text -> DevParser
DevParser { devRegex :: Regex
devRegex    = Regex
r
                        , devFamRep :: Maybe Text
devFamRep    = Maybe Text
fam
                        , devBrandRep :: Maybe Text
devBrandRep = Maybe Text
brandRep
                        , devModelRep :: Maybe Text
devModelRep = Maybe Text
modRep})
    parseJSON Value
_ = [Char] -> Parser DevParser
forall a. HasCallStack => [Char] -> a
error [Char]
"Object expected when parsing JSON"


-------------------------------------------------------------------------------
at :: [a] -> Int -> Maybe a
at :: [a] -> Int -> Maybe a
at [] Int
_ = Maybe a
forall a. Maybe a
Nothing
at (a
a:[a]
_) Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
a
at (a
_:[a]
as) Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
at [a]
as (Int -> Int
forall a. Enum a => a -> a
pred Int
n)
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing