-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Arrow.DocumentInput
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   State arrows for document input
-}

-- ------------------------------------------------------------

module Text.XML.HXT.Arrow.DocumentInput
    ( getXmlContents
    , getXmlEntityContents
    , getEncoding
    , getTextEncoding
    , decodeDocument
    , addInputError
    )
where

import           Control.Arrow
import           Control.Arrow.ArrowIf
import           Control.Arrow.ArrowIO
import           Control.Arrow.ArrowList
import           Control.Arrow.ArrowTree
import           Control.Arrow.ListArrow

import           Data.List                            (isPrefixOf)
import           Data.String.Unicode                  (getDecodingFct,
                                                       guessEncoding,
                                                       normalizeNL)

import           System.FilePath                      (takeExtension)

import qualified Text.XML.HXT.IO.GetFILE              as FILE

import           Text.XML.HXT.DOM.Interface

import           Text.XML.HXT.Arrow.ParserInterface   (parseXmlDocEncodingSpec, parseXmlEntityEncodingSpec,
                                                       removeEncodingSpec)
import           Text.XML.HXT.Arrow.XmlArrow
import           Text.XML.HXT.Arrow.XmlState
import           Text.XML.HXT.Arrow.XmlState.TypeDefs

-- ----------------------------------------------------------

protocolHandlers        :: AssocList String (IOStateArrow s XmlTree XmlTree)
protocolHandlers :: forall s. AssocList String (IOStateArrow s XmlTree XmlTree)
protocolHandlers
    = [ (String
"file",        IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getFileContents)
      , (String
"http",        IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getHttpContents)
      , (String
"https",       IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getHttpContents)
      , (String
"stdin",       IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getStdinContents)
      ]

getProtocolHandler      :: IOStateArrow s String (IOStateArrow s XmlTree XmlTree)
getProtocolHandler :: forall s. IOStateArrow s String (IOStateArrow s XmlTree XmlTree)
getProtocolHandler
    = (String -> IOStateArrow s XmlTree XmlTree)
-> IOSLA (XIOState s) String (IOStateArrow s XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
s -> IOStateArrow s XmlTree XmlTree
-> String
-> AssocList String (IOStateArrow s XmlTree XmlTree)
-> IOStateArrow s XmlTree XmlTree
forall k v. Eq k => v -> k -> AssocList k v -> v
lookupDef IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getUnsupported String
s AssocList String (IOStateArrow s XmlTree XmlTree)
forall s. AssocList String (IOStateArrow s XmlTree XmlTree)
protocolHandlers)

getUnsupported          :: IOStateArrow s XmlTree XmlTree
getUnsupported :: forall s. IOStateArrow s XmlTree XmlTree
getUnsupported
    = IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_source
                IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (String -> String) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((String
"unsupported protocol in URI " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
                IOSLA (XIOState s) String String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) String String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSLA (XIOState s) String (IOSLA (XIOState s) String String)
-> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ((String -> IOSLA (XIOState s) String String)
-> IOSLA (XIOState s) String (IOSLA (XIOState s) String String)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> IOSLA (XIOState s) String String
forall s b. String -> IOStateArrow s b b
issueFatal)
              )
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> IOSLA (XIOState s) XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"accessing documents"

getStringContents               :: IOStateArrow s XmlTree XmlTree
getStringContents :: forall s. IOStateArrow s XmlTree XmlTree
getStringContents
    = String -> IOSLA (XIOState s) XmlTree XmlTree
