--------------------------------------------------------------------
-- |
-- Module    : Text.DublinCore.Types
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
--
-- Representing the DublinCore metadata elements in Haskell.
-- For information on the Dublin Core Metadata Element Set,
-- see: <http://dublincore.org/>
--
module Text.DublinCore.Types
  ( DCItem(..)
  , DCInfo(..)
  , infoToTag
  , dc_element_names
  ) where

import Prelude.Compat

import Data.Text

-- | A DCItem pairs a specific element with its (string) value.
data DCItem =
  DCItem
    { DCItem -> DCInfo
dcElt :: DCInfo
    , DCItem -> Text
dcText :: Text
    }
  deriving (DCItem -> DCItem -> Bool
(DCItem -> DCItem -> Bool)
-> (DCItem -> DCItem -> Bool) -> Eq DCItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DCItem -> DCItem -> Bool
$c/= :: DCItem -> DCItem -> Bool
== :: DCItem -> DCItem -> Bool
$c== :: DCItem -> DCItem -> Bool
Eq, Int -> DCItem -> ShowS
[DCItem] -> ShowS
DCItem -> String
(Int -> DCItem -> ShowS)
-> (DCItem -> String) -> ([DCItem] -> ShowS) -> Show DCItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DCItem] -> ShowS
$cshowList :: [DCItem] -> ShowS
show :: DCItem -> String
$cshow :: DCItem -> String
showsPrec :: Int -> DCItem -> ShowS
$cshowsPrec :: Int -> DCItem -> ShowS
Show)

-- | The Dublin Core Metadata Element Set, all 15 of them (plus an extension constructor.)
data DCInfo
  = DC_Title -- ^ A name given to the resource.
  | DC_Creator -- ^ An entity primarily responsible for making the content of the resource.
  | DC_Subject -- ^ The topic of the content of the resource.
  | DC_Description -- ^ An account of the content of the resource.
  | DC_Publisher -- ^ An entity responsible for making the resource available
  | DC_Contributor -- ^ An entity responsible for making contributions to the content of the resource.
  | DC_Date -- ^ A date associated with an event in the life cycle of the resource (YYYY-MM-DD)
  | DC_Type -- ^ The nature or genre of the content of the resource.
  | DC_Format -- ^ The physical or digital manifestation of the resource.
  | DC_Identifier -- ^ An unambiguous reference to the resource within a given context.
  | DC_Source -- ^ A Reference to a resource from which the present resource is derived.
  | DC_Language -- ^ A language of the intellectual content of the resource.
  | DC_Relation -- ^ A reference to a related resource.
  | DC_Coverage -- ^ The extent or scope of the content of the resource.
  | DC_Rights -- ^ Information about rights held in and over the resource.
  | DC_Other Text -- ^ Other; data type extension mechanism.
  deriving (DCInfo -> DCInfo -> Bool
(DCInfo -> DCInfo -> Bool)
-> (DCInfo -> DCInfo -> Bool) -> Eq DCInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DCInfo -> DCInfo -> Bool
$c/= :: DCInfo -> DCInfo -> Bool
== :: DCInfo -> DCInfo -> Bool
$c== :: DCInfo -> DCInfo -> Bool
Eq, Int -> DCInfo -> ShowS
[DCInfo] -> ShowS
DCInfo -> String
(Int -> DCInfo -> ShowS)
-> (DCInfo -> String) -> ([DCInfo] -> ShowS) -> Show DCInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DCInfo] -> ShowS
$cshowList :: [DCInfo] -> ShowS
show :: DCInfo -> String
$cshow :: DCInfo -> String
showsPrec :: Int -> DCInfo -> ShowS
$cshowsPrec :: Int -> DCInfo -> ShowS
Show)

infoToTag :: DCInfo -> Text
infoToTag :: DCInfo -> Text
infoToTag DCInfo
i =
  case DCInfo
i of
    DCInfo
DC_Title -> Text
"title"
    DCInfo
DC_Creator -> Text
"creator"
    DCInfo
DC_Subject -> Text
"subject"
    DCInfo
DC_Description -> Text
"description"
    DCInfo
DC_Publisher -> Text
"publisher"
    DCInfo
DC_Contributor -> Text
"contributor"
    DCInfo
DC_Date -> Text
"date"
    DCInfo
DC_Type -> Text
"type"
    DCInfo
DC_Format -> Text
"format"
    DCInfo
DC_Identifier -> Text
"identifier"
    DCInfo
DC_Source -> Text
"source"
    DCInfo
DC_Language -> Text
"language"
    DCInfo
DC_Relation -> Text
"relation"
    DCInfo
DC_Coverage -> Text
"coverage"
    DCInfo
DC_Rights -> Text
"rights"
    DC_Other Text
o -> Text
o

dc_element_names :: [Text]
dc_element_names :: [Text]
dc_element_names =
  [ Text
"title"
  , Text
"creator"
  , Text
"subject"
  , Text
"description"
  , Text
"publisher"
  , Text
"contributor"
  , Text
"date"
  , Text
"type"
  , Text
"format"
  , Text
"identifier"
  , Text
"source"
  , Text
"language"
  , Text
"relation"
  , Text
"coverage"
  , Text
"rights"
  ]