1 {-# LANGUAGE RecordWildCards #-}
    2 module Databrary.EZID.DataCite
    3   ( DataCite(..)
    4   , dataCiteXML
    5   ) where
    6 
    7 import Control.Arrow (first)
    8 import qualified Data.ByteString as BS
    9 import qualified Data.ByteString.Char8 as BSC
   10 import Data.Maybe (isNothing, catMaybes)
   11 import Data.Monoid ((<>))
   12 import qualified Data.Text as T
   13 import Network.URI (URI(..))
   14 import qualified Text.XML.Light as XML
   15 
   16 import Databrary.Ops
   17 import Databrary.Model.Party.Types
   18 import Databrary.Model.Funding.Types
   19 import Databrary.Model.Funding.FundRef
   20 
   21 data DataCite = DataCite
   22   { dataCiteDOI :: Maybe BS.ByteString
   23   , dataCiteTitle :: T.Text
   24   , dataCiteAuthors :: [Party]
   25   , dataCiteYear :: Int
   26   , dataCiteDescription :: Maybe T.Text
   27   , dataCiteFunders :: [Funding]
   28   , dataCitePublication :: Maybe URI
   29   , dataCiteReferences :: [URI]
   30   , dataCiteSubjects :: [BS.ByteString]
   31   }
   32 
   33 dataCiteXML :: DataCite -> XML.Element
   34 dataCiteXML DataCite{..} =
   35   "resource" <=>
   36     [ "xmlns" =. "http://datacite.org/schema/kernel-3"
   37     , XML.Attr (q "xsi"){ XML.qPrefix = Just "xmlns" } "http://www.w3.org/2001/XMLSchema-instance"
   38     , XML.Attr (q "schemaLocation"){ XML.qPrefix = Just "xsi" } "http://datacite.org/schema/kernel-3 http://schema.datacite.org/meta/kernel-3/metadata.xsd"
   39     ] $ catMaybes
   40     [ Just $ "identifier" <=>
   41       ("identifierType" =. "DOI")
   42       $ maybe "(:tba)" BSC.unpack dataCiteDOI
   43     , Just $ "publisher" <.> "Databrary"
   44     , Just $ "resourceType" <=>
   45       ("resourceTypeGeneral" =. "Dataset")
   46       $ "Volume"
   47     , Just $ "rightsList" <.> ("rights" <=>
   48       ("rightsURI" =. "http://databrary.org/access/policies/agreement.html")
   49       ) "Databrary Access Agreement"
   50     , Just $ "titles" <.> "title" <.> T.unpack dataCiteTitle
   51     , "creators" <?> dataCiteAuthors $ \Party{ partyRow = PartyRow{..} } -> "creator" <.> catMaybes
   52       [ Just $ "creatorName" <.> (T.unpack $ partySortName <> foldMap (T.pack ", " <>) partyPreName)
   53       , ("nameIdentifier" <=>
   54         [ "schemeURI" =. "http://orcid.org/"
   55         , "nameIdentifierScheme" =. "ORCID"
   56         ]) . show <$> partyORCID
   57       , ("affiliation" <.>) . T.unpack <$> partyAffiliation
   58       ]
   59     , Just $ "publicationYear" <.> show dataCiteYear
   60     , ("descriptions" <.>) . ("description" <=>
   61       ("descriptionType" =. "Abstract"))
   62       . T.unpack <$> dataCiteDescription
   63     , "contributors" <?> dataCiteFunders $ \Funding{ fundingFunder = Funder{..} } -> "contributor" <=>
   64       [ "contributorType" =. "Funder" ] $
   65       [ "contributorName" <.> T.unpack funderName
   66       , "nameIdentifier" <=>
   67         [ "schemeURI" =. "http://crossref.org/fundref"
   68         , "nameIdentifierScheme" =. "FundRef"
   69         ] $ fundRefDOI ++ show funderId
   70       ]
   71     , "subjects" <?> dataCiteSubjects $ ("subject" <.>) . BSC.unpack
   72     , (isNothing dataCitePublication || null dataCiteReferences) `unlessUse`
   73       ("relatedIdentifiers" <.>
   74         (maybe id ((:) . ur "IsSupplementTo") dataCitePublication
   75         $ map (ur "References") dataCiteReferences))
   76     ]
   77   where
   78   infixr 5 <.>, <=>
   79   (<.>) :: XML.Node a => String -> a -> XML.Element
   80   (<.>) = XML.unode
   81   (<=>) :: XML.Node (a, b) => String -> a -> b -> XML.Element
   82   (<=>) = curry . XML.unode
   83   (<?>) :: XML.Node [b] => String -> [a] -> (a -> b) -> Maybe XML.Element
   84   (<?>) _ [] _ = Nothing
   85   (<?>) n l f = Just $ n <.> map f l
   86   (=.) :: String -> String -> XML.Attr
   87   (=.) = XML.Attr . q
   88   q = XML.unqual
   89   ur t u = "relatedIdentifier" <.>
   90     first (("relationType" =. t :) . return . ("relatedIdentifierType" =.))
   91       (case uriScheme u of
   92         "doi:" -> ("DOI", uriPath u)
   93         "hdl:" -> ("Handle", uriPath u)
   94         _ -> ("URL", show u))
   95