forall {cat :: * -> * -> *}.
ArrowXml cat =>
String -> cat XmlTree XmlTree
setCont (String -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_source
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferMessage String
"OK"
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferStatus String
"200"
    where
    setCont :: String -> cat XmlTree XmlTree
setCont String
contents
        = cat XmlTree XmlTree -> cat XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (String -> cat XmlTree XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
contents')
          cat XmlTree XmlTree -> cat XmlTree XmlTree -> cat 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 -> String -> cat XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferURI (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
7 String
contents)                 -- the "string:" prefix is stored, this is required by setBaseURIFromDoc
          cat XmlTree XmlTree -> cat XmlTree XmlTree -> cat 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 -> String -> cat XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
a_source (String -> String
forall a. Show a => a -> String
show (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
prefix Int
48 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
contents')       -- a quoted prefix of the content, max 48 chars is taken as source name
        where
        contents' :: String
contents'  = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
stringProtocol) String
contents
        prefix :: Int -> String -> String
prefix Int
l String
s
            | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
            | Bool
otherwise     = String
s'
            where
            s' :: String
s' = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s

getFileContents         :: IOStateArrow s XmlTree XmlTree
getFileContents :: forall s. IOStateArrow s XmlTree XmlTree
getFileContents
    = IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( ( Selector XIOSysState Bool -> IOStateArrow s XmlTree Bool
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Bool
theStrictInput
                 IOStateArrow s XmlTree Bool
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree (Bool, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                 ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferURI
                   IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                   IOSLA (XIOState s) String String
forall (a :: * -> * -> *). ArrowList a => a String String
getPathFromURI
                 )
               )
               IOSLA (XIOState s) XmlTree (Bool, String)
-> IOSLA
     (XIOState s) (Bool, String) (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               Int
-> ((Bool, String) -> String)
-> IOStateArrow s (Bool, String) (Bool, String)
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 (\ (Bool
b, String
f) -> String
"read file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (strict input = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
               IOStateArrow s (Bool, String) (Bool, String)
-> IOSLA
     (XIOState s) (Bool, String) (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) (Bool, String) (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
               ((Bool, String)
 -> IO (Either ([(String, String)], String) ByteString))
-> IOSLA
     (XIOState s)
     (Bool, String)
     (Either ([(String, String)], String) ByteString)
forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO ((Bool
 -> String -> IO (Either ([(String, String)], String) ByteString))
-> (Bool, String)
-> IO (Either ([(String, String)], String) ByteString)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool
-> String -> IO (Either ([(String, String)], String) ByteString)
FILE.getCont)
               IOSLA
  (XIOState s)
  (Bool, String)
  (Either ([(String, String)], String) ByteString)
-> IOSLA
     (XIOState s)
     (Either ([(String, String)], String) ByteString)
     (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) (Bool, String) (IOSLA (XIOState s) 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, String)], String)
 -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s)
     ([(String, String)], String)
     (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([(String, String)]
 -> String -> IOSLA (XIOState s) XmlTree XmlTree)
-> ([(String, String)], String)
-> IOSLA (XIOState s) XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(String, String)] -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall s.
[(String, String)] -> String -> IOStateArrow s XmlTree XmlTree
addInputError) -- io error occured
                 IOSLA
  (XIOState s)
  ([(String, String)], String)
  (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) ByteString (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s)
     (Either ([(String, String)], String) ByteString)
     (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
                 (ByteString -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) ByteString (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ByteString -> IOSLA (XIOState s) XmlTree XmlTree
forall s. ByteString -> IOStateArrow s XmlTree XmlTree
addTxtContent      -- content read
               )
             )
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSLA (XIOState s) XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
addMimeType

getStdinContents                :: IOStateArrow s XmlTree XmlTree
getStdinContents :: forall s. IOStateArrow s XmlTree XmlTree
getStdinContents
    = IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA (  Selector XIOSysState Bool -> IOStateArrow s XmlTree Bool
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState Bool
theStrictInput
                IOStateArrow s XmlTree Bool
-> IOSLA (XIOState s) Bool (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (Bool -> IO (Either ([(String, String)], String) ByteString))
-> IOSLA
     (XIOState s) Bool (Either ([(String, String)], String) ByteString)
forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO Bool -> IO (Either ([(String, String)], String) ByteString)
FILE.getStdinCont
               IOSLA
  (XIOState s) Bool (Either ([(String, String)], String) ByteString)
-> IOSLA
     (XIOState s)
     (Either ([(String, String)], String) ByteString)
     (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) Bool (IOSLA (XIOState s) 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, String)], String)
 -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s)
     ([(String, String)], String)
     (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (([(String, String)]
 -> String -> IOSLA (XIOState s) XmlTree XmlTree)
-> ([(String, String)], String)
-> IOSLA (XIOState s) XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(String, String)] -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall s.
[(String, String)] -> String -> IOStateArrow s XmlTree XmlTree
addInputError) -- io error occured
                 IOSLA
  (XIOState s)
  ([(String, String)], String)
  (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) ByteString (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s)
     (Either ([(String, String)], String) ByteString)
     (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
                 (ByteString -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA
     (XIOState s) ByteString (IOSLA (XIOState s) XmlTree XmlTree)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ByteString -> IOSLA (XIOState s) XmlTree XmlTree
forall s. ByteString -> IOStateArrow s XmlTree XmlTree
addTxtContent           -- content read
               )
             )

addInputError                :: Attributes -> String -> IOStateArrow s XmlTree XmlTree
addInputError :: forall s.
[(String, String)] -> String -> IOStateArrow s XmlTree XmlTree
addInputError [(String, String)]
al String
e
    = String -> IOStateArrow s XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueFatal String
e
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      [IOStateArrow s XmlTree XmlTree] -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => [a b b] -> a b b
seqA (((String, String) -> IOStateArrow s XmlTree XmlTree)
-> [(String, String)] -> [IOStateArrow s XmlTree XmlTree]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> IOStateArrow s XmlTree XmlTree)
-> (String, String) -> IOStateArrow s XmlTree XmlTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr) [(String, String)]
al)
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s 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 -> IOStateArrow s XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"accessing documents"

