    -- Copyright 2024 United States Government as represented by the Administrator
    -- of the National Aeronautics and Space Administration. All Rights Reserved.
    --
    -- Licensed under the Apache License, Version 2.0 (the "License"); you may
    -- not use this file except in compliance with the License. You may obtain a
    -- copy of the License at
    --
    --      https://www.apache.org/licenses/LICENSE-2.0
    --
    -- Unless required by applicable law or agreed to in writing, software
    -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
    -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
    -- License for the specific language governing permissions and limitations
    -- under the License.

    -- | 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 <- XMLFormat -> String -> ExceptT String IO XMLFormatInternal
    parseXMLFormat XMLFormat
    xmlFormat String
    value

      -- Internal variables

      -- intVarStrings :: [String]
      intVarStrings <- liftIO $ maybe
                                  (return [])
                                  (`executeXPath` value)
                                  (xfiInternalVars xmlFormatInternal)

      let internalVarDef :: String -> ExceptT String IO InternalVariableDef
          internalVarDef String
    def = do
            let msgI :: String
    msgI = String
    "internal variable name"
            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
    "internal variable type"
            varType <- maybe
                         (liftEither $ Right "")
                         (\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)
                         (xfiInternalVarType xmlFormatInternal)

            let msgE = String
    "internal variable expr"
            varExpr <- ExceptT $
                         listToEither msgE <$>
                         executeXPath (xfiInternalVarExpr xmlFormatInternal) def

            return $ InternalVariableDef
                       { internalVariableName = varId
                       , internalVariableType = varType
                       , internalVariableExpr = varExpr
                       }

      internalVariableDefs <- mapM internalVarDef intVarStrings

      -- External variables

      -- extVarStrings :: [String]
      extVarStrings <- liftIO $ maybe
                                  (return [])
                                  (`executeXPath` value)
                                  (xfiExternalVars xmlFormatInternal)

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

            let msgI :: String
    msgI = String
    "external variable name"
            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
    "external variable type"
            varType <- maybe
                         (liftEither $ Right "")
                         (\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)
                         (xfiExternalVarType xmlFormatInternal)

            return $ ExternalVariableDef
                       { externalVariableName = varId
                       , externalVariableType = varType
                       }

      externalVariableDefs <- mapM externalVarDef extVarStrings

      -- Requirements

      -- reqStrings :: [String]
      reqStrings <- liftIO $ executeXPath (xfiRequirements xmlFormatInternal) value

      let -- requirementDef :: String -> ExceptT String (Requirement a)
          requirementDef String
    def = do
            -- let msgI = "Requirement name: " ++ take 160 def
            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
            reqExpr <- liftIO $
                         listToMaybe <$>
                           concatMapM (`executeXPath` def) (xfiRequirementExpr xmlFormatInternal)

            reqExpr' <- maybe (return defA)
                              (ExceptT . parseExpr . textUnescape)
                              reqExpr

            -- let msgD = "Requirement description"
            reqDesc <- maybe
                         (liftEither $ Right "")
                         (\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)
                         (xfiRequirementDesc xmlFormatInternal)

            reqResType <- case xfiRequirementResultType 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

            reqResExpr <- case xfiRequirementResultExpr 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

            reqResExpr' <- maybe (return Nothing)
                             (fmap Just . ExceptT . parseExpr . textUnescape)
                             reqResExpr

            return $ Requirement
                       { requirementName        = reqId
                       , requirementExpr        = reqExpr'
                       , requirementDescription = reqDesc
                       , requirementResultType  = reqResType
                       , requirementResultExpr  = reqResExpr'
                       }

      requirements <- mapM requirementDef reqStrings

      -- Complete spec
      return $ Spec internalVariableDefs externalVariableDefs 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.
      _ <- 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

      v  <- liftIO $ executeXPath val xml
      case 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.
      _ <- 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

      v  <- liftIO $ executeXPath val xml
      case 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
      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

      xfi3  <- resolveIndirectly file $ specInternalVarId xmlFormat

      xfi4  <- resolveIndirectly file $ specInternalVarExpr xmlFormat

      xfi5  <- swapMaybeExceptT $
                 resolveIndirectly file <$> specInternalVarType xmlFormat

      xfi6  <- liftEither $
                 swapMaybeEither $ checkXPathExpr <$> specExternalVars xmlFormat

      xfi7  <- resolveIndirectly file $ specExternalVarId xmlFormat

      xfi8  <- swapMaybeExceptT $
                 resolveIndirectly file <$> specExternalVarType xmlFormat

      xfi9  <- resolveIndirectly file $ specRequirements xmlFormat

      xfi10 <- resolveIndirectly file $ specRequirementId xmlFormat

      xfi11 <- swapMaybeExceptT $
                 resolveIndirectly file <$> specRequirementDesc xmlFormat

      xfi12 <- resolveIndirectly' file $ specRequirementExpr xmlFormat

      xfi13 <- swapMaybeExceptT $
                 resolveIndirectly file <$> specRequirementResultType xmlFormat

      xfi14 <- swapMaybeExceptT $
                 resolveIndirectly file <$> specRequirementResultExpr xmlFormat

      return $ XMLFormatInternal
                 { xfiInternalVars          = xfi2
                 , xfiInternalVarId         = xfi3
                 , xfiInternalVarExpr       = xfi4
                 , xfiInternalVarType       = xfi5
                 , xfiExternalVars          = xfi6
                 , xfiExternalVarId         = xfi7
                 , xfiExternalVarType       = xfi8
                 , xfiRequirements          = xfi9
                 , xfiRequirementId         = xfi10
                 , xfiRequirementDesc       = xfi11
                 , xfiRequirementExpr       = xfi12
                 , xfiRequirementResultType = xfi13
                 , xfiRequirementResultExpr = 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
                   ]
      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 = (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

      return 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