{-# 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 (WrappedArrow (WrapArrow), unwrapArrow)
import Control.Arrow.ListArrows ((>>>), (>>^), listA)
import Data.Tree.NTree.TypeDefs ( NTree )
import Text.XML.HXT.Arrow.XmlArrow (ArrowXml)
import Text.XML.HXT.DOM.TypeDefs (XNode)

import Codec.Epub.Data.Metadata (Refinement (..))
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 = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"meta") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) Refinement -> a (NTree XNode) Refinement
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ( WrappedArrow a (NTree XNode) Refinement
-> a (NTree XNode) Refinement
forall (a :: * -> * -> *) b c. WrappedArrow a b c -> a b c
unwrapArrow (WrappedArrow a (NTree XNode) Refinement
 -> a (NTree XNode) Refinement)
-> WrappedArrow a (NTree XNode) Refinement
-> a (NTree XNode) Refinement
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> Refinement
Refinement
   (String -> String -> String -> String -> Refinement)
-> WrappedArrow a (NTree XNode) String
-> WrappedArrow
     a (NTree XNode) (String -> String -> String -> Refinement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String)
-> a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall a b. (a -> b) -> a -> b
$ String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"refines" a (NTree XNode) (Maybe String)
-> (Maybe String -> String) -> a (NTree XNode) String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
removeHash)
   WrappedArrow
  a (NTree XNode) (String -> String -> String -> Refinement)
-> WrappedArrow a (NTree XNode) String
-> WrappedArrow a (NTree XNode) (String -> String -> Refinement)
forall a b.
WrappedArrow a (NTree XNode) (a -> b)
-> WrappedArrow a (NTree XNode) a -> WrappedArrow a (NTree XNode) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String)
-> a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall a b. (a -> b) -> a -> b
$ String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"property" a (NTree XNode) (Maybe String)
-> (Maybe String -> String) -> a (NTree XNode) String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id)
   WrappedArrow a (NTree XNode) (String -> String -> Refinement)
-> WrappedArrow a (NTree XNode) String
-> WrappedArrow a (NTree XNode) (String -> Refinement)
forall a b.
WrappedArrow a (NTree XNode) (a -> b)
-> WrappedArrow a (NTree XNode) a -> WrappedArrow a (NTree XNode) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String)
-> a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall a b. (a -> b) -> a -> b
$ String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"scheme" a (NTree XNode) (Maybe String)
-> (Maybe String -> String) -> a (NTree XNode) String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id)
   WrappedArrow a (NTree XNode) (String -> Refinement)
-> WrappedArrow a (NTree XNode) String
-> WrappedArrow a (NTree XNode) Refinement
forall a b.
WrappedArrow a (NTree XNode) (a -> b)
-> WrappedArrow a (NTree XNode) a -> WrappedArrow a (NTree XNode) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) String -> WrappedArrow a (NTree XNode) String)
-> a (NTree XNode) String -> WrappedArrow a (NTree XNode) String
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) String
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 = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
opfName String
"metadata") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) [Refinement] -> a (NTree XNode) [Refinement]
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) Refinement -> a (NTree XNode) [Refinement]
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) Refinement
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Refinement
refinementP