-- Copyright 2024 United States Government as represented by the Administrator
-- of the National Aeronautics and Space Administration. All Rights Reserved.
--
-- No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY WARRANTY
-- OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT
-- LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL CONFORM TO
-- SPECIFICATIONS, ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
-- PARTICULAR PURPOSE, OR FREEDOM FROM INFRINGEMENT, ANY WARRANTY THAT THE
-- SUBJECT SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY THAT DOCUMENTATION, IF
-- PROVIDED, WILL CONFORM TO THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN
-- ANY MANNER, CONSTITUTE AN ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR
-- RECIPIENT OF ANY RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR
-- ANY OTHER APPLICATIONS RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER,
-- GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING
-- THIRD-PARTY SOFTWARE, IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES
-- IT "AS IS."
--
-- Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS AGAINST
-- THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS
-- ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN
-- ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR LOSSES ARISING FROM SUCH USE,
-- INCLUDING ANY DAMAGES FROM PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S
-- USE OF THE SUBJECT SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE
-- UNITED STATES GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY
-- PRIOR RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY
-- FOR ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS
-- AGREEMENT.

-- | Parser for Ogma specs stored in XML files.
module Language.XMLSpec.Parser where

-- External imports
import Control.Monad.Except   (ExceptT (..), liftEither, throwError, runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.List              (isPrefixOf)
import Data.Maybe             (fromMaybe, listToMaybe)
import Text.XML.HXT.Core      (configSysVars, no, readString, runX,
                               withCanonicalize, withOutputPLAIN, withRedirect,
                               withRemoveWS, withSubstDTDEntities,
                               withSubstHTMLEntities, withValidate, yes, (>>>))
import Text.XML.HXT.XPath     (getXPathTrees, parseXPathExpr)

-- External imports: ogma-spec
import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..),
                      Requirement (..), Spec (Spec))

-- Internal imports
import Language.XMLSpec.PrintTrees (pretty, flattenDoc)

-- | List of XPath routes to the elements we need to parse.
--
-- The optional paths denote elements that may not exist. If they are nothing,
-- those elements are not parsed in the input file.
--
-- The subfields are applied on each string matching the parent element. That
-- is, the internal var ID XPath will be a applied to the strings returned when
-- applying the internal vars XPath (if it exists). Paths whose names are
-- plural denote expected lists of elements.
--
-- The components of a tuple (String, Maybe (String, String)) mean the
-- following: if a string is present but the second component is Nothing, then
-- the string is the XPath expression to be used. If a Just value is present,
-- the first element of its inner tuple represents a key, and the second
-- element represents an XPath expression that will produce a value when
-- evaluated globally in the file. After evaluating that expression, the key
-- must be found in the first string of the three and replaced with the result
-- of evaluating the expression.
data XMLFormat = XMLFormat
    { XMLFormat -> Maybe String
specInternalVars          :: Maybe String
    , XMLFormat -> (String, Maybe (String, String))
specInternalVarId         :: (String, Maybe (String, String))
    , XMLFormat -> (String, Maybe (String, String))
specInternalVarExpr       :: (String, Maybe (String, String))
    , XMLFormat -> Maybe (String, Maybe (String, String))
specInternalVarType       :: Maybe (String, Maybe (String, String))
    , XMLFormat -> Maybe String
specExternalVars          :: Maybe String
    , XMLFormat -> (String, Maybe (String, String))
specExternalVarId         :: (String, Maybe (String, String))
    , XMLFormat -> Maybe (String, Maybe (String, String))
specExternalVarType       :: Maybe (String, Maybe (String, String))
    , XMLFormat -> (String, Maybe (String, String))
specRequirements          :: (String, Maybe (String, String))
    , XMLFormat -> (String, Maybe (String, String))
specRequirementId         :: (String, Maybe (String, String))
    , XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementDesc       :: Maybe (String, Maybe (String, String))
    , XMLFormat -> (String, Maybe (String, String))
specRequirementExpr       :: (String, Maybe (String, String))
    , XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementResultType :: Maybe (String, Maybe (String, String))
    , XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementResultExpr :: Maybe (String, Maybe (String, String))
    }
  deriving (Int -> XMLFormat -> ShowS
[XMLFormat] -> ShowS
XMLFormat -> String
(Int -> XMLFormat -> ShowS)
-> (XMLFormat -> String)
-> ([XMLFormat] -> ShowS)
-> Show XMLFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XMLFormat -> ShowS
showsPrec :: Int -> XMLFormat -> ShowS
$cshow :: XMLFormat -> String
show :: XMLFormat -> String
$cshowList :: [XMLFormat] -> ShowS
showList :: [XMLFormat] -> ShowS
Show, ReadPrec [XMLFormat]
ReadPrec XMLFormat
Int -> ReadS XMLFormat
ReadS [XMLFormat]
(Int -> ReadS XMLFormat)
-> ReadS [XMLFormat]
-> ReadPrec XMLFormat
-> ReadPrec [XMLFormat]
-> Read XMLFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XMLFormat
readsPrec :: Int -> ReadS XMLFormat
$creadList :: ReadS [XMLFormat]
readList :: ReadS [XMLFormat]
$creadPrec :: ReadPrec XMLFormat
readPrec :: ReadPrec XMLFormat
$creadListPrec :: ReadPrec [XMLFormat]
readListPrec :: ReadPrec [XMLFormat]
Read)