addMimeType     :: IOStateArrow s XmlTree XmlTree
addMimeType :: forall s. IOStateArrow s XmlTree XmlTree
addMimeType
    = String -> IOSLA (XIOState s) XmlTree XmlTree
forall {cat :: * -> * -> *}.
ArrowXml cat =>
String -> cat XmlTree XmlTree
addMime (String -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( ( Selector XIOSysState String -> IOSLA (XIOState s) XmlTree String
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState String
theFileMimeType
                     IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     (String -> Bool) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                   )
                   IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                   ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferURI
                     IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     ( MimeTypeTable -> IOSLA (XIOState s) String String
forall {a :: * -> * -> *}.
Arrow a =>
MimeTypeTable -> a String String
uriToMime (MimeTypeTable -> IOSLA (XIOState s) String String)
-> IOSLA (XIOState s) String MimeTypeTable
-> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState s) String MimeTypeTable
forall s b. IOStateArrow s b MimeTypeTable
getMimeTypeTable )
                   )
                 )
    where
    addMime :: String -> a XmlTree XmlTree
addMime String
mt
        = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferMimeType String
mt
    uriToMime :: MimeTypeTable -> a String String
uriToMime MimeTypeTable
mtt
        = (String -> String) -> a String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((String -> String) -> a String String)
-> (String -> String) -> a String String
forall a b. (a -> b) -> a -> b
$ ( \ String
uri -> String -> MimeTypeTable -> String
extensionToMimeType (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
uri) MimeTypeTable
mtt )

addTxtContent   :: Blob -> IOStateArrow s XmlTree XmlTree
addTxtContent :: forall s. ByteString -> IOStateArrow s XmlTree XmlTree
addTxtContent ByteString
bc
    = IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (ByteString -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
ByteString -> a n XmlTree
blb ByteString
bc)
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferMessage String
"OK"
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> String -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferStatus String
"200"

getHttpContents         :: IOStateArrow s XmlTree XmlTree
getHttpContents :: forall s. IOStateArrow s XmlTree XmlTree
getHttpContents
    = IOSArrow XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall b c s0. IOSArrow b c -> IOStateArrow s0 b c
withoutUserState (IOSArrow XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA (IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
 -> IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
-> IOSArrow XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ Selector XIOSysState (IOSArrow XmlTree XmlTree)
-> IOSLA (XIOState ()) XmlTree (IOSArrow XmlTree XmlTree)
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState (IOSArrow XmlTree XmlTree)
theHttpHandler

getContentsFromString   :: IOStateArrow s XmlTree XmlTree
getContentsFromString :: forall s. IOStateArrow s XmlTree XmlTree
getContentsFromString
    = ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_source
        IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        (String -> Bool) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
stringProtocol)
      )
      IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      IOSLA (XIOState s) XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getStringContents

