{- | Data types for working with the metadata of epub documents

   This module defines the Metadata structure which contains most of the taxonomic information about the literary work. Metadata is probably the most important data structure in this library.

   Both commonly-used versions of epub (2.x and 3.x) are supported by these types.
-}
module Codec.Epub.Data.Metadata
   ( Metadata (..)
   , Identifier (..)
   , Title (..)
   , Creator (..)
   , DateValue (..)
   , DateEvent (..)
   , Description (..)
   , Refinement (..)
   , dateEventFromString
   , dateEventToString
   , emptyMetadata
   , refineIdentifier
   , refineTitle
   , refineCreator
   )
   where

import Control.Monad ( mplus )
import Data.List ( find )
import qualified Data.Map.Strict as Map
import Data.Map.Strict ( Map )


{- | Refinements represent meta tags within the metadata section
   that refine other tags. These are used during the parsing phase
   and are discarded as their information is slotted into the data
   they refine (CreatorS, TitleS, IdentifierS, etc..)

   This is specific to epub3
-}
data Refinement = Refinement
   { Refinement -> String
refId :: String  -- ^ id attribute
   , Refinement -> String
refProp :: String  -- ^ property attribute
   , Refinement -> String
refScheme :: String  -- ^ scheme attribute
   , Refinement -> String
refText :: String  -- ^ meta tag text
   }


{- Used for locating specific meta information in a list of
   Refinements. The data from these meta tags is related to other
   tags by an XML id attribute.
-}
findByIdProp :: String -> String -> [Refinement] -> Maybe Refinement
findByIdProp :: String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
i String
prop = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Refinement
r -> Refinement -> String
refId Refinement
r forall a. Eq a => a -> a -> Bool
== String
i Bool -> Bool -> Bool
&& Refinement -> String
refProp Refinement
r forall a. Eq a => a -> a -> Bool
== String
prop)


-- | package\/metadata\/dc:identifier tag
data Identifier = Identifier
   { Identifier -> Maybe String
idId :: Maybe String  -- ^ id attribute
   , Identifier -> Maybe String
idType :: Maybe String  -- ^ identifier-type property from meta tag
   , Identifier -> Maybe String
idScheme :: Maybe String  -- ^ scheme from attribute or meta tag
   , Identifier -> String
idText :: String  -- ^ identifier tag text
   }
   deriving (Identifier -> Identifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show)


{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta
   tag info into the data gathered from an identifier tag
-}
refineIdentifier :: [Refinement] -> Identifier -> Identifier
refineIdentifier :: [Refinement] -> Identifier -> Identifier
refineIdentifier [Refinement]
refinements Identifier
ident = Identifier -> Identifier
assignScheme forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
assignType forall a b. (a -> b) -> a -> b
$ Identifier
ident
   where
      meta :: Maybe Refinement
meta = String -> String -> [Refinement] -> Maybe Refinement
findByIdProp (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe String
idId Identifier
ident)
         String
"identifier-type" [Refinement]
refinements

      assignType :: Identifier -> Identifier
assignType Identifier
ident' = Identifier
ident' { idType :: Maybe String
idType = Refinement -> String
refText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Refinement
meta }

      assignScheme :: Identifier -> Identifier
assignScheme Identifier
ident' =
         let existingScheme :: Maybe String
existingScheme = Identifier -> Maybe String
idScheme Identifier
ident'
         in Identifier
ident' { idScheme :: Maybe String
idScheme = Maybe String
existingScheme forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
               (Refinement -> String
refScheme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Refinement
meta) }


-- | package\/metadata\/dc:title tag
data Title = Title
   { Title -> Maybe String
titleLang :: Maybe String  -- ^ lang attribute
   , Title -> Maybe String
titleType :: Maybe String  -- ^ title-type property from meta tag
   , Title -> Maybe Int
titleSeq :: Maybe Int  -- ^ display-sequence property from meta
   , Title -> String
titleText :: String  -- ^ title tag text
   }
   deriving (Title -> Title -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Title -> Title -> Bool
$c/= :: Title -> Title -> Bool
== :: Title -> Title -> Bool
$c== :: Title -> Title -> Bool
Eq, Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Title] -> ShowS
$cshowList :: [Title] -> ShowS
show :: Title -> String
$cshow :: Title -> String
showsPrec :: Int -> Title -> ShowS
$cshowsPrec :: Int -> Title -> ShowS
Show)


{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta
   tag info into the data gathered from a title tag
-}
refineTitle :: [Refinement] -> (String, Title) -> Title
refineTitle :: [Refinement] -> (String, Title) -> Title
refineTitle [Refinement]
refinements (String
elid, Title
title) = Title -> Title
assignSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Title
assignType forall a b. (a -> b) -> a -> b
$ Title
title
   where
      assignType :: Title -> Title
assignType Title
title' =
         let newTy :: Maybe String
newTy = Refinement -> String
refText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
               String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
elid String
"title-type" [Refinement]
refinements
         in Title
title' { titleType :: Maybe String
titleType = Maybe String
newTy }

      assignSeq :: Title -> Title
assignSeq Title
title' =
         let sq :: Maybe Int
sq = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refinement -> String
refText) forall a b. (a -> b) -> a -> b
$
               String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
elid String
"display-seq" [Refinement]
refinements
         in Title
title' { titleSeq :: Maybe Int
titleSeq = Maybe Int
sq }


{- | package\/metadata\/dc:creator or package\/metadata\/dc:contributor
   tags

   This structure is used for both contributor and creator as they are exactly the same.
-}
data Creator = Creator
   { Creator -> Maybe String
creatorRole :: Maybe String  -- ^ role from attribute or meta tag
   , Creator -> Maybe String
creatorFileAs :: Maybe String  -- ^ file-as from attribute or meta tag
   , Creator -> Maybe Int
creatorSeq :: Maybe Int  -- ^ display-sequence property from meta
   , Creator -> String
creatorText :: String  -- ^ creator or contributor tag text
   }
   deriving (Creator -> Creator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Creator -> Creator -> Bool
$c/= :: Creator -> Creator -> Bool
== :: Creator -> Creator -> Bool
$c== :: Creator -> Creator -> Bool
Eq, Int -> Creator -> ShowS
[Creator] -> ShowS
Creator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Creator] -> ShowS
$cshowList :: [Creator] -> ShowS
show :: Creator -> String
$cshow :: Creator -> String
showsPrec :: Int -> Creator -> ShowS
$cshowsPrec :: Int -> Creator -> ShowS
Show)


{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta
   tag info into the data gathered from contributor and creator tags
-}
refineCreator :: [Refinement] -> (String, Creator) -> Creator
refineCreator :: [Refinement] -> (String, Creator) -> Creator
refineCreator [Refinement]
refinements (String
elid, Creator
creator) =
   Creator -> Creator
assignSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. Creator -> Creator
assignFileAs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Creator -> Creator
assignRole forall a b. (a -> b) -> a -> b
$ Creator
creator

   where
      assignRole :: Creator -> Creator
assignRole Creator
creator' =
         let existingRole :: Maybe String
existingRole = Creator -> Maybe String
creatorRole Creator
creator'
             metaRole :: Maybe String
metaRole = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refinement -> String
refText) forall a b. (a -> b) -> a -> b
$
               String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
elid String
"role" [Refinement]
refinements
         in Creator
creator' { creatorRole :: Maybe String
creatorRole = Maybe String
existingRole forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
metaRole }

      assignFileAs :: Creator -> Creator
assignFileAs Creator
creator' =
         let existingFileAs :: Maybe String
existingFileAs = Creator -> Maybe String
creatorFileAs Creator
creator'
             metaFileAs :: Maybe String
metaFileAs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refinement -> String
refText) forall a b. (a -> b) -> a -> b
$
               String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
elid String
"file-as" [Refinement]
refinements
         in Creator
creator' { creatorFileAs :: Maybe String
creatorFileAs = Maybe String
existingFileAs forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
metaFileAs }

      assignSeq :: Creator -> Creator
assignSeq Creator
creator' =
         let sq :: Maybe Int
sq = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refinement -> String
refText) forall a b. (a -> b) -> a -> b
$
               String -> String -> [Refinement] -> Maybe Refinement
findByIdProp String
elid String
"display-seq" [Refinement]
refinements
         in Creator