-- | Parse an XML file and extract a Spec from it.
--
-- An auxiliary function must be provided to parse the requirement expressions.
--
-- Fails if any of the XPaths in the argument XMLFormat are not valid
-- expressions, of the XML is malformed, or if the elements are not found with
-- the frequency expected (e.g., an external variable id is not found even
-- though external variables are found).
parseXMLSpec :: (String -> IO (Either String a)) -- ^ Parser for expressions.
             -> a
             -> XMLFormat                        -- ^ XPaths for spec locations.
             -> String                           -- ^ String containing XML
             -> IO (Either String (Spec a))
parseXMLSpec :: forall a.
(String -> IO (Either String a))
-> a -> XMLFormat -> String -> IO (Either String (Spec a))
parseXMLSpec String -> IO (Either String a)
parseExpr a
defA XMLFormat
xmlFormat String
value = ExceptT String IO (Spec a) -> IO (Either String (Spec a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO (Spec a) -> IO (Either String (Spec a)))
-> ExceptT String IO (Spec a) -> IO (Either String (Spec a))
forall a b. (a -> b) -> a -> b
$ do
  XMLFormatInternal
xmlFormatInternal <- XMLFormat -> String -> ExceptT String IO XMLFormatInternal
parseXMLFormat XMLFormat
xmlFormat String
value

  -- Internal variables

  -- intVarStrings :: [String]
  [String]
intVarStrings <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ExceptT String IO [String])
-> IO [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
-> (String -> IO [String]) -> Maybe String -> IO [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                              ([String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                              (String -> String -> IO [String]
`executeXPath` String
value)
                              (XMLFormatInternal -> Maybe String
xfiInternalVars XMLFormatInternal
xmlFormatInternal)

  let internalVarDef :: String -> ExceptT String IO InternalVariableDef
      internalVarDef :: String -> ExceptT String IO InternalVariableDef
internalVarDef String
def = do
        let msgI :: String
msgI = String
"internal variable name"
        String
varId <- IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String String) -> ExceptT String IO String)
-> IO (Either String String) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$
                   String -> [String] -> Either String String
listToEither String
msgI ([String] -> Either String String)
-> IO [String] -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   String -> String -> IO [String]
executeXPath (XMLFormatInternal -> String
xfiInternalVarId XMLFormatInternal
xmlFormatInternal) String
def

        let msgT :: String
msgT = String
"internal variable type"
        String
varType <- ExceptT String IO String
-> (String -> ExceptT String IO String)
-> Maybe String
-> ExceptT String IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                     (Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
"")
                     (\String
e -> IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String String) -> ExceptT String IO String)
-> IO (Either String String) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Either String String
listToEither String
msgT ([String] -> Either String String)
-> IO [String] -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
executeXPath String
e String
def)
                     (XMLFormatInternal -> Maybe String
xfiInternalVarType XMLFormatInternal
xmlFormatInternal)

        let msgE :: String
