    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}

    --------------------------------------------------------------------------------
    --  See end of this file for licence information.
    --------------------------------------------------------------------------------
    -- |
    --  Module      :  Utils
    --  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018, 2022 Douglas Burke
    --  License     :  GPL V2
    --
    --  Maintainer  :  Douglas Burke
    --  Stability   :  experimental
    --  Portability :  CPP, OverloadedStrings
    --
    --  Support for the RDF Parsing modules.
    --
    --------------------------------------------------------------------------------

    module Swish.RDF.Parser.Utils
        ( SpecialMap
        -- , mapPrefix

        -- tables
        , prefixTable, specialTable

        -- parser
        , runParserWithError
        , ParseResult
        , ignore
        , char
        , ichar
        , string
        , stringT
        , symbol
        , isymbol
        , lexeme
        , notFollowedBy
        , whiteSpace
        , skipMany
        , skipMany1
        , endBy
        , sepEndBy
        , sepEndBy1
        , manyTill
        , noneOf
        , eoln
        , fullStop
        , hex4
        , hex8
        , appendURIs
        )
        where

    import Swish.Namespace (Namespace, makeNamespace, ScopedName)

    import Swish.RDF.Graph (RDFGraph)
    import Swish.RDF.Vocabulary
        ( namespaceRDF
        , namespaceRDFS
        , namespaceRDFD
        , namespaceOWL
        , namespaceLOG
        , rdfType
        , rdfFirst, rdfRest, rdfNil
        , owlSameAs, logImplies
        , defaultBase
        )

    import Data.Char (isSpace, isHexDigit, chr)

    #if MIN_VERSION_base(4, 7, 0)
    import Data.Functor (($>))
    #endif

    import Data.Maybe (fromMaybe, fromJust)

    import Network.URI (URI(..), relativeTo, parseURIReference)

    import Text.ParserCombinators.Poly.StateText

    import qualified Data.Map       as M
    import qualified Data.Text      as T
    import qualified Data.Text.Lazy as L
    import qualified Data.Text.Read as R

    #if !MIN_VERSION_base(4, 7, 0)
    ($>) :: Functor f => f a -> b -> f b
    ($>) = flip (<$)
    #endif

    -- Code

    -- | Append the two URIs. Given the change in signature of
    --   `Network.URI.relativeTo` in version @2.4.0.0@ of @network@,
    --   it is not clear that this function is necessary. At the
    --   very least, it should be changed to just return a `URI`.
    --
    appendURIs ::
      URI     -- ^ The base URI
      -> URI  -- ^ The URI to append (it can be an absolute URI).
      -> Either String URI
    appendURIs :: URI -> URI -> Either String URI
    appendURIs URI
    base URI
    uri =
      case URI -> String
    uriScheme URI
    uri of
        String
    "" -> URI -> Either String URI
    forall a b. b -> Either a b
    Right (URI -> Either String URI) -> URI -> Either String URI
    forall a b. (a -> b) -> a -> b
    $ URI
    uri URI -> URI -> URI
    `relativeTo` URI
    base
        String
    _  -> URI -> Either String URI
    forall a b. b -> Either a b
    Right URI
    uri

    -- | Type for special name lookup table
    type SpecialMap = M.Map String ScopedName

    -- | Define default table of namespaces
    prefixTable :: [Namespace]
    prefixTable :: [Namespace]
    prefixTable =   [ Namespace
    namespaceRDF
                    , Namespace
    namespaceRDFS
                    , Namespace
    namespaceRDFD     -- datatypes
                    , Namespace
    namespaceOWL
                    , Namespace
    namespaceLOG
                    , Maybe Text -> URI -> Namespace
    makeNamespace Maybe Text
    forall a. Maybe a
    Nothing (URI -> Namespace) -> URI -> Namespace
    forall a b. (a -> b) -> a -> b
    $ Maybe URI -> URI
    forall a. HasCallStack => Maybe a -> a
    fromJust (String -> Maybe URI
    parseURIReference String
    "#") -- is this correct?
                    ]

    -- | Define default special-URI table.
    specialTable ::
        Maybe ScopedName  -- ^ initial base URI, otherwise uses 'defaultBase'
        -> [(String,ScopedName)]
    specialTable :: Maybe ScopedName -> [(String, ScopedName)]
    specialTable Maybe ScopedName
    mbase =
      [ (String
    "a",         ScopedName
    rdfType    ),
        (String
    "equals",    ScopedName
    owlSameAs  ),
        (String
    "implies",   ScopedName
    logImplies ),
        (String
    "listfirst", ScopedName
    rdfFirst   ),
        (String
    "listrest",  ScopedName
    rdfRest    ),
        (String
    "listnull",  ScopedName
    rdfNil     ),
        (String
    "base",      ScopedName -> Maybe ScopedName -> ScopedName
    forall a. a -> Maybe a -> a
    fromMaybe ScopedName
    defaultBase Maybe ScopedName
    mbase )
      ]

    -- Parser routines, heavily based on Parsec combinators

    -- | Run the parser and return the successful parse or an error
    -- message which consists of the standard Polyparse error plus
    -- a fragment of the unparsed input to provide context.
    --
    runParserWithError ::
      Parser a b -- ^ parser (carrying state) to apply
      -> a       -- ^ starting state for the parser
      -> L.Text       -- ^ input to be parsed
      -> Either String b
    runParserWithError :: forall a b. Parser a b -> a -> Text -> Either String b
    runParserWithError Parser a b
    parser a
    state0 Text
    input =
      let (Either String b
    result, a
    _, Text
    unparsed) = Parser a b -> a -> Text -> (Either String b, a, Text)
    forall s a. Parser s a -> s -> Text -> (Either String a, s, Text)
    runParser Parser a b
    parser a
    state0 Text
    input

          -- TODO: work out how best to report error context; for now just take the
          -- next 40 characters and assume there is enough context.
          econtext :: String
    econtext = if Text -> Bool
    L.null Text
    unparsed
                     then String
    "\n(at end of the text)\n"
                     else String
    "\nRemaining input:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                          case Text -> Int64 -> Ordering
    L.compareLength Text
    unparsed Int64
    40 of
                            Ordering
    GT -> Text -> String
    L.unpack (Int64 -> Text -> Text
    L.take Int64
    40 Text
    unparsed) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "..."
                            Ordering
    _ -> Text -> String
    L.unpack Text
    unparsed

      in case Either String b
    result of
        Left String
    emsg -> String -> Either String b
    forall a b. a -> Either a b
    Left (String -> Either String b) -> String -> Either String b
    forall a b. (a -> b) -> a -> b
    $ String
    emsg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    econtext
        Either String b
    _ -> Either String b
    result

    -- | The result of a parse, which is either an error message or a graph.
    type ParseResult = Either String RDFGraph

    -- | Run the parser and ignore the result.
    ignore :: (Applicative f) => f a -> f ()
    ignore :: forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore f a
    f = f a
    f f a -> () -> f ()
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ()

    -- | Match the character.
    char :: Char -> Parser s Char
    char :: forall s. Char -> Parser s Char
    char Char
    c = (Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c)

    -- | Match the character, ignoring the result.
    ichar :: Char -> Parser s ()
    ichar :: forall s. Char -> Parser s ()
    ichar = Parser s Char -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore (Parser s Char -> Parser s ())
    -> (Char -> Parser s Char) -> Char -> Parser s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Parser s Char
    forall s. Char -> Parser s Char
    char

    -- TODO: is there a better way to do this?
    -- | Match the text.
    string :: String -> Parser s String
    string :: forall s. String -> Parser s String
    string = (Char -> Parser s Char) -> String -> Parser s 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 Char -> Parser s Char
    forall s. Char -> Parser s Char
    char

    -- | Match the text.
    stringT :: T.Text -> Parser s T.Text
    stringT :: forall s. Text -> Parser s Text
    stringT Text
    s = String -> Parser s String
    forall s. String -> Parser s String
    string (Text -> String
    T.unpack Text
    s) Parser s String -> Parser s Text -> Parser s Text
    forall a b. Parser s a -> Parser s b -> Parser s b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> Parser s Text
    forall a. a -> Parser s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s

    -- | Run the parser 'many' times and ignore the result.
    skipMany :: Parser s a -> Parser s ()
    skipMany :: forall s a. Parser s a -> Parser s ()
    skipMany = Parser s [a] -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore (Parser s [a] -> Parser s ())
    -> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Parser s a -> Parser s [a]
    forall a. Parser s a -> Parser s [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many

    -- | Run the parser 'many1' times and ignore the result.
    skipMany1 :: Parser s a -> Parser s ()
    skipMany1 :: forall s a. Parser s a -> Parser s ()
    skipMany1 = Parser s [a] -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore (Parser s [a] -> Parser s ())
    -> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Parser s a -> Parser s [a]
    forall (p :: * -> *) a. PolyParse p => p a -> p [a]
    many1

    -- | Match zero or more occurences of
    -- parser followed by separator.
    endBy ::
        Parser s a    -- ^ parser
        -> Parser s b -- ^ separator
        -> Parser s [a]
    endBy :: forall s a b. Parser s a -> Parser s b -> Parser s [a]
    endBy Parser s a
    p Parser s b
    sep = Parser s a -> Parser s [a]
    forall a. Parser s a -> Parser s [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Parser s a
    p Parser s a -> Parser s b -> Parser s a
    forall a b. Parser s a -> Parser s b -> Parser s a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser s b
    sep)

    -- | Match zero or more occurences of the parser followed
    -- by the separator.
    sepEndBy ::
        Parser s a    -- ^ parser
        -> Parser s b -- ^ separator
        -> Parser s [a]
    sepEndBy :: forall s a b. Parser s a -> Parser s b -> Parser s [a]
    sepEndBy Parser s a
    p Parser s b
    sep = Parser s a -> Parser s b -> Parser s [a]
    forall s a b. Parser s a -> Parser s b -> Parser s [a]
    sepEndBy1 Parser s a
    p Parser s b
    sep Parser s [a] -> Parser s [a] -> Parser s [a]
    forall a. Parser s a -> Parser s a -> Parser s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [a] -> Parser s [a]
    forall a. a -> Parser s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []

    -- | Accept one or more occurences of the parser
    -- separated by the separator. Unlike 'endBy' the
    -- last separator is optional.
    sepEndBy1 ::
        Parser s a    -- ^ parser
        -> Parser s b -- ^ separator
        -> Parser s [a]
    sepEndBy1 :: forall s a b. Parser s a -> Parser s b -> Parser s [a]
    sepEndBy1 Parser s a
    p Parser s b
    sep = do
      a
    x <- Parser s a
    p
      (Parser s b
    sep Parser s b -> Parser s [a] -> Parser s [a]
    forall a b. Parser s a -> Parser s b -> Parser s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ((a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> [a]) -> Parser s [a] -> Parser s [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser s a -> Parser s b -> Parser s [a]
    forall s a b. Parser s a -> Parser s b -> Parser s [a]
    sepEndBy Parser s a
    p Parser s b
    sep)) Parser s [a] -> Parser s [a] -> Parser s [a]
    forall a. Parser s a -> Parser s a -> Parser s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [a] -> Parser s [a]
    forall a. a -> Parser s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [a
    x]

    -- | Accept zero or more runs of the parser
    -- ending with the delimiter.
    manyTill ::
        Parser s a    -- ^ parser
        -> Parser s b -- ^ delimiter
        -> Parser s [a]
    manyTill :: forall s a b. Parser s a -> Parser s b -> Parser s [a]
    manyTill Parser s a
    p Parser s b
    end = Parser s [a]
    go
      where
        go :: Parser s [a]
    go = (Parser s b
    end Parser s b -> [a] -> Parser s [a]
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> [])
             Parser s [a] -> Parser s [a] -> Parser s [a]
    forall a. Parser s a -> Parser s a -> Parser s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
             ((:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser s a
    p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
    forall a b. Parser s (a -> b) -> Parser s a -> Parser s b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser s [a]
    go)

    -- | Accept any character that is not a member of the given string.
    noneOf :: String -> Parser s Char
    noneOf :: forall s. String -> Parser s Char
    noneOf String
    istr = (Char -> Bool) -> Parser s Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfy (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` String
    istr)

    -- | Matches '.'.
    fullStop :: Parser s ()
    fullStop :: forall s. Parser s ()
    fullStop = Char -> Parser s ()
    forall s. Char -> Parser s ()
    ichar Char
    '.'

    -- | Match the end-of-line sequence (@"\\n"@, @"\\r"@, or @"\\r\\n"@).
    eoln :: Parser s ()
    -- eoln = ignore (newline <|> (lineFeed *> optional newline))
    -- eoln = ignore (try (string "\r\n") <|> string "\r" <|> string "\n")
    eoln :: forall s. Parser s ()
    eoln = Parser s String -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore ([Parser s String] -> Parser s String
    forall (p :: * -> *) a. PolyParse p => [p a] -> p a
    oneOf [String -> Parser s String
    forall s. String -> Parser s String
    string String
    "\r\n", String -> Parser s String
    forall s. String -> Parser s String
    string String
    "\r", String -> Parser s String
    forall s. String -> Parser s String
    string String
    "\n"])

    -- | Succeed if the next character does not match the given function.
    notFollowedBy :: (Char -> Bool) -> Parser s ()
    notFollowedBy :: forall s. (Char -> Bool) -> Parser s ()
    notFollowedBy Char -> Bool
    p = do
      Char
    c <- Parser s Char
    forall s. Parser s Char
    next
      if Char -> Bool
    p Char
    c
        then String -> Parser s ()
    forall a. String -> Parser s a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Parser s ()) -> String -> Parser s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected character: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show [Char
    c]
        else Text -> Parser s ()
    forall s. Text -> Parser s ()
    reparse (Text -> Parser s ()) -> Text -> Parser s ()
    forall a b. (a -> b) -> a -> b
    $ Char -> Text
    L.singleton Char
    c

    -- | Match the given string and any trailing 'whiteSpace'.
    symbol :: String -> Parser s String
    symbol :: forall s. String -> Parser s String
    symbol = Parser s String -> Parser s String
    forall s a. Parser s a -> Parser s a
    lexeme (Parser s String -> Parser s String)
    -> (String -> Parser s String) -> String -> Parser s String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Parser s String
    forall s. String -> Parser s String
    string

    -- | As 'symbol' but ignoring the result.
    isymbol :: String -> Parser s ()
    isymbol :: forall s. String -> Parser s ()
    isymbol = Parser s String -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore (Parser s String -> Parser s ())
    -> (String -> Parser s String) -> String -> Parser s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Parser s String
    forall s. String -> Parser s String
    symbol

    -- | Convert a parser into one that also matches, and ignores,
    -- trailing 'whiteSpace'.
    lexeme :: Parser s a -> Parser s a
    lexeme :: forall s a. Parser s a -> Parser s a
    lexeme Parser s a
    p = Parser s a
    p Parser s a -> Parser s () -> Parser s a
    forall a b. Parser s a -> Parser s b -> Parser s a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser s ()
    forall s. Parser s ()
    whiteSpace

    -- | Match white space: a space or a comment (@#@ character and anything following it
    -- up to to a new line).
    whiteSpace :: Parser s ()
    whiteSpace :: forall s. Parser s ()
    whiteSpace = Parser s () -> Parser s ()
    forall s a. Parser s a -> Parser s ()
    skipMany (Parser s ()
    forall s. Parser s ()
    simpleSpace Parser s () -> Parser s () -> Parser s ()
    forall a. Parser s a -> Parser s a -> Parser s a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser s ()
    forall s. Parser s ()
    oneLineComment)

    simpleSpace :: Parser s ()
    simpleSpace :: forall s. Parser s ()
    simpleSpace = Parser s Text -> Parser s ()
    forall (f :: * -> *) a. Applicative f => f a -> f ()
    ignore (Parser s Text -> Parser s ()) -> Parser s Text -> Parser s ()
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Parser s Text
    forall s. (Char -> Bool) -> Parser s Text
    many1Satisfy Char -> Bool
    isSpace

    -- TODO: this should use eoln rather than a check on \n
    oneLineComment :: Parser s ()
    oneLineComment :: forall s. Parser s ()
    oneLineComment = (Char -> Parser s ()
    forall s. Char -> Parser s ()
    ichar Char
    '#' Parser s () -> Parser s Text -> Parser s Text
    forall a b. Parser s a -> Parser s b -> Parser s b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Char -> Bool) -> Parser s Text
    forall s. (Char -> Bool) -> Parser s Text
    manySatisfy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')) Parser s Text -> () -> Parser s ()
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ()

    {-

    Not sure we can get this with polyparse

    -- | Annotate a Parsec error with the local context - i.e. the actual text
    -- that caused the error and preceeding/succeeding lines (if available)
    --
    annotateParsecError ::
        Int -- ^ the number of extra lines to include in the context (<=0 is ignored)
        -> [String] -- ^ text being parsed
        -> ParseError -- ^ the parse error
        -> String -- ^ Parsec error with additional context
    annotateParsecError extraLines ls err =
        -- the following is based on the show instance of ParseError
        let ePos = errorPos err
            lNum = sourceLine ePos
            cNum = sourceColumn ePos
            -- it is possible to be at the end of the input so need
            -- to check; should produce better output than this in this
            -- case
            nLines = length ls
            ln1 = lNum - 1
            eln = max 0 extraLines
            lNums = [max 0 (ln1 - eln) .. min (nLines-1) (ln1 + eln)]

            beforeLines = map (ls !!) $ filter (< ln1) lNums
            afterLines  = map (ls !!) $ filter (> ln1) lNums

            -- in testing was able to get a line number after the text so catch this
            -- case; is it still necessary?
            errorLine = if ln1 >= nLines then "" else ls !! ln1
            arrowLine = replicate (cNum-1) ' ' ++ "^"
            finalLine = "(line " ++ show lNum ++ ", column " ++ show cNum ++ " indicated by the '^' sign above):"

            eHdr = "" : beforeLines ++ errorLine : arrowLine : afterLines ++ [finalLine]
            eMsg = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input"
                   (errorMessages err)

        in unlines eHdr ++ eMsg

    -}

    {-
    Handle hex encoding; the spec for N3 and NTriples suggest that
    only upper-case A..F are valid but you can find lower-case values
    out there so support these too.
    -}

    hexDigit :: Parser a Char
    -- hexDigit = satisfy (`elem` ['0'..'9'] ++ ['A'..'F'])
    hexDigit :: forall s. Parser s Char
    hexDigit = (Char -> Bool) -> Parser a Char
    forall s. (Char -> Bool) -> Parser s Char
    satisfy Char -> Bool
    isHexDigit

    -- | A four-digit hex value (e.g. @1a34@ or @03F1@).
    hex4 :: Parser a Char
    hex4 :: forall s. Parser s Char
    hex4 = do
      String
    digs <- Int -> Parser a Char -> Parser a String
    forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
    exactly Int
    4 Parser a Char
    forall s. Parser s Char
    hexDigit
      let mhex :: Either String (Int, Text)
    mhex = Reader Int
    forall a. Integral a => Reader a
    R.hexadecimal (String -> Text
    T.pack String
    digs)
      case Either String (Int, Text)
    mhex of
        Left String
    emsg     -> String -> Parser a Char
    forall (p :: * -> *) a. PolyParse p => String -> p a
    failBad (String -> Parser a Char) -> String -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error: unable to parse hex4: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    emsg
        Right (Int
    v, Text
    "") -> Char -> Parser a Char
    forall a. a -> Parser a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Parser a Char) -> Char -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ Int -> Char
    chr Int
    v
        Right (Int
    _, Text
    vs) -> String -> Parser a Char
    forall (p :: * -> *) a. PolyParse p => String -> p a
    failBad (String -> Parser a Char) -> String -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error: hex4 remainder = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    vs

    -- | An eight-digit hex value that has a maximum of @0010FFFF@.
    hex8 :: Parser a Char
    hex8 :: forall s. Parser s Char
    hex8 = do
      String
    digs <- Int -> Parser a Char -> Parser a String
    forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
    exactly Int
    8 Parser a Char
    forall s. Parser s Char
    hexDigit
      let mhex :: Either String (Int, Text)
    mhex = Reader Int
    forall a. Integral a => Reader a
    R.hexadecimal (String -> Text
    T.pack String
    digs)
      case Either String (Int, Text)
    mhex of
        Left String
    emsg     -> String -> Parser a Char
    forall (p :: * -> *) a. PolyParse p => String -> p a
    failBad (String -> Parser a Char) -> String -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error: unable to parse hex8: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    emsg
        Right (Int
    v, Text
    "") -> if Int
    v Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0x10FFFF
                         then Char -> Parser a Char
    forall a. a -> Parser a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Parser a Char) -> Char -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ Int -> Char
    chr Int
    v
                         else String -> Parser a Char
    forall (p :: * -> *) a. PolyParse p => String -> p a
    failBad String
    "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"
        Right (Int
    _, Text
    vs) -> String -> Parser a Char
    forall (p :: * -> *) a. PolyParse p => String -> p a
    failBad (String -> Parser a Char) -> String -> Parser a Char
    forall a b. (a -> b) -> a -> b
    $ String
    "Internal error: hex8 remainder = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    vs

    --------------------------------------------------------------------------------
    --
    --  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --    2011, 2012, 2014, 2018, 2022 Douglas Burke
    --  All rights reserved.
    --
    --  This file is part of Swish.
    --
    --  Swish is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  Swish is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --  You should have received a copy of the GNU General Public License
    --  along with Swish; if not, write to:
    --    The Free Software Foundation, Inc.,
    --    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    --
    --------------------------------------------------------------------------------