{-# LANGUAGE Arrows #-}

-- | Parsing for the guide section of the OPF Package XML Document
module Codec.Epub.Parse.Guide
   ( guideP
   )
   where

import Control.Arrow.ListArrows ( (>>>), constA, listA, orElse, returnA )
import Data.Tree.NTree.TypeDefs ( NTree )
import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue )
import Text.XML.HXT.DOM.TypeDefs ( XNode )

import Codec.Epub.Data.Guide
import Codec.Epub.Parse.Util


guideRefP :: (ArrowXml a) => a (NTree XNode) GuideRef
guideRefP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) GuideRef
guideRefP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"reference") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) GuideRef -> a (NTree XNode) GuideRef
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
   proc NTree XNode
x -> do
      String
t <- String -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"type" -< NTree XNode
x
      Maybe String
mt <- String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"title" -< NTree XNode
x
      String
h <- String -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"href" -< NTree XNode
x
      a GuideRef GuideRef
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< String -> Maybe String -> String -> GuideRef
GuideRef String
t Maybe String
mt String
h


guideP :: (ArrowXml a) => a (NTree XNode) [GuideRef]
guideP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) [GuideRef]
guideP = (QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"guide") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) [GuideRef] -> a (NTree XNode) [GuideRef]
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) GuideRef -> a (NTree XNode) [GuideRef]
forall b c. a b c -> a b [c]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA a (NTree XNode) GuideRef
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) GuideRef
guideRefP)
   a (NTree XNode) [GuideRef]
-> a (NTree XNode) [GuideRef] -> a (NTree XNode) [GuideRef]
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` [GuideRef] -> a (NTree XNode) [GuideRef]
forall c b. c -> a b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA []