{-# LANGUAGE Arrows #-}

-- | Parsing for the metadata section of the OPF Package XML Document
module Codec.Epub.Parse.Metadata
   ( metadataP
   )
   where

import Control.Applicative ( WrappedArrow (WrapArrow), unwrapArrow )
import Control.Arrow.ListArrows ( (>>.), (>>>), (<<<), catA, constA, listA, returnA )
import Data.List ( isPrefixOf )
import qualified Data.Map.Strict as Map
import Data.Maybe ( catMaybes )
import Data.Tree.NTree.TypeDefs ( NTree )
import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, hasAttrValue )
import Text.XML.HXT.DOM.TypeDefs ( XNode )

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


idP :: (ArrowXml a) => a (NTree XNode) Identifier
idP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Identifier
idP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"identifier") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) Identifier -> a (NTree XNode) Identifier
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) Identifier
-> a (NTree XNode) Identifier
forall (a :: * -> * -> *) b c. WrappedArrow a b c -> a b c
unwrapArrow (WrappedArrow a (NTree XNode) Identifier
 -> a (NTree XNode) Identifier)
-> WrappedArrow a (NTree XNode) Identifier
-> a (NTree XNode) Identifier
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Maybe String -> Maybe String -> String -> Identifier
Identifier
   (Maybe String
 -> Maybe String -> Maybe String -> String -> Identifier)
-> WrappedArrow a (NTree XNode) (Maybe String)
-> WrappedArrow
     a
     (NTree XNode)
     (Maybe String -> Maybe String -> String -> Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a (NTree XNode) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) (Maybe String)
 -> WrappedArrow a (NTree XNode) (Maybe String))
-> a (NTree XNode) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe 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
"id")
   WrappedArrow
  a
  (NTree XNode)
  (Maybe String -> Maybe String -> String -> Identifier)
-> WrappedArrow a (NTree XNode) (Maybe String)
-> WrappedArrow
     a (NTree XNode) (Maybe String -> String -> Identifier)
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) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) (Maybe String)
 -> WrappedArrow a (NTree XNode) (Maybe String))
-> a (NTree XNode) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall a b. (a -> b) -> a -> b
$ 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)
   WrappedArrow a (NTree XNode) (Maybe String -> String -> Identifier)
-> WrappedArrow a (NTree XNode) (Maybe String)
-> WrappedArrow a (NTree XNode) (String -> Identifier)
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) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) (Maybe String)
 -> WrappedArrow a (NTree XNode) (Maybe String))
-> a (NTree XNode) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall a b. (a -> b) -> a -> b
$ QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
opfName String
"scheme"))  -- An attr in epub2
   WrappedArrow a (NTree XNode) (String -> Identifier)
-> WrappedArrow a (NTree XNode) String
-> WrappedArrow a (NTree XNode) Identifier
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)
   )


titleP :: (ArrowXml a) => a (NTree XNode) (String, Title)
titleP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (String, Title)
titleP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"title") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (String, Title)
-> a (NTree XNode) (String, Title)
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
      Maybe String
i <- String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"id" -< NTree XNode
x
      Maybe String
l <- QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
xmlName String
"lang") -< NTree XNode
x
      String
c <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
      a (String, Title) (String, Title)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id Maybe String
i), Maybe String -> Maybe String -> Maybe Int -> String -> Title
Title Maybe String
l Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing String
c)


langP :: (ArrowXml a) => a (NTree XNode) String
langP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
langP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"language") 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
text


{- Since creators and contributors have the same exact XML structure,
   this arrow is used to get either of them
-}
creatorP :: (ArrowXml a) => String -> a (NTree XNode) (String, Creator)
creatorP :: forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (String, Creator)
creatorP String
tag = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
tag) a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (String, Creator)
-> a (NTree XNode) (String, Creator)
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
      Maybe String
i <- String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"id" -< NTree XNode
x
      Maybe String
r <- QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
opfName String
"role") -< NTree XNode
x
      Maybe String
f <- QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
opfName String
"file-as") -< NTree XNode
x
      String