msgE = String
"internal variable expr"
        String
varExpr <- IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String String) -> ExceptT String IO String)
-> IO (Either String String) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$
                     String -> [String] -> Either String String
listToEither String
msgE ([String] -> Either String String)
-> IO [String] -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     String -> String -> IO [String]
executeXPath (XMLFormatInternal -> String
xfiInternalVarExpr XMLFormatInternal
xmlFormatInternal) String
def

        InternalVariableDef -> ExceptT String IO InternalVariableDef
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalVariableDef -> ExceptT String IO InternalVariableDef)
-> InternalVariableDef -> ExceptT String IO InternalVariableDef
forall a b. (a -> b) -> a -> b
$ InternalVariableDef
                   { internalVariableName :: String
internalVariableName = String
varId
                   , internalVariableType :: String
internalVariableType = String
varType
                   , internalVariableExpr :: String
internalVariableExpr = String
varExpr
                   }

  [InternalVariableDef]
internalVariableDefs <- (String -> ExceptT String IO InternalVariableDef)
-> [String] -> ExceptT String IO [InternalVariableDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> ExceptT String IO InternalVariableDef
internalVarDef [String]
intVarStrings

  -- External variables

  -- extVarStrings :: [String]
  [String]
extVarStrings <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ExceptT String IO [String])
-> IO [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ IO [String]
-> (String -> IO [String]) -> Maybe String -> IO [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                              ([String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                              (String -> String -> IO [String]
`executeXPath` String
value)
                              (XMLFormatInternal -> Maybe String
xfiExternalVars XMLFormatInternal
xmlFormatInternal)

  let externalVarDef :: String -> ExceptT String IO ExternalVariableDef
      externalVarDef :: String -> ExceptT String IO ExternalVariableDef
externalVarDef String
def = do

        let msgI :: String
msgI = String
"external variable name"
        String
varId <- IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String String) -> ExceptT String IO String)
-> IO (Either String String) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$
                   String -> [String] -> Either String String
listToEither String
msgI ([String] -> Either String String)
-> IO [String] -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   String -> String -> IO [String]
executeXPath (XMLFormatInternal -> String
xfiExternalVarId XMLFormatInternal
xmlFormatInternal) String
def

        let msgT :: String
msgT = String
"external variable type"
        String
varType <- ExceptT String IO String
-> (String -> ExceptT String IO String)
-> Maybe String
-> ExceptT String IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                     (Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
"")
                     (\String
e -> IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String String) -> ExceptT String IO String)
-> IO (Either String String) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Either String String
listToEither String
msgT ([String] -> Either String String)
-> IO [String] -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
executeXPath String
e String
def)
                     (XMLFormatInternal -> Maybe String
xfiExternalVarType XMLFormatInternal
xmlFormatInternal)

        ExternalVariableDef -> ExceptT String IO ExternalVariableDef
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalVariableDef -> ExceptT String IO ExternalVariableDef)
-> ExternalVariableDef -> ExceptT String IO ExternalVariableDef
forall a b. (a -> b) -> a -> b
$ ExternalVariableDef
                   { externalVariableName :: String
externalVariableName = String
varId
                   , externalVariableType :: String
externalVariableType = String
varType
                   }

  [ExternalVariableDef]
