    {-# LANGUAGE OverloadedStrings #-}
    --------------------------------------------------------------------------------
    -- |
    -- Module      : Text.XRDS
    -- Copyright   : (c) Trevor Elliott, 2008
    -- License     : BSD3
    --
    -- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
    -- Stability   :
    -- Portability :
    --

    module OpenId2.XRDS (
        -- * Types
        XRDS
      , Service(..)

        -- * Parsing
      , parseXRDS
      ) where

    -- Libraries
    import Control.Monad ((>=>))
    import Data.Maybe (listToMaybe)
    import Text.XML (parseLBS, def)
    import Text.XML.Cursor (fromDocument, element, content, ($/), (&|), Cursor, (&/), attribute)
    import qualified Data.ByteString.Lazy as L
    import Data.Text (Text)
    import qualified Data.Text.Read

    -- Types -----------------------------------------------------------------------

    type XRDS = [XRD]

    type XRD = [Service]

    data Service = Service
      { Service -> [Text]
    serviceTypes      :: [Text]
      , Service -> [Text]
    serviceMediaTypes :: [Text]
      , Service -> [Text]
    serviceURIs       :: [Text]
      , Service -> [Text]
    serviceLocalIDs   :: [Text]
      , Service -> Maybe Int
    servicePriority   :: Maybe Int
      } deriving Int -> Service -> ShowS
    [Service] -> ShowS
    Service -> String
    (Int -> Service -> ShowS)
    -> (Service -> String) -> ([Service] -> ShowS) -> Show Service
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Service -> ShowS
    showsPrec :: Int -> Service -> ShowS
    $cshow :: Service -> String
    show :: Service -> String
    $cshowList :: [Service] -> ShowS
    showList :: [Service] -> ShowS
    Show

    parseXRDS :: L.ByteString -> Maybe XRDS
    parseXRDS :: ByteString -> Maybe XRDS
    parseXRDS ByteString
    str =
        (SomeException -> Maybe XRDS)
    -> (Document -> Maybe XRDS)
    -> Either SomeException Document
    -> Maybe XRDS
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either
            (Maybe XRDS -> SomeException -> Maybe XRDS
    forall a b. a -> b -> a
    const Maybe XRDS
    forall a. Maybe a
    Nothing)
            (XRDS -> Maybe XRDS
    forall a. a -> Maybe a
    Just (XRDS -> Maybe XRDS)
    -> (Document -> XRDS) -> Document -> Maybe XRDS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> XRDS
    parseXRDS' (Cursor -> XRDS) -> (Document -> Cursor) -> Document -> XRDS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document -> Cursor
    fromDocument)
            (ParseSettings -> ByteString -> Either SomeException Document
    parseLBS ParseSettings
    forall a. Default a => a
    def ByteString
    str)

    parseXRDS' :: Cursor -> [[Service]]
    parseXRDS' :: Cursor -> XRDS
    parseXRDS' = Name -> Axis
    element Name
    "{xri://$xrds}XRDS" Axis -> (Cursor -> XRDS) -> Cursor -> XRDS
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/
                 Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}XRD" Axis -> (Cursor -> [Service]) -> Cursor -> XRDS
    forall node a b.
    (Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
    &|
                 Cursor -> [Service]
    parseXRD

    parseXRD :: Cursor -> [Service]
    parseXRD :: Cursor -> [Service]
    parseXRD Cursor
    c = Cursor
    c Cursor -> (Cursor -> [Service]) -> [Service]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}Service" Axis -> (Cursor -> [Service]) -> Cursor -> [Service]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [Service]
    parseService

    parseService :: Cursor -> [Service]
    parseService :: Cursor -> [Service]
    parseService Cursor
    c =
        if [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    types then [] else [Service
            { serviceTypes :: [Text]
    serviceTypes = [Text]
    types
            , serviceMediaTypes :: [Text]
    serviceMediaTypes = [Text]
    mtypes
            , serviceURIs :: [Text]
    serviceURIs = [Text]
    uris
            , serviceLocalIDs :: [Text]
    serviceLocalIDs = [Text]
    localids
            , servicePriority :: Maybe Int
    servicePriority = [Text] -> Maybe Text
    forall a. [a] -> Maybe a
    listToMaybe (Name -> Cursor -> [Text]
    attribute Name
    "priority" Cursor
    c) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Int
    forall {a}. Integral a => Text -> Maybe a
    readMaybe
            }]
      where
        types :: [Text]
    types = Cursor
    c Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}Type" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content
        mtypes :: [Text]
    mtypes = Cursor
    c Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}MediaType" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content
        uris :: [Text]
    uris = Cursor
    c Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}URI" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content
        localids :: [Text]
    localids = Cursor
    c Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    "{xri://$xrd*($v*2.0)}LocalID" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Cursor -> [Text]
    content
        readMaybe :: Text -> Maybe a
    readMaybe Text
    t =
            case Reader a -> Reader a
    forall a. Num a => Reader a -> Reader a
    Data.Text.Read.signed Reader a
    forall a. Integral a => Reader a
    Data.Text.Read.decimal Text
    t of
                Right (a
    i, Text
    "") -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    i
                Either String (a, Text)
    _ -> Maybe a
    forall a. Maybe a
    Nothing