t <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
      a (String, Creator) (String, Creator)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id Maybe String
i), Maybe String -> Maybe String -> Maybe Int -> String -> Creator
Creator Maybe String
r Maybe String
f Maybe Int
forall a. Maybe a
Nothing String
t)


dateElemP :: (ArrowXml a) => a (NTree XNode) (Maybe (DateEvent, DateValue))
dateElemP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe (DateEvent, DateValue))
dateElemP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"date") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (Maybe (DateEvent, DateValue))
-> a (NTree XNode) (Maybe (DateEvent, DateValue))
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
      Maybe String
e <- QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
opfName String
"event") -< NTree XNode
x
      String
c <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
      a (Maybe (DateEvent, DateValue)) (Maybe (DateEvent, DateValue))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (, String -> DateValue
DateValue String
c) (DateEvent -> (DateEvent, DateValue))
-> Maybe DateEvent -> Maybe (DateEvent, DateValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Maybe DateEvent
dateEventFromString Maybe String
e


dateMetaP :: (ArrowXml a) => a (NTree XNode) (Maybe (DateEvent, DateValue))
dateMetaP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe (DateEvent, DateValue))
dateMetaP = 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) (Maybe (DateEvent, DateValue))
-> a (NTree XNode) (Maybe (DateEvent, DateValue))
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
      Maybe String
e <- String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"property" a (NTree XNode) (Maybe String)
-> a (NTree XNode) (NTree XNode) -> a (NTree XNode) (Maybe String)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< String -> (String -> Bool) -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> (String -> Bool) -> a (NTree XNode) (NTree XNode)
hasAttrValue String
"property" (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"dcterms:") -< NTree XNode
x
      String
c <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
      a (Maybe (DateEvent, DateValue)) (Maybe (DateEvent, DateValue))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (, String -> DateValue
DateValue String
c) (DateEvent -> (DateEvent, DateValue))
-> Maybe DateEvent -> Maybe (DateEvent, DateValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Maybe DateEvent
dateEventFromString Maybe String
e


sourceP :: (ArrowXml a) => a (NTree XNode) (String, Source)
sourceP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (String, Source)
sourceP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"source") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) (String, Source)
-> a (NTree XNode) (String, Source)
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
    Maybe String
i <- String -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (Maybe String)
mbGetAttrValue String
"id" -< NTree XNode
x
    String
t <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
    a (String, Source) (String, Source)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ((String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
forall a. a -> a
id Maybe String
i), Maybe String -> Maybe String -> Maybe String -> String -> Source
Source Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing String
t)


typeP :: (ArrowXml a) => a (NTree XNode) (Maybe String)
typeP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe String)
typeP = QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbQTagText (QName -> a (NTree XNode) (Maybe String))
-> QName -> a (NTree XNode) (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> QName
dcName String
"type"


coverageP :: (ArrowXml a) => a (NTree XNode) String
coverageP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
coverageP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"coverage") 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
text


descriptionP :: (ArrowXml a) => a (NTree XNode) Description
descriptionP :: forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) Description
descriptionP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"description") a (NTree XNode) (NTree XNode)
-> a (NTree XNode) Description -> a (NTree XNode) Description
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
      Maybe String
l <- QName -> a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (Maybe String)
mbGetQAttrValue (String -> QName
xmlName String
"lang") -< NTree XNode
x
      String
c <- a (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
text -< NTree XNode
x
      a Description Description
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe String -> String -> Description
Description Maybe String
l String
c


formatP :: (ArrowXml a) => a (NTree XNode) String
formatP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
formatP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"format") 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
text


publisherP :: (ArrowXml a) => a (NTree XNode) String
publisherP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
publisherP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"publisher") 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
text


relationP :: (ArrowXml a) => a (NTree XNode) String
relationP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
relationP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"relation") 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
text


rightsP :: (ArrowXml a) => a (NTree XNode) String
rightsP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
rightsP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"rights") 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
text