externalVariableDefs <- (String -> ExceptT String IO ExternalVariableDef)
-> [String] -> ExceptT String IO [ExternalVariableDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> ExceptT String IO ExternalVariableDef
externalVarDef [String]
extVarStrings

  -- Requirements

  -- reqStrings :: [String]
  [String]
reqStrings <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ExceptT String IO [String])
-> IO [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
executeXPath (XMLFormatInternal -> String
xfiRequirements XMLFormatInternal
xmlFormatInternal) String
value

  let -- requirementDef :: String -> ExceptT String (Requirement a)
      requirementDef :: String -> ExceptT String IO (Requirement a)
requirementDef String
def = do
        -- let msgI = "Requirement name: " ++ take 160 def
        String
reqId <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT String IO String)
-> IO String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ([String] -> Maybe String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> String) -> IO [String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   String -> String -> IO [String]
executeXPath (XMLFormatInternal -> String
xfiRequirementId XMLFormatInternal
xmlFormatInternal) String
def

        -- let msgE = "Requirement expression: " ++ take 160 def
        Maybe String
reqExpr <- IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ExceptT String IO (Maybe String))
-> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
                     [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       (String -> IO [String]) -> [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (String -> String -> IO [String]
`executeXPath` String
def) (XMLFormatInternal -> [String]
xfiRequirementExpr XMLFormatInternal
xmlFormatInternal)

        a
reqExpr' <- ExceptT String IO a
-> (String -> ExceptT String IO a)
-> Maybe String
-> ExceptT String IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> ExceptT String IO a
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
defA)
                          (IO (Either String a) -> ExceptT String IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String a) -> ExceptT String IO a)
-> (String -> IO (Either String a))
-> String
-> ExceptT String IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either String a)
parseExpr (String -> IO (Either String a))
-> ShowS -> String -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
textUnescape)
                          Maybe String
reqExpr

        -- let msgD = "Requirement description"
        String
reqDesc <- ExceptT String IO String
-> (String -> ExceptT String IO String)
-> Maybe String
-> ExceptT String IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                     (Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
"")
                     (\String
e -> IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT String IO String)
-> IO String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ([String] -> Maybe String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> String) -> IO [String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
executeXPath String
e String
def)
                     (XMLFormatInternal -> Maybe String
xfiRequirementDesc XMLFormatInternal
xmlFormatInternal)

        Maybe String
reqResType <- case XMLFormatInternal -> Maybe String
xfiRequirementResultType XMLFormatInternal
xmlFormatInternal of
                        Maybe String
Nothing -> Maybe String -> ExceptT String IO (Maybe String)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                        Just String
e  -> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ExceptT String IO (Maybe String))
-> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
executeXPath String
e String
def

        Maybe String
reqResExpr <- case XMLFormatInternal -> Maybe String
xfiRequirementResultExpr XMLFormatInternal
xmlFormatInternal of
                        Maybe String
Nothing -> Maybe String -> ExceptT String IO (Maybe String)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                        Just String
e  -> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ExceptT String IO (Maybe String))
-> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
executeXPath String
e String
def

        Maybe a
reqResExpr' <- ExceptT String IO (Maybe a)
-> (String -> ExceptT String IO (Maybe a))
-> Maybe String
-> ExceptT String IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> ExceptT String IO (Maybe a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
                         ((a -> Maybe a)
-> ExceptT String IO a -> ExceptT String IO (Maybe a)
forall a b. (a -> b) -> ExceptT String IO a -> ExceptT String IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (ExceptT String IO a -> ExceptT String IO (Maybe a))
-> (String -> ExceptT String IO a)
-> String
-> ExceptT String IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either String a) -> ExceptT String IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String a) -> ExceptT String IO a)
-> (String -> IO (Either String a))
-> String
-> ExceptT String IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either String a)
parseExpr (String -> IO (Either String a))
-> ShowS -> String -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
textUnescape)
                         Maybe String
reqResExpr

        Requirement a -> ExceptT String IO (Requirement a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Requirement a -> ExceptT String IO (Requirement a))
