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

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

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

   State arrows for document output

-}

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

module Text.XML.HXT.Arrow.DocumentOutput
    ( putXmlDocument
    , putXmlTree
    , putXmlSource
    , encodeDocument
    , encodeDocument'
    )
where

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

import qualified Data.ByteString.Lazy                 as BS
import           Data.Maybe
import           Data.String.Unicode                  (getOutputEncodingFct')

import           Text.XML.HXT.DOM.Interface
import qualified Text.XML.HXT.DOM.ShowXml             as XS

import           Text.XML.HXT.Arrow.Edit              (addHeadlineToXmlDoc,
                                                       addXmlPi,
                                                       addXmlPiEncoding,
                                                       escapeHtmlRefs,
                                                       escapeXmlRefs, indentDoc,
                                                       numberLinesInXmlDoc,
                                                       treeRepOfXmlDoc)
import           Text.XML.HXT.Arrow.XmlArrow
import           Text.XML.HXT.Arrow.XmlState
import           Text.XML.HXT.Arrow.XmlState.TypeDefs

import           System.IO                            (Handle, IOMode (..),
                                                       hClose, hPutStrLn,
                                                       hSetBinaryMode,
                                                       openBinaryFile, openFile,
                                                       stdout)

-- ------------------------------------------------------------
--
-- | Write the contents of a document tree into an output stream (file or stdout).
--
-- If textMode is set, writing is done with Haskell string output, else (default)
-- writing is done with lazy ByteString output

putXmlDocument  :: Bool -> String -> IOStateArrow s XmlTree XmlTree
putXmlDocument :: forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
putXmlDocument Bool
textMode String
dst
    = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform forall {s}. IOSLA (XIOState s) XmlTree XmlTree
putDoc
      where
      putDoc :: IOSLA (XIOState s) XmlTree XmlTree
putDoc
          = ( if Bool
textMode
              then ( forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     forall (a :: * -> * -> *) b c.
ArrowExc a =>
a b c -> a b (Either SomeException c)
tryA (forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO (\ String
s -> (Handle -> IO ()) -> IO ()
hPutDocument (\Handle
h -> Handle -> String -> IO ()
hPutStrLn Handle
h String
s)))
                   )
              else ( forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree -> a n Blob
xshowBlob forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                     forall (a :: * -> * -> *) b c.
ArrowExc a =>
a b c -> a b (Either SomeException c)
tryA (forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO (\ Blob
s -> (Handle -> IO ()) -> IO ()
hPutDocument (\Handle
h -> do Handle -> Blob -> IO ()
BS.hPutStr Handle
h Blob
s
                                                                Handle -> Blob -> IO ()
BS.hPutStr Handle
h (String -> Blob
stringToBlob String
"\n")
                                                      )
                                 )
                          )
                   )
            )
            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            ( ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"io error, document not written to " forall a. [a] -> [a] -> [a]
++ String
outFile)
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. Show a => a -> String
show forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => Int -> a String XmlTree
mkError Int
c_fatal
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall {s}. IOSLA (XIOState s) XmlTree XmlTree
filterErrorMsg
              )
              forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
|||
              ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"document written to " forall a. [a] -> [a] -> [a]
++ String
outFile forall a. [a] -> [a] -> [a]
++ String
", textMode = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
textMode)
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
              )
            )
          where
          isStdout :: Bool
isStdout  = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dst Bool -> Bool -> Bool
|| String
dst forall a. Eq a => a -> a -> Bool
== String
"-"

          outFile :: String
outFile   = if Bool
isStdout
                      then String
"stdout"
                      else forall a. Show a => a -> String
show String
dst

          hPutDocument      :: (Handle -> IO ()) -> IO ()
          hPutDocument :: (Handle -> IO ()) -> IO ()
hPutDocument Handle -> IO ()
action
              | Bool
isStdout
                  = do
                    Handle -> Bool -> IO ()
hSetBinaryMode Handle
stdout (Bool -> Bool
not Bool
textMode)
                    Handle -> IO ()
action Handle
stdout
                    Handle -> Bool -> IO ()
hSetBinaryMode Handle
stdout Bool
False
              | Bool
otherwise
                  = do
                    Handle