subjectP :: (ArrowXml a) => a (NTree XNode) String
subjectP :: forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
subjectP = QName -> a (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
QName -> a (NTree XNode) (NTree XNode)
atQTag (String -> QName
dcName String
"subject") 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
text


metadataP :: (ArrowXml a) => [Refinement] -> a (NTree XNode) Metadata
metadataP :: forall (a :: * -> * -> *).
ArrowXml a =>
[Refinement] -> a (NTree XNode) Metadata
metadataP [Refinement]
refinements =
   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) Metadata -> a (NTree XNode) Metadata
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) Metadata -> a (NTree XNode) Metadata
forall (a :: * -> * -> *) b c. WrappedArrow a b c -> a b c
unwrapArrow (WrappedArrow a (NTree XNode) Metadata -> a (NTree XNode) Metadata)
-> WrappedArrow a (NTree XNode) Metadata
-> a (NTree XNode) Metadata
forall a b. (a -> b) -> a -> b
$ [Identifier]
-> [Title]
-> [String]
-> [Creator]
-> [Creator]
-> Map DateEvent DateValue
-> [Source]
-> Maybe String
-> [String]
-> [Description]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Metadata
Metadata
      ([Identifier]
 -> [Title]
 -> [String]
 -> [Creator]
 -> [Creator]
 -> Map DateEvent DateValue
 -> [Source]
 -> Maybe String
 -> [String]
 -> [Description]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> Metadata)
-> WrappedArrow a (NTree XNode) [Identifier]
-> WrappedArrow
     a
     (NTree XNode)
     ([Title]
      -> [String]
      -> [Creator]
      -> [Creator]
      -> Map DateEvent DateValue
      -> [Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a (NTree XNode) [Identifier]
-> WrappedArrow a (NTree XNode) [Identifier]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Identifier]
 -> WrappedArrow a (NTree XNode) [Identifier])
-> a (NTree XNode) [Identifier]
-> WrappedArrow a (NTree XNode) [Identifier]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Identifier -> a (NTree XNode) [Identifier]
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) Identifier -> a (NTree XNode) [Identifier])
-> a (NTree XNode) Identifier -> a (NTree XNode) [Identifier]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Identifier
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) Identifier
idP a (NTree XNode) Identifier
-> ([Identifier] -> [Identifier]) -> a (NTree XNode) Identifier
forall b c d. a b c -> ([c] -> [d]) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. (Identifier -> Identifier) -> [Identifier] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ([Refinement] -> Identifier -> Identifier
refineIdentifier [Refinement]
refinements))
      WrappedArrow
  a
  (NTree XNode)
  ([Title]
   -> [String]
   -> [Creator]
   -> [Creator]
   -> Map DateEvent DateValue
   -> [Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [Title]
-> WrappedArrow
     a
     (NTree XNode)
     ([String]
      -> [Creator]
      -> [Creator]
      -> Map DateEvent DateValue
      -> [Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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) [Title] -> WrappedArrow a (NTree XNode) [Title]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Title] -> WrappedArrow a (NTree XNode) [Title])
-> a (NTree XNode) [Title] -> WrappedArrow a (NTree XNode) [Title]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Title -> a (NTree XNode) [Title]
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) Title -> a (NTree XNode) [Title])
-> a (NTree XNode) Title -> a (NTree XNode) [Title]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) (String, Title)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (String, Title)
titleP a (NTree XNode) (String, Title)
-> ([(String, Title)] -> [Title]) -> a (NTree XNode) Title
forall b c d. a b c -> ([c] -> [d]) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. ((String, Title) -> Title) -> [(String, Title)] -> [Title]
forall a b. (a -> b) -> [a] -> [b]
map ([Refinement] -> (String, Title) -> Title
refineTitle [Refinement]
refinements))
      WrappedArrow
  a
  (NTree XNode)
  ([String]
   -> [Creator]
   -> [Creator]
   -> Map DateEvent DateValue
   -> [Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow
     a
     (NTree XNode)
     ([Creator]
      -> [Creator]
      -> Map DateEvent DateValue
      -> [Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
langP)
      WrappedArrow
  a
  (NTree XNode)
  ([Creator]
   -> [Creator]
   -> Map DateEvent DateValue
   -> [Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [Creator]
-> WrappedArrow
     a
     (NTree XNode)
     ([Creator]
      -> Map DateEvent DateValue
      -> [Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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) [Creator] -> WrappedArrow a (NTree XNode) [Creator]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Creator]
 -> WrappedArrow a (NTree XNode) [Creator])
-> a (NTree XNode) [Creator]
-> WrappedArrow a (NTree XNode) [Creator]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Creator -> a (NTree XNode) [Creator]
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) Creator -> a (NTree XNode) [Creator])
-> a (NTree XNode) Creator -> a (NTree XNode) [Creator]
forall a b. (a -> b) -> a -> b
$ String -> a (NTree XNode) (String, Creator)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (String, Creator)
creatorP String
"contributor" a (NTree XNode) (String, Creator)
-> ([(String, Creator)] -> [Creator]) -> a (NTree XNode) Creator
forall b c d. a b c -> ([c] -> [d]) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
         ((String, Creator) -> Creator) -> [(String, Creator)] -> [Creator]
forall a b. (a -> b) -> [a] -> [b]
map ([Refinement] -> (String, Creator) -> Creator
refineCreator [Refinement]
refinements))
      WrappedArrow
  a
  (NTree XNode)
  ([Creator]
   -> Map DateEvent DateValue
   -> [Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [Creator]
-> WrappedArrow
     a
     (NTree XNode)
     (Map DateEvent DateValue
      -> [Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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) [Creator] -> WrappedArrow a (NTree XNode) [Creator]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Creator]
 -> WrappedArrow a (NTree XNode) [Creator])
-> a (NTree XNode) [Creator]
-> WrappedArrow a (NTree XNode) [Creator]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Creator -> a (NTree XNode) [Creator]
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) Creator -> a (NTree XNode) [Creator])
-> a (NTree XNode) Creator -> a (NTree XNode) [Creator]
forall a b. (a -> b) -> a -> b
$ String -> a (NTree XNode) (String, Creator)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) (String, Creator)
creatorP String
"creator" a (NTree XNode) (String, Creator)
-> ([(String, Creator)] -> [Creator]) -> a (NTree XNode) Creator
forall b c d. a b c -> ([c] -> [d]) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>.
         ((String, Creator) -> Creator) -> [(String, Creator)] -> [Creator]