creator' { creatorSeq :: Maybe Int
creatorSeq = Maybe Int
sq }


data DateEvent
  = Available
  | Created
  | Date
  | DateAccepted
  | DateCopyrighted
  | DateSubmitted
  | Epub
  | Issued
  | Modified
  | Valid
  deriving (DateEvent -> DateEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateEvent -> DateEvent -> Bool
$c/= :: DateEvent -> DateEvent -> Bool
== :: DateEvent -> DateEvent -> Bool
$c== :: DateEvent -> DateEvent -> Bool
Eq, Eq DateEvent
DateEvent -> DateEvent -> Bool
DateEvent -> DateEvent -> Ordering
DateEvent -> DateEvent -> DateEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DateEvent -> DateEvent -> DateEvent
$cmin :: DateEvent -> DateEvent -> DateEvent
max :: DateEvent -> DateEvent -> DateEvent
$cmax :: DateEvent -> DateEvent -> DateEvent
>= :: DateEvent -> DateEvent -> Bool
$c>= :: DateEvent -> DateEvent -> Bool
> :: DateEvent -> DateEvent -> Bool
$c> :: DateEvent -> DateEvent -> Bool
<= :: DateEvent -> DateEvent -> Bool
$c<= :: DateEvent -> DateEvent -> Bool
< :: DateEvent -> DateEvent -> Bool
$c< :: DateEvent -> DateEvent -> Bool
compare :: DateEvent -> DateEvent -> Ordering
$ccompare :: DateEvent -> DateEvent -> Ordering
Ord, Int -> DateEvent -> ShowS
[DateEvent] -> ShowS
DateEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateEvent] -> ShowS
$cshowList :: [DateEvent] -> ShowS
show :: DateEvent -> String
$cshow :: DateEvent -> String
showsPrec :: Int -> DateEvent -> ShowS
$cshowsPrec :: Int -> DateEvent -> ShowS
Show)

dateEventFromString :: Maybe String -> Maybe DateEvent
dateEventFromString :: Maybe String -> Maybe DateEvent
dateEventFromString (Just String
"dcterms:available") = forall a. a -> Maybe a
Just DateEvent
Available
dateEventFromString (Just String
"dcterms:created") = forall a. a -> Maybe a
Just DateEvent
Created
dateEventFromString (Just String
"publication") = forall a. a -> Maybe a
Just DateEvent
Created                      -- EPUB 2.x
dateEventFromString (Just String
"dcterms:date") = forall a. a -> Maybe a
Just DateEvent
Date
dateEventFromString (Just String
"dcterms:dateAccepted") = forall a. a -> Maybe a
Just DateEvent
DateAccepted
dateEventFromString (Just String
"dcterms:dateCopyrighted") = forall a. a -> Maybe a
Just DateEvent
DateCopyrighted
dateEventFromString (Just String
"dcterms:dateSubmitted") = forall a. a -> Maybe a
Just DateEvent
DateSubmitted
dateEventFromString (Just String
"dcterms:issued") = forall a. a -> Maybe a
Just DateEvent
Issued
dateEventFromString (Just String
"original-publication") = forall a. a -> Maybe a
Just DateEvent
Issued              -- EPUB 2.x
dateEventFromString (Just String
"dcterms:modified") = forall a. a -> Maybe a
Just DateEvent
Modified
dateEventFromString (Just String
"dcterms:valid") = forall a. a -> Maybe a
Just DateEvent
Valid
dateEventFromString Maybe String
Nothing = forall a. a -> Maybe a
Just DateEvent
Epub
dateEventFromString Maybe String
_ = forall a. Maybe a
Nothing

dateEventToString :: DateEvent -> String
dateEventToString :: DateEvent -> String
dateEventToString DateEvent
Available = String
"available"
dateEventToString DateEvent
Created = String
"created"
dateEventToString DateEvent
Date = String
"date"
dateEventToString DateEvent
DateAccepted = String
"dateAccepted"
dateEventToString DateEvent
DateCopyrighted = String
"dateCopyrighted"
dateEventToString DateEvent
DateSubmitted = String
"dateSubmitted"
dateEventToString DateEvent
Epub = String
"EPUB created"
dateEventToString DateEvent
Issued = String
"issued"
dateEventToString DateEvent
Modified = String
"modified"
dateEventToString DateEvent
Valid = String
"valid"