handle <- ( if Bool
textMode
                                then String -> IOMode -> IO Handle
openFile
                                else String -> IOMode -> IO Handle
openBinaryFile
                              ) String
dst IOMode
WriteMode
                    Handle -> IO ()
action Handle
handle
                    Handle -> IO ()
hClose Handle
handle

-- |
-- write the tree representation of a document to a file

putXmlTree      :: String -> IOStateArrow s XmlTree XmlTree
putXmlTree :: forall s. String -> IOStateArrow s XmlTree XmlTree
putXmlTree String
dst
    = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
treeRepOfXmlDoc
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
addHeadlineToXmlDoc
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
putXmlDocument Bool
True String
dst
              )

-- |
-- write a document with indentaion and line numers

putXmlSource    :: String -> IOStateArrow s XmlTree XmlTree
putXmlSource :: forall s. String -> IOStateArrow s XmlTree XmlTree
putXmlSource String
dst
    = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( (forall (a :: * -> * -> *) b. ArrowList a => a b b
this ) forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot` forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
indentDoc
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
numberLinesInXmlDoc
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
addHeadlineToXmlDoc
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
putXmlDocument Bool
True String
dst
              )

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

getEncodingParam        :: IOStateArrow s XmlTree String
getEncodingParam :: forall s. IOStateArrow s XmlTree String
getEncodingParam
    = forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA [ forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState String
theOutputEncoding   -- 4. guess: take output encoding parameter from global state
           , forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState String
theInputEncoding    -- 5. guess: take encoding parameter from global state
           , forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
utf8                   -- default : utf8
           ]
      forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null))

getOutputEncoding       :: String -> IOStateArrow s XmlTree String
getOutputEncoding :: forall s. String -> IOStateArrow s XmlTree String
getOutputEncoding String
defaultEnc
    = forall {a :: * -> * -> *}.
ArrowList a =>
String -> a XmlTree String
getEC forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall s. IOStateArrow s XmlTree String
getEncodingParam
    where
    getEC :: String -> a XmlTree String
getEC String
enc' = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA forall a b. (a -> b) -> a -> b
$ String -> String -> LA XmlTree String
getOutputEncoding' String
defaultEnc String
enc'

encodeDocument  :: Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
encodeDocument :: forall s. Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
encodeDocument Bool
quoteXml Bool
supressXmlPi String
defaultEnc
    = forall s. String -> IOStateArrow s XmlTree XmlTree
encode forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall s. String -> IOStateArrow s XmlTree String
getOutputEncoding String
defaultEnc
    where
    encode :: String -> IOSLA (XIOState s) XmlTree XmlTree
encode String
enc
        = forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"encodeDocument: encoding is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
enc)
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( forall (a :: * -> * -> *).
ArrowXml a =>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDocument' Bool
quoteXml Bool
supressXmlPi String
enc
            forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
            ( forall s b. String -> IOStateArrow s b b
issueFatal (String
"encoding scheme not supported: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
enc)
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"encoding document"
            )
          )

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

isBinaryDoc               :: LA XmlTree XmlTree
isBinaryDoc :: LA XmlTree XmlTree
isBinaryDoc               = ( ( forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
transferMimeType forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> String
stringToLower )
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (\ String
t -> Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t Bool -> Bool -> Bool
|| String -> Bool
isTextMimeType String
t Bool -> Bool -> Bool
|| String -> Bool
isXmlMimeType String
t))
                            )
                            forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b. ArrowList a => a b b
this

getOutputEncoding'      :: String -> String -> LA XmlTree String
getOutputEncoding' :: String -> String -> LA XmlTree String
getOutputEncoding' String
defaultEnc String
defaultEnc2
    =  forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA [ LA XmlTree XmlTree
isBinaryDoc
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                               -- 0. guess: binary data found: no encoding at all
              forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
isoLatin1                  --           the content should usually be a blob
                                                --           this handling is like the decoding in DocumentInput,
                                                --           there nothing is decoded for non text or non xml contents
            , forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                       -- 1. guess: evaluate <?xml ... encoding="..."?>
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ( ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isPi forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
hasName String
t_xml )
                forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
                forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_encoding
              )
            , forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
defaultEnc                 -- 2. guess: explicit parameter, may be ""
            , forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
a_output_encoding    -- 3. guess: take output encoding parameter in root node
            , forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
defaultEnc2                -- default : UNICODE or utf8
            ]
      forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null))           -- make the filter deterministic: take 1. entry from list of guesses

encodeDocument' :: ArrowXml a => Bool -> Bool -> String -> a XmlTree XmlTree
encodeDocument' :: forall (a :: * -> * -> *).
ArrowXml a =>
Bool -> Bool -> String -> a XmlTree XmlTree
encodeDocument' Bool
quoteXml Bool
supressXmlPi String
defaultEnc
    = forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
fromLA (String -> LA XmlTree XmlTree
encode forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> String -> LA XmlTree String
getOutputEncoding' String
defaultEnc String
utf8)
    where
    encode      :: String -> LA XmlTree XmlTree
    encode :: String -> LA XmlTree XmlTree
encode String
encodingScheme
        | String
encodingScheme forall a. Eq a => a -> a -> Bool
== String
unicodeString
            = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
              ( (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (Char -> String -> String)
-> (Char -> String -> String) -> XmlTrees -> String
XS.xshow'' Char -> String -> String
cQuot Char -> String -> String
aQuot)
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText
              )
        | forall a. Maybe a -> Bool
isNothing Maybe (Char -> String -> String)
encodeFct
            = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
        | Bool
otherwise
            = ( if Bool
supressXmlPi
                then forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isXmlPi)
                else ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
addXmlPi
                       forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                       forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
addXmlPiEncoding String
encodingScheme
                     )
              )
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ( LA XmlTree XmlTree
isLatin1Blob
                forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                forall {a :: * -> * -> *}.
ArrowXml a =>
(Char -> String -> String) -> a XmlTree XmlTree
encodeDoc (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Char -> String -> String)
encodeFct)
              )
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a XmlTree XmlTree
addAttr String
a_output_encoding String
encodingScheme
        where
        (Char -> String -> String
cQuot, Char -> String -> String
aQuot)
            | Bool
quoteXml  = (Char -> String -> String, Char -> String -> String)
escapeXmlRefs
            | Bool
otherwise = (Char -> String -> String, Char -> String -> String)
escapeHtmlRefs

        encodeFct :: Maybe (Char -> String -> String)
encodeFct       = String -> Maybe (Char -> String -> String)
getOutputEncodingFct' String
encodingScheme

        encodeDoc :: (Char -> String -> String) -> a XmlTree XmlTree
encodeDoc Char -> String -> String
ef    = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
                          ( forall {a :: * -> * -> *} {b}.
ArrowList a =>
(Char -> String -> String)
-> (Char -> String -> String)
-> (Char -> String -> String)
-> a b XmlTree
-> a b Blob
xshowBlobWithEnc Char -> String -> String
cQuot Char -> String -> String
aQuot Char -> String -> String
ef forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                            forall (a :: * -> * -> *). ArrowXml a => a Blob XmlTree
mkBlob
                          )
        xshowBlobWithEnc :: (Char -> String -> String)
-> (Char -> String -> String)
-> (Char -> String -> String)
-> a b XmlTree
-> a b Blob
xshowBlobWithEnc Char -> String -> String
cenc Char -> String -> String
aenc Char -> String -> String
enc a b XmlTree
f
                        = a b XmlTree
f forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> d) -> a b d
>. (Char -> String -> String)
-> (Char -> String -> String)
-> (Char -> String -> String)
-> XmlTrees
-> Blob
XS.xshow' Char -> String -> String
cenc Char -> String -> String
aenc Char -> String -> String
enc

        -- if encoding scheme is isolatin1 and the contents is a single blob (bytestring)
        -- the encoding is the identity.
        -- This optimization enables processing (copying) of none XML contents
        -- without any conversions from and to strings
        isLatin1Blob :: LA XmlTree XmlTree
isLatin1Blob
            | String
encodingScheme forall a. Eq a => a -> a -> Bool
/= String
isoLatin1
                        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
            | Bool
otherwise = LA XmlTree XmlTree
childIsSingleBlob forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            where
            childIsSingleBlob :: LA XmlTree XmlTree
childIsSingleBlob
                        = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall a. Eq a => a -> a -> Bool
== Int
1))
                          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA
                          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isBlob

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