getContentsFromDoc      :: IOStateArrow s XmlTree XmlTree
getContentsFromDoc :: forall s. IOStateArrow s XmlTree XmlTree
getContentsFromDoc
    = ( ( String -> IOSLA (XIOState s) XmlTree XmlTree
forall {cat :: * -> * -> *}.
ArrowXml cat =>
String -> cat XmlTree XmlTree
addTransferURI (String -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IOSLA (XIOState s) XmlTree String
forall s b. IOStateArrow s b String
getBaseURI
          IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSLA (XIOState s) XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getCont
        )
        IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
        ( String -> IOSLA (XIOState s) XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
setAbsURI (String -> IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_source
                         IOSLA (XIOState s) XmlTree String
-> (String -> String) -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
                         ( \ String
src-> (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
src then String
"stdin:" else String
src) )   -- empty document name -> read from stdin
                       )
        )
      )
      IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) 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 -> IOSLA (XIOState s) XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"getContentsFromDoc"
    where
    setAbsURI :: String -> IOSLA (XIOState s) d d
setAbsURI String
src
        = IOSLA (XIOState s) d String
-> IOSLA (XIOState s) d d
-> IOSLA (XIOState s) d d
-> IOSLA (XIOState s) d d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( String -> IOSLA (XIOState s) d String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
src IOSLA (XIOState s) d String
-> IOSLA (XIOState s) String String -> IOSLA (XIOState s) d String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState s) String String
forall s. IOStateArrow s String String
changeBaseURI )
          IOSLA (XIOState s) d d
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          ( String -> IOSLA (XIOState s) d d
forall s b. String -> IOStateArrow s b b
issueFatal (String
"illegal URI : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
src) )

    addTransferURI :: String -> a XmlTree XmlTree
addTransferURI String
uri
        = String -> String -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferURI String
uri

    getCont :: IOSLA (XIOState s) XmlTree XmlTree
getCont
        = IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( IOStateArrow s XmlTree String
forall s b. IOStateArrow s b String
getBaseURI                           -- compute the handler and call it
                   IOStateArrow s XmlTree String
-> IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) XmlTree (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                   Int -> (String -> String) -> IOStateArrow s String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"getContentsFromDoc: reading " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
                   IOStateArrow s String String
-> IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                   IOStateArrow s String String
forall (a :: * -> * -> *). ArrowList a => a String String
getSchemeFromURI
                   IOStateArrow s String String
-> IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
-> IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                   IOSLA (XIOState s) String (IOSLA (XIOState s) XmlTree XmlTree)
forall s. IOStateArrow s String (IOStateArrow s XmlTree XmlTree)
getProtocolHandler
                 )
          IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
          IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this                                          -- don't change tree, when no handler can be found

setBaseURIFromDoc       :: IOStateArrow s XmlTree XmlTree
setBaseURIFromDoc :: forall s. IOStateArrow s XmlTree XmlTree
setBaseURIFromDoc
    = IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferURI
                IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                (String -> Bool) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
stringProtocol)         -- do not change base URI when reading from a string
                IOSLA (XIOState s) String String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) String String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                IOSLA (XIOState s) String String
forall s. IOStateArrow s String String
setBaseURI
              )

{- |
   Read the content of a document.

   This routine is usually called from 'Text.XML.HXT.Arrow.ProcessDocument.getDocumentContents'.

   The input must be a root node (constructed with 'Text.XML.HXT.Arrow.XmlArrow.root'), usually without children.
   The attribute list contains all input parameters, e.g. URI or source file name, encoding preferences, ...
   If the source name is empty, the input is read from standard input.

   The source is transformed into an absolute URI. If the source is a relative URI, or a file name,
   it is expanded into an absolute URI with respect to the current base URI.
   The default base URI is of protocol \"file\" and points to the current working directory.

   The currently supported protocols are \"http\", \"file\", \"stdin\" and \"string\".

   The latter two are internal protocols. An uri of the form \"stdin:\" stands for the content of
   the standard input stream.

   \"string:some text\" means, that \"some text\" is taken as input.
   This internal protocol is used for reading from normal 'String' values.

-}

getXmlContents          :: IOStateArrow s XmlTree XmlTree
getXmlContents :: forall s. IOStateArrow s XmlTree XmlTree
getXmlContents
    = IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall s.
IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
getXmlContents' IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDocEncodingSpec
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
setBaseURIFromDoc

getXmlEntityContents            :: IOStateArrow s XmlTree XmlTree
getXmlEntityContents :: forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
    = Int -> String -> IOStateArrow s XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 String
"getXmlEntityContents"
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s 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 -> String -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferMimeType String
text_xml_external_parsed_entity  -- the default transfer mimetype
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall s.
IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
getXmlContents' IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlEntityEncodingSpec
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s 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 -> String -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
transferMimeType String
text_xml_external_parsed_entity
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren
      ( IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
removeEncodingSpec
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s 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 -> String) -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeText String -> String
normalizeNL                  -- newline normalization must be done here
      )                                         -- the following calls of the parsers don't do this
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
setBaseURIFromDoc
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      Int -> String -> IOStateArrow s XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 String
"getXmlEntityContents done"

getXmlContents'         :: IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
getXmlContents' :: forall s.
IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
getXmlContents' IOStateArrow s XmlTree XmlTree
parseEncodingSpec
    = ( IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getContentsFromString    -- no decoding done for string: protocol
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
        ( IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getContentsFromDoc
          IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          [IfThen
   (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)]
-> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
isXmlHtmlDoc  IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree
-> IfThen
     (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( IOStateArrow s XmlTree XmlTree
parseEncodingSpec
                                IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
filterErrorMsg
                                IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
decodeDocument
                              )
          , IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
isTextDoc     IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree
-> IfThen
     (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
decodeDocument
          , IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this          IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree
-> IfThen
     (IOStateArrow s XmlTree XmlTree) (IOStateArrow s XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
          ]
          IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOSLA (XIOState s) XmlTree String -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( String -> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferURI
                    IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    Int -> (String -> String) -> IOSLA (XIOState s) String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
1 ((String
"getXmlContents: content read and decoded for " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
                  )
          IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s 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 -> IOStateArrow s XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"getXmlContents'"
        )
      )
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot

isMimeDoc               :: (String -> Bool) -> IOStateArrow s XmlTree XmlTree
isMimeDoc :: forall s. (String -> Bool) -> IOStateArrow s XmlTree XmlTree
isMimeDoc String -> Bool
isMT          = LA XmlTree XmlTree -> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (LA XmlTree XmlTree -> IOSLA (XIOState s) XmlTree XmlTree)
-> LA XmlTree XmlTree -> IOSLA (XIOState s) XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
                          ( ( String -> LA XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferMimeType LA XmlTree String -> (String -> String) -> LA XmlTree String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> String
stringToLower )
                            LA XmlTree String -> LA String String -> LA XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                            (String -> Bool) -> LA String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ String
t -> String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t Bool -> Bool -> Bool
|| String -> Bool
isMT String
t)
                          )
                          LA XmlTree String -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` LA XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

isTextDoc, isXmlHtmlDoc :: IOStateArrow s XmlTree XmlTree

isTextDoc :: forall s. IOStateArrow s XmlTree XmlTree
isTextDoc               = (String -> Bool) -> IOStateArrow s XmlTree XmlTree
forall s. (String -> Bool) -> IOStateArrow s XmlTree XmlTree
isMimeDoc String -> Bool
isTextMimeType

isXmlHtmlDoc :: forall s. IOStateArrow s XmlTree XmlTree
isXmlHtmlDoc            = (String -> Bool) -> IOStateArrow s XmlTree XmlTree
forall s. (String -> Bool) -> IOStateArrow s XmlTree XmlTree
isMimeDoc (\ String
mt -> String -> Bool
isHtmlMimeType String
mt Bool -> Bool -> Bool
|| String -> Bool
isXmlMimeType String
mt)

-- ------------------------------------------------------------

getEncoding     :: IOStateArrow s XmlTree String
getEncoding :: forall s. IOStateArrow s XmlTree String
getEncoding
    = [IOSLA (XIOState s) XmlTree String]
-> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA [ IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                  -- 1. guess: guess encoding by looking at the first few bytes
             IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) String String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
             (String -> String) -> IOSLA (XIOState s) String String
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr String -> String