-- | EPUB 2.x: package\/metadata\/dc:date tag, opf:event attribute, text
-- | EPUB 3.x: package\/metadata\/dc:date tag
-- |           package\/metadata\/meta property="dcterms:issued"
-- |           package\/metadata\/meta property="dcterms:modified"
-- |           package\/metadata\/meta property="dcterms:..."
newtype DateValue = DateValue String
   deriving (DateValue -> DateValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateValue -> DateValue -> Bool
$c/= :: DateValue -> DateValue -> Bool
== :: DateValue -> DateValue -> Bool
$c== :: DateValue -> DateValue -> Bool
Eq, Int -> DateValue -> ShowS
[DateValue] -> ShowS
DateValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateValue] -> ShowS
$cshowList :: [DateValue] -> ShowS
show :: DateValue -> String
$cshow :: DateValue -> String
showsPrec :: Int -> DateValue -> ShowS
$cshowsPrec :: Int -> DateValue -> ShowS
Show)


-- | package\/metadata\/dc:description tag, xml:lang attribute, text
data Description = Description (Maybe String) String
   deriving (Description -> Description -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c== :: Description -> Description -> Bool
Eq, Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Description] -> ShowS
$cshowList :: [Description] -> ShowS
show :: Description -> String
$cshow :: Description -> String
showsPrec :: Int -> Description -> ShowS
$cshowsPrec :: Int -> Description -> ShowS
Show)


{- | package\/metadata tag

   This is perhaps the most useful data structure in this library. It
   contains most of the information tools will want to use to
   organize epub documents.
-}
data Metadata = Metadata
   { Metadata -> [Identifier]
metaIds :: [Identifier]  -- ^ at least one required
   , Metadata -> [Title]
metaTitles :: [Title]  -- ^ at least one required
   , Metadata -> [String]
metaLangs :: [String]  -- ^ dc:language tags, at least one required
   , Metadata -> [Creator]
metaContributors :: [Creator]
   , Metadata -> [Creator]
metaCreators :: [Creator]
   , Metadata -> Map DateEvent DateValue
metaDates :: Map DateEvent DateValue
   , Metadata -> Maybe String
metaSource :: Maybe String  -- ^ dc:source tags
   , Metadata -> Maybe String
metaType :: Maybe String  -- ^ dc:type tags
   , Metadata -> [String]
metaCoverages :: [String]  -- ^ dc:coverage tags
   , Metadata -> [Description]
metaDescriptions :: [Description]
   , Metadata -> [String]
metaFormats :: [String]  -- ^ dc:format tags
   , Metadata -> [String]
metaPublishers :: [String]  -- ^ dc:publisher tags
   , Metadata -> [String]
metaRelations :: [String]  -- ^ dc:relation tags
   , Metadata -> [String]
metaRights :: [String]  -- ^ dc:rights tags
   , Metadata -> [String]
metaSubjects :: [String]  -- ^ dc:subject tags
   }
   deriving (Metadata -> Metadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show)

-- | Note: This isn't valid as-is, some required values are empty lists!
emptyMetadata :: Metadata
emptyMetadata :: Metadata
emptyMetadata = Metadata
   { metaIds :: [Identifier]
metaIds = []  -- one required
   , metaTitles :: [Title]
metaTitles = []  -- one required
   , metaLangs :: [String]
metaLangs = []  -- one required
   , metaContributors :: [Creator]
metaContributors = []
   , metaCreators :: [Creator]
metaCreators = []
   , metaDates :: Map DateEvent DateValue
metaDates = forall k a. Map k a
Map.empty
   , metaSource :: Maybe String
metaSource = forall a. Maybe a
Nothing
   , metaType :: Maybe String
metaType = forall a. Maybe a
Nothing
   , metaCoverages :: [String]
metaCoverages = []
   , metaDescriptions :: [Description]
metaDescriptions = []
   , metaFormats :: [String]
metaFormats = []
   , metaPublishers :: [String]
metaPublishers = []
   , metaRelations :: [String]
metaRelations = []
   , metaRights :: [String]
metaRights = []
   , metaSubjects :: [String]
metaSubjects = []
   }