{-# 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 ( ArrowList, (>>^), (>>>), constA, deep,
  getChildren, isA, orElse )
import Data.Tree.NTree.TypeDefs ( NTree )
import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue, getQAttrValue,
  getText, hasQName, isElem )
import Text.XML.HXT.DOM.TypeDefs ( QName, XmlTree, XNode, mkQName )


-- 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 = a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b c. Tree t => a (t b) c -> a (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep (a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isElem a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> QName -> a (NTree XNode) (NTree XNode)
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 = a (NTree XNode) (NTree XNode)
forall (t :: * -> *) b. Tree t => a (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren a (NTree XNode) (NTree XNode)
-> a (NTree XNode) String -> a (NTree XNode) String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a (NTree XNode) String
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 = ([b] -> Bool) -> a [b] [b]
forall b. (b -> Bool) -> a b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (([b] -> Bool) -> a [b] [b]) -> ([b] -> Bool) -> a [b] [b]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> ([b] -> Bool) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall a. [a] -> Bool
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 =
   ( QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag QName
tag a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (Maybe String) -> a (NTree XNode) (Maybe String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
     a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text a (NTree XNode) String
-> a String (Maybe String) -> a (NTree XNode) (Maybe String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a String String
forall (a :: * -> * -> *) b. ArrowList a => a [b] [b]
notNullA a String String
-> (String -> Maybe String) -> a String (Maybe String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> Maybe String
forall a. a -> Maybe a
Just )
   a (NTree XNode) (Maybe String)
-> a (NTree XNode) (Maybe String) -> a (NTree XNode) (Maybe String)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
   (Maybe String -> a (NTree XNode) (Maybe String)
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Maybe String
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 =
   (String -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
n a (NTree XNode) String
-> a String (Maybe String) -> a (NTree XNode) (Maybe String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a String String
forall (a :: * -> * -> *) b. ArrowList a => a [b] [b]
notNullA a String String
-> (String -> Maybe String) -> a String (Maybe String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> Maybe String
forall a. a -> Maybe a
Just)
   a (NTree XNode) (Maybe String)
-> a (NTree XNode) (Maybe String) -> a (NTree XNode) (Maybe String)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` (Maybe String -> a (NTree XNode) (Maybe String)
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Maybe String
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 =
   (QName -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) String
getQAttrValue QName
qn a (NTree XNode) String
-> a String (Maybe String) -> a (NTree XNode) (Maybe String)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a String String
forall (a :: * -> * -> *) b. ArrowList a => a [b] [b]
notNullA a String String
-> (String -> Maybe String) -> a String (Maybe String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> Maybe String
forall a. a -> Maybe a
Just)
   a (NTree XNode) (Maybe String)
-> a (NTree XNode) (Maybe String) -> a (NTree XNode) (Maybe String)
forall b c. a b c -> a b c -> a b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse` (Maybe String -> a (NTree XNode) (Maybe String)
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA Maybe String
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"