-> Requirement a -> ExceptT String IO (Requirement a)
forall a b. (a -> b) -> a -> b
$ Requirement
                   { requirementName :: String
requirementName        = String
reqId
                   , requirementExpr :: a
requirementExpr        = a
reqExpr'
                   , requirementDescription :: String
requirementDescription = String
reqDesc
                   , requirementResultType :: Maybe String
requirementResultType  = Maybe String
reqResType
                   , requirementResultExpr :: Maybe a
requirementResultExpr  = Maybe a
reqResExpr'
                   }

  [Requirement a]
requirements <- (String -> ExceptT String IO (Requirement a))
-> [String] -> ExceptT String IO [Requirement a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> ExceptT String IO (Requirement a)
requirementDef [String]
reqStrings

  -- Complete spec
  Spec a -> ExceptT String IO (Spec a)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec a -> ExceptT String IO (Spec a))
-> Spec a -> ExceptT String IO (Spec a)
forall a b. (a -> b) -> a -> b
$ [InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
forall a.
[InternalVariableDef]
-> [ExternalVariableDef] -> [Requirement a] -> Spec a
Spec [InternalVariableDef]
internalVariableDefs [ExternalVariableDef]
externalVariableDefs [Requirement a]
requirements

-- | Internal representation of an XML Format specification.
data XMLFormatInternal = XMLFormatInternal
  { XMLFormatInternal -> Maybe String
xfiInternalVars          :: Maybe XPathExpr
  , XMLFormatInternal -> String
xfiInternalVarId         :: XPathExpr
  , XMLFormatInternal -> String
xfiInternalVarExpr       :: XPathExpr
  , XMLFormatInternal -> Maybe String
xfiInternalVarType       :: Maybe XPathExpr
  , XMLFormatInternal -> Maybe String
xfiExternalVars          :: Maybe XPathExpr
  , XMLFormatInternal -> String
xfiExternalVarId         :: XPathExpr
  , XMLFormatInternal -> Maybe String
xfiExternalVarType       :: Maybe XPathExpr
  , XMLFormatInternal -> String
xfiRequirements          :: XPathExpr
  , XMLFormatInternal -> String
xfiRequirementId         :: XPathExpr
  , XMLFormatInternal -> Maybe String
xfiRequirementDesc       :: Maybe XPathExpr
  , XMLFormatInternal -> [String]
xfiRequirementExpr       :: [XPathExpr]
  , XMLFormatInternal -> Maybe String
xfiRequirementResultType :: Maybe XPathExpr
  , XMLFormatInternal -> Maybe String
xfiRequirementResultExpr :: Maybe XPathExpr
  }

-- | Internal representation of an XPath expression.
type XPathExpr = String

-- | Resolve an indirect XPath query, returning an XPath expression.
resolveIndirectly :: String
                  -> (String, Maybe (String, String))
                  -> ExceptT String IO XPathExpr
resolveIndirectly :: String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
_ (String
query, Maybe (String, String)
Nothing) =
  Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr String
query

resolveIndirectly String
xml (String
query, Just (String
key, String
val)) = do
  -- Check that the given query string parses correctly.
  String
_ <- Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr String
val

  [String]
v  <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ExceptT String IO [String])
-> IO [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
executeXPath String
val String
xml
  case [String]
v of
    (String
f:[String]
_) -> do let query' :: String
query' = String -> String -> ShowS
replace String
query String
key String
f
                Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr String
query'
    [String]
_     -> String -> ExceptT String IO String
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$
               String
"Substitution path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
val String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in file."

-- | Resolve an indirect XPath query, returning a list of XPath expressions.
resolveIndirectly' :: String
                   -> (String, Maybe (String, String))
                   -> ExceptT String IO [XPathExpr]
resolveIndirectly' :: String
-> (String, Maybe (String, String)) -> ExceptT String IO [String]
resolveIndirectly' String
_ (String
query, Maybe (String, String)
Nothing) =
  (String -> [String])
-> ExceptT String IO String -> ExceptT String IO [String]
forall a b. (a -> b) -> ExceptT String IO a -> ExceptT String IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (ExceptT String IO String -> ExceptT String IO [String])
-> ExceptT String IO String -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr String
query

resolveIndirectly' String
xml (String
query, Just (String
key, String
val)) = do
  -- Check that the given query string parses correctly.
  String
_ <- Either String String -> ExceptT String IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String String -> ExceptT String IO String)
-> Either String String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr String
val

  [String]
