{-# LANGUAGE Arrows #-}

{- | Parsing for meta tags in the metadata section of the OPF
   Package XML Document
-}
module Codec.Epub.Parse.Refinements
   ( refinementsP
   )
   where

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

import Codec.Epub.Data.Metadata
import Codec.Epub.Parse.Util


removeHash :: String -> String
removeHash :: String -> String
removeHash (Char
'#' : String
cs) = String
cs
removeHash String
s          = String
s


refinementP :: (ArrowXml a) => a (NTree XNode) Refinement
refinementP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Refinement
refinementP = forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"meta") 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. WrappedArrow a b c -> a b c
unwrapArrow forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> Refinement
Refinement
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"refines" forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
removeHash)
   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"property" forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. a -> a
id)
   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"scheme" forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. a -> a
id)
   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text)
   )


refinementsP :: (ArrowXml a) => a (NTree XNode) [Refinement]
refinementsP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) [Refinement]
refinementsP = forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"metadata") 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 -> a b [c]
listA forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Refinement
refinementP