forall a b. (a -> b) -> [a] -> [b]
map ([Refinement] -> (String, Creator) -> Creator
refineCreator [Refinement]
refinements))
      WrappedArrow
  a
  (NTree XNode)
  (Map DateEvent DateValue
   -> [Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) (Map DateEvent DateValue)
-> WrappedArrow
     a
     (NTree XNode)
     ([Source]
      -> Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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
<*> ([(DateEvent, DateValue)] -> Map DateEvent DateValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DateEvent, DateValue)] -> Map DateEvent DateValue)
-> ([Maybe (DateEvent, DateValue)] -> [(DateEvent, DateValue)])
-> [Maybe (DateEvent, DateValue)]
-> Map DateEvent DateValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (DateEvent, DateValue)] -> [(DateEvent, DateValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (DateEvent, DateValue)] -> Map DateEvent DateValue)
-> WrappedArrow a (NTree XNode) [Maybe (DateEvent, DateValue)]
-> WrappedArrow a (NTree XNode) (Map DateEvent DateValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a (NTree XNode) [Maybe (DateEvent, DateValue)]
-> WrappedArrow a (NTree XNode) [Maybe (DateEvent, DateValue)]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Maybe (DateEvent, DateValue)]
 -> WrappedArrow a (NTree XNode) [Maybe (DateEvent, DateValue)])
-> a (NTree XNode) [Maybe (DateEvent, DateValue)]
-> WrappedArrow a (NTree XNode) [Maybe (DateEvent, DateValue)]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) (Maybe (DateEvent, DateValue))
-> a (NTree XNode) [Maybe (DateEvent, DateValue)]
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) (Maybe (DateEvent, DateValue))
 -> a (NTree XNode) [Maybe (DateEvent, DateValue)])