v  <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ExceptT String IO [String])
-> IO [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
executeXPath String
val String
xml
  case [String]
v of
    [] -> String -> ExceptT String IO [String]
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO [String])
-> String -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ String
"Substitution path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
val String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in file."
    [String]
fs -> do let queries :: [String]
queries = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> ShowS
replace String
query String
key) [String]
fs
             Either String [String] -> ExceptT String IO [String]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String [String] -> ExceptT String IO [String])
-> Either String [String] -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Either String String)
-> [String] -> Either String [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> Either String String
checkXPathExpr [String]
queries

-- | Check that an XPath expression is syntactically correct.
checkXPathExpr :: String -> Either String XPathExpr
checkXPathExpr :: String -> Either String String
checkXPathExpr String
s = String
s String -> Either String Expr -> Either String String
forall a b. a -> Either String b -> Either String a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Either String Expr
parseXPathExpr String
s

-- | Check an XMLFormat and return an internal representation.
--
-- Fails with an error message if any of the given expressions are not a valid
-- XPath expression.
parseXMLFormat :: XMLFormat -> String -> ExceptT String IO XMLFormatInternal
parseXMLFormat :: XMLFormat -> String -> ExceptT String IO XMLFormatInternal
parseXMLFormat XMLFormat
xmlFormat String
file = do
  Maybe String
xfi2  <- Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String (Maybe String) -> ExceptT String IO (Maybe String))
-> Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe (Either String String) -> Either String (Maybe String)
forall a b. Maybe (Either a b) -> Either a (Maybe b)
swapMaybeEither
                      (Maybe (Either String String) -> Either String (Maybe String))
