XML Parsing

Example.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Simple.FactorTrust.Proprietary where

import Control.Monad.Except (Except)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Catch (MonadCatch)
import Data.Aeson (ToJSON)
import GHC.Generics (Generic)
import Simple.FactorTrust.SendInquiry (sendAPI)
import Simple.FactorTrust.Store (FTStore(..))
import Simple.FactorTrust.Parse (int, optional, checkText, ParseError, parse)
import Simple.Risk.Types.LeaseApplication (LeaseApplication)
import Text.XML.Cursor

type Miles = Int
type Age = Int
type Months = Int
data Fields = Fields
  { addrMostRecentDist :: Maybe Miles
  , addrMostRecentMoveAge :: Maybe Age
  , currentAddress_LenOfRes :: Maybe Months
  , derogAge :: Maybe Age
  , inferredMinAge :: Maybe Age
  , inputAddress_LenOfRes :: Maybe Months
  , inputAddress_TaxVal :: Maybe Dollars
  , phoneEDAAAgeNewestRec :: Maybe Months
  , ssnCharacteristics_HighIssueAge :: Maybe Months
  , subjAddrCnt :: Maybe Int
  } deriving (Show, Eq, Generic)
instance ToJSON Fields


fetch :: (MonadIO m, MonadCatch m) => LeaseApplication -> m Fields
fetch l =
    sendAPI parseFields store l


parseFields :: Cursor -> Except ParseError Fields
parseFields c = Fields
    <$> parse (optional int) (c $// element "MostRecentAddress" &// element "AddrMostRecentDist" &// content)
    <*> parse (optional int) (c $// element "MostRecentAddress" &// element "AddrMostRecentMoveAge" &// content)
    <*> parse (optional int) (c $// element "CurrentAddress" &// element "LenOfRes" &// content)
    <*> parse (optional int) (c $// element "DerogatoryPublicRecords" &// element "DerogAge" &// content)
    <*> parse (optional int) (c $// element "IdentityManipulation" &// element "InferredMinAge" &// content)
    <*> parse (optional int) (c $// element "InputAddress" &// element "LenOfRes" &// content)
    <*> parse (optional dollars) (c $// element "InputAddress" &// element "TaxVal" &// content)
    <*> parse (optional int) (c $// element "PhoneAndAddressRisk" &// element "PHoneEDAAAgeNewestRec" &// content)
    <*> parse (optional int) (c $// element "SSNCharacteristics" &// element "HighIssueAge" &// content)
    <*> parse (optional int) (c $// element "IdentityManipulation" &// element "SubjAddrCnt" &// content)

Parse.hs

{-# LANGUAGE OverloadedStrings #-}
module Simple.FactorTrust.Parse where

import Control.Monad.Except (Except, throwError)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Read (decimal, double)
import Text.XML.Cursor
import Text.XML (Name)

import Simple.Risk.Types.Dollars (Dollars(..))

type ParseError = String



checkText :: Name -> Text -> Axis
checkText n t =
    check isText
    where
      isText :: Cursor -> Bool
      isText c =
          (c $// element n &// content) == [t]


-- -- | Fail parsing if you can't find the node
-- required :: Parser a -> Cursor -> Name -> Except ParseError a
-- required p c n =
--     case c $// element n &// content of
--       [] -> throwError $ "Required: " ++ (show n)
--       ts -> p (mconcat ts)


-- -- | Return a maybe if you can't find the node
-- optional :: Parser a -> [Text] -> Except ParseError (Maybe a)
-- optional p t =
--     case t of
--       [] -> return Nothing
--       ts -> fmap Just $ p $ Text.concat ts


parse :: Parser a -> [Text] -> Except ParseError a
parse p ts = p $ Text.concat ts


type Parser a = Text -> Except ParseError a


int :: Integral a => Parser a
int = exceptRead . decimal


float :: Parser Float
float = fmap realToFrac . exceptRead . double


dollars :: Parser Dollars
dollars = fmap Dollars . float


optional :: Parser a -> Parser (Maybe a)
optional p t =
    case t of
      "" -> return Nothing
      "-1" -> return Nothing
      _ -> fmap Just $ p t


exceptRead :: Either String (a, Text) -> Except ParseError a
exceptRead (Left err) = throwError err
exceptRead (Right (i, _)) = return i