{-# LANGUAGE Arrows #-}

-- | Parsing for the package section of the OPF Package XML Document
module Codec.Epub.Parse.Package
   ( packageP
   )
   where

import Control.Arrow.ListArrows ( (>>>), 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.Package
import Codec.Epub.Parse.Util


packageP :: (ArrowXml a) => a (NTree XNode) Package
packageP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Package
packageP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"package") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) Package -> a (NTree XNode) Package
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
v <- String -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"version" -< NTree XNode
x
      String
u <- String -> a (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"unique-identifier" -< NTree XNode
x
      a Package Package
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (String -> String -> Package
Package String
v String
u)