{-# LANGUAGE Arrows #-}

-- | Helper functions used by the other parsing modules
module Codec.Epub.Parse.Util
   ( atQTag
   , mbQTagText
   , mbGetAttrValue
   , mbGetQAttrValue
   , notNullA
   , text
   , dcName
   , opfName
   , xmlName
   )
   where

import Control.Arrow.ListArrows
import Data.Tree.NTree.TypeDefs ( NTree )
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.DOM.TypeDefs


-- HXT helpers

{- Not used at this time. But may be used someday

atTag :: (ArrowXml a) => String -> a (NTree XNode) XmlTree
atTag tag = deep (isElem >>> hasName tag)
-}


{- | Shortcut arrow to drill down to a specific namespaced child
   element
-}
atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree
atQTag :: forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag QName
tag = forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep (forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem 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 =>
QName -> a (NTree XNode) (NTree XNode)
hasQName QName
tag)


-- | Shortcut arrow to gather up the text part of all child nodes
text :: (ArrowXml a) => a (NTree XNode) String
text :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text = 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 (NTree XNode) String
getText


-- | Arrow that succeeds if the input is not the empty list
notNullA :: (ArrowList a) => a [b] [b]
notNullA :: forall (a :: * -> * -> *) b. ArrowList a => a [b] [b]
notNullA = forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null


{- | Shortcut arrow to retrieve the contents of a namespaced element
   as a Maybe String
-}
mbQTagText :: (ArrowXml a) => QName -> a (NTree XNode) (Maybe String)
mbQTagText :: forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbQTagText QName
tag =
   ( forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag QName
tag 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 (NTree XNode) String
text 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]
notNullA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a. a -> Maybe a
Just )
   forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
   (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA forall a. Maybe a
Nothing)


{- | Shortcut arrow to retrieve an attribute of an element as a
   Maybe String
-}
mbGetAttrValue :: (ArrowXml a) =>
   String -> a XmlTree (Maybe String)
mbGetAttrValue :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
n =
   (forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue 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 (a :: * -> * -> *) b. ArrowList a => a [b] [b]
notNullA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a. a -> Maybe a
Just)
   forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA forall a. Maybe a
Nothing)


{- | Shortcut arrow to retrieve an attribute of a namespaced element
   as a Maybe String
-}
mbGetQAttrValue :: (ArrowXml a) =>
   QName -> a XmlTree (Maybe String)
mbGetQAttrValue :: forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue QName
qn =
   (forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) String
getQAttrValue QName
qn 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]
notNullA forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a. a -> Maybe a
Just)
   forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA forall a. Maybe a
Nothing)


-- | Construct a qualified name in the Dublin Core namespace
dcName :: String -> QName
dcName :: String -> QName
dcName String
local = String -> String -> String -> QName
mkQName String
"dc" String
local String
"http://purl.org/dc/elements/1.1/"


-- | Construct a qualified name in the epub OPF namespace
opfName :: String -> QName
opfName :: String -> QName
opfName String
local = String -> String -> String -> QName
mkQName String
"opf" String
local String
"http://www.idpf.org/2007/opf"


-- | Construct a qualified name in the XML namespace
xmlName :: String -> QName
xmlName :: String -> QName
xmlName String
local = String -> String -> String -> QName
mkQName String
"xml" String
local String
"http://www.w3.org/XML/1998/namespace"