-> a (NTree XNode) (Maybe (DateEvent, DateValue))
-> a (NTree XNode) [Maybe (DateEvent, DateValue)]
forall a b. (a -> b) -> a -> b
$ [a (NTree XNode) (Maybe (DateEvent, DateValue))]
-> a (NTree XNode) (Maybe (DateEvent, DateValue))
forall b c. [a b c] -> a b c
forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA [a (NTree XNode) (Maybe (DateEvent, DateValue))
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe (DateEvent, DateValue))
dateElemP, a (NTree XNode) (Maybe (DateEvent, DateValue))
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe (DateEvent, DateValue))
dateMetaP]))
      WrappedArrow
  a
  (NTree XNode)
  ([Source]
   -> Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [Source]
-> WrappedArrow
     a
     (NTree XNode)
     (Maybe String
      -> [String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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) [Source] -> WrappedArrow a (NTree XNode) [Source]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Source] -> WrappedArrow a (NTree XNode) [Source])
-> a (NTree XNode) [Source]
-> WrappedArrow a (NTree XNode) [Source]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Source -> a (NTree XNode) [Source]
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) Source -> a (NTree XNode) [Source])
-> a (NTree XNode) Source -> a (NTree XNode) [Source]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) (String, Source)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (String, Source)
sourceP a (NTree XNode) (String, Source)
-> ([(String, Source)] -> [Source]) -> a (NTree XNode) Source
forall b c d. a b c -> ([c] -> [d]) -> a b d
forall (a :: * -> * -> *) b c d.
ArrowList a =>
a b c -> ([c] -> [d]) -> a b d
>>. ((String, Source) -> Source) -> [(String, Source)] -> [Source]
forall a b. (a -> b) -> [a] -> [b]
map ([Refinement] -> (String, Source) -> Source
refineSource [Refinement]
refinements))
      WrappedArrow
  a
  (NTree XNode)
  (Maybe String
   -> [String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) (Maybe String)
-> WrappedArrow
     a
     (NTree XNode)
     ([String]
      -> [Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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) (Maybe String)
-> WrappedArrow a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow a (NTree XNode) (Maybe String)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (Maybe String)
typeP)
      WrappedArrow
  a
  (NTree XNode)
  ([String]
   -> [Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow
     a
     (NTree XNode)
     ([Description]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
coverageP)
      WrappedArrow
  a
  (NTree XNode)
  ([Description]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> Metadata)
-> WrappedArrow a (NTree XNode) [Description]
-> WrappedArrow
     a
     (NTree XNode)
     ([String]
      -> [String] -> [String] -> [String] -> [String] -> Metadata)
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) [Description]
-> WrappedArrow a (NTree XNode) [Description]
forall (a :: * -> * -> *) b c. a b c -> WrappedArrow a b c
WrapArrow (a (NTree XNode) [Description]
 -> WrappedArrow a (NTree XNode) [Description])
-> a (NTree XNode) [Description]
-> WrappedArrow a (NTree XNode) [Description]
forall a b. (a -> b) -> a -> b
$ a (NTree XNode) Description -> a (NTree XNode) [Description]
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) Description
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) Description
descriptionP)
      WrappedArrow
  a
  (NTree XNode)
  ([String]
   -> [String] -> [String] -> [String] -> [String] -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow
     a
     (NTree XNode)
     ([String] -> [String] -> [String] -> [String] -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
formatP)
      WrappedArrow
  a
  (NTree XNode)
  ([String] -> [String] -> [String] -> [String] -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow
     a (NTree XNode) ([String] -> [String] -> [String] -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
publisherP)
      WrappedArrow
  a (NTree XNode) ([String] -> [String] -> [String] -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow a (NTree XNode) ([String] -> [String] -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
relationP)
      WrappedArrow a (NTree XNode) ([String] -> [String] -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow a (NTree XNode) ([String] -> Metadata)
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
rightsP)
      WrappedArrow a (NTree XNode) ([String] -> Metadata)
-> WrappedArrow a (NTree XNode) [String]
-> WrappedArrow a (NTree XNode) Metadata
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 -> a (NTree XNode) [String]
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) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
subjectP)
      )