-> Maybe (Either String String) -> Either String (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr (String -> Either String String)
-> Maybe String -> Maybe (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe String
specInternalVars XMLFormat
xmlFormat

  String
xfi3  <- String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> (String, Maybe (String, String)) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specInternalVarId XMLFormat
xmlFormat

  String
xfi4  <- String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> (String, Maybe (String, String)) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specInternalVarExpr XMLFormat
xmlFormat

  Maybe String
xfi5  <- Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT (Maybe (ExceptT String IO String)
 -> ExceptT String IO (Maybe String))
-> Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> Maybe (String, Maybe (String, String))
-> Maybe (ExceptT String IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe (String, Maybe (String, String))
specInternalVarType XMLFormat
xmlFormat

  Maybe String
xfi6  <- Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String (Maybe String) -> ExceptT String IO (Maybe String))
-> Either String (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             Maybe (Either String String) -> Either String (Maybe String)
forall a b. Maybe (Either a b) -> Either a (Maybe b)
swapMaybeEither (Maybe (Either String String) -> Either String (Maybe String))
-> Maybe (Either String String) -> Either String (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
checkXPathExpr (String -> Either String String)
-> Maybe String -> Maybe (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe String
specExternalVars XMLFormat
xmlFormat

  String
xfi7  <- String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> (String, Maybe (String, String)) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specExternalVarId XMLFormat
xmlFormat

  Maybe String
xfi8  <- Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT (Maybe (ExceptT String IO String)
 -> ExceptT String IO (Maybe String))
-> Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> Maybe (String, Maybe (String, String))
-> Maybe (ExceptT String IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe (String, Maybe (String, String))
specExternalVarType XMLFormat
xmlFormat

  String
xfi9  <- String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> (String, Maybe (String, String)) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specRequirements XMLFormat
xmlFormat

  String
xfi10 <- String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> (String, Maybe (String, String)) -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specRequirementId XMLFormat
xmlFormat

  Maybe String
xfi11 <- Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT (Maybe (ExceptT String IO String)
 -> ExceptT String IO (Maybe String))
-> Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> Maybe (String, Maybe (String, String))
-> Maybe (ExceptT String IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementDesc XMLFormat
xmlFormat

  [String]
xfi12 <- String
-> (String, Maybe (String, String)) -> ExceptT String IO [String]
resolveIndirectly' String
file ((String, Maybe (String, String)) -> ExceptT String IO [String])
-> (String, Maybe (String, String)) -> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ XMLFormat -> (String, Maybe (String, String))
specRequirementExpr XMLFormat
xmlFormat

  Maybe String
xfi13 <- Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT (Maybe (ExceptT String IO String)
 -> ExceptT String IO (Maybe String))
-> Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> Maybe (String, Maybe (String, String))
-> Maybe (ExceptT String IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementResultType XMLFormat
xmlFormat

  Maybe String
xfi14 <- Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT (Maybe (ExceptT String IO String)
 -> ExceptT String IO (Maybe String))
-> Maybe (ExceptT String IO String)
-> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
             String
-> (String, Maybe (String, String)) -> ExceptT String IO String
resolveIndirectly String
file ((String, Maybe (String, String)) -> ExceptT String IO String)
-> Maybe (String, Maybe (String, String))
-> Maybe (ExceptT String IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLFormat -> Maybe (String, Maybe (String, String))
specRequirementResultExpr XMLFormat
xmlFormat

  XMLFormatInternal -> ExceptT String IO XMLFormatInternal
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (XMLFormatInternal -> ExceptT String IO XMLFormatInternal)
-> XMLFormatInternal -> ExceptT String IO XMLFormatInternal
forall a b. (a -> b) -> a -> b
$ XMLFormatInternal
             { xfiInternalVars :: Maybe String
xfiInternalVars          = Maybe String
xfi2
             , xfiInternalVarId :: String
xfiInternalVarId         = String
xfi3
             , xfiInternalVarExpr :: String
xfiInternalVarExpr       = String
xfi4
             , xfiInternalVarType :: Maybe String
xfiInternalVarType       = Maybe String
xfi5
             , xfiExternalVars :: Maybe String
xfiExternalVars          = Maybe String
xfi6
             , xfiExternalVarId :: String
xfiExternalVarId         = String
xfi7
             , xfiExternalVarType :: Maybe String
xfiExternalVarType       = Maybe String
xfi8
             , xfiRequirements :: String
xfiRequirements          = String
xfi9
             , xfiRequirementId :: String
xfiRequirementId         = String
xfi10
             , xfiRequirementDesc :: Maybe String
xfiRequirementDesc       = Maybe String
xfi11
             , xfiRequirementExpr :: [String]
xfiRequirementExpr       = [String]
xfi12
             , xfiRequirementResultType :: Maybe String
xfiRequirementResultType = Maybe String
xfi13
             , xfiRequirementResultExpr :: Maybe String
xfiRequirementResultExpr = Maybe String
xfi14
             }

-- | Execute an XPath query in an XML string, returning the list of strings
-- that match the path.
executeXPath :: String -> String -> IO [String]
executeXPath :: String -> String -> IO [String]
executeXPath String
query String
string = do
  let config :: [SysConfig]
config = [ Bool -> SysConfig
withValidate Bool
no
               , Bool -> SysConfig
withRedirect Bool
no
               , Bool -> SysConfig
withCanonicalize Bool
no
               , Bool -> SysConfig
withRemoveWS Bool
yes
               , Bool -> SysConfig
withSubstDTDEntities Bool
no
               , SysConfig
withOutputPLAIN
               , Bool -> SysConfig
withSubstHTMLEntities Bool
no
               ]
  [XmlTree]
v <- IOSArrow XmlTree XmlTree -> IO [XmlTree]
forall c. IOSArrow XmlTree c -> IO [c]
runX (IOSArrow XmlTree XmlTree -> IO [XmlTree])
-> IOSArrow XmlTree XmlTree -> IO [XmlTree]
forall a b. (a -> b) -> a -> b
$ [SysConfig] -> IOSArrow XmlTree XmlTree
forall s c. [SysConfig] -> IOStateArrow s c c
configSysVars [SysConfig]
config
              IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([SysConfig] -> String -> IOSArrow XmlTree XmlTree
forall s b. [SysConfig] -> String -> IOStateArrow s b XmlTree
readString [SysConfig]
config String
string IOSArrow XmlTree XmlTree
-> IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
getXPathTrees String
query)

  let u :: [String]
u = (XmlTree -> String) -> [XmlTree] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> String
flattenDoc (Doc -> String) -> (XmlTree -> Doc) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Doc
forall x. Pretty x => x -> Doc
pretty ([XmlTree] -> Doc) -> (XmlTree -> [XmlTree]) -> XmlTree -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlTree -> [XmlTree] -> [XmlTree]
forall a. a -> [a] -> [a]
:[])) [XmlTree]
v

  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
u

-- * Auxiliary

-- | Unescape @'<'@, @'>'@ and @'&'@ in a string.
textUnescape :: String -> String
textUnescape :: ShowS
textUnescape (Char
'&':Char
'l':Char
't':Char
';':String
xs)        = Char
'<' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
textUnescape String
xs
textUnescape (Char
'&':Char
'g':Char
't':Char
';':String
xs)        = Char
'>' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
textUnescape String
xs
textUnescape (Char
'&':Char
'a':Char
'm': Char
'p' : Char
';':String
xs) = Char
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
textUnescape String
xs
textUnescape (Char
x:String
xs)                      = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
textUnescape String
xs
textUnescape []                          = []

-- | Swap the Maybe and Either layers of a value.
swapMaybeEither :: Maybe (Either a b) -> Either a (Maybe b)
swapMaybeEither :: forall a b. Maybe (Either a b) -> Either a (Maybe b)
swapMaybeEither Maybe (Either a b)
Nothing          = Maybe b -> Either a (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
swapMaybeEither (Just (Left a
s))  = a -> Either a (Maybe b)
forall a b. a -> Either a b
Left a
s
swapMaybeEither (Just (Right b
x)) = Maybe b -> Either a (Maybe b)
forall a b. b -> Either a b
Right (Maybe b -> Either a (Maybe b)) -> Maybe b -> Either a (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
x

-- | Swap the Maybe and Either layers of a value.
swapMaybeExceptT :: Monad m => Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT :: forall (m :: * -> *) a b.
Monad m =>
Maybe (ExceptT a m b) -> ExceptT a m (Maybe b)
swapMaybeExceptT Maybe (ExceptT a m b)
Nothing  = Maybe b -> ExceptT a m (Maybe b)
forall a. a -> ExceptT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
swapMaybeExceptT (Just ExceptT a m b
e) = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> ExceptT a m b -> ExceptT a m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT a m b
e

-- | Convert a list to an Either, failing if the list provided does not have
-- exactly one value.
listToEither :: String -> [String] -> Either String String
listToEither :: String -> [String] -> Either String String
listToEither String
_   [String
x] = String -> Either String String
forall a b. b -> Either a b
Right String
x
listToEither String
msg []  = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Failed to find a value for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
listToEither String
msg [String]
_   = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Unexpectedly found multiple values for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

-- | Replace a string by another string
replace :: String -> String -> String -> String
replace :: String -> String -> ShowS
replace []           String
_k  String
_v    = []
replace string :: String
string@(Char
h:String
t) String
key String
value
  | String
key String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
string
  = String
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> String -> ShowS
replace (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
key) String
string) String
key String
value
  | Bool
otherwise
  = Char
h Char -> ShowS
forall a. a -> [a] -> [a]
: String -> String -> ShowS
replace String
t String
key String
value

-- | Map a monadic action over the elements of a container and concatenate the
-- resulting lists.
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f = ([[b]] -> [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[b]] -> m [b]) -> ([a] -> m [[b]]) -> [a] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m [b]
f