module Text.CSL.Input.MODS where
import Text.CSL.Output.Plain ( (<+>) )
import Text.CSL.Reference
import Text.CSL.Pickle
import Text.CSL.Style ( betterThen )
import Data.Char ( isDigit, isLower )
#ifdef USE_HXT
import Text.XML.HXT.Arrow.Pickle.Xml
#endif
readModsFile :: FilePath -> IO Reference
readModsFile = readXmlFile xpMods
readModsCollectionFile :: FilePath -> IO [Reference]
readModsCollectionFile = readXmlFile xpModsCollection
xpModsCollection :: PU [Reference]
xpModsCollection = xpIElem "modsCollection" $ xpList xpMods
xpMods :: PU Reference
xpMods = xpIElem "mods" xpReference
xpReference :: PU Reference
xpReference
= xpWrap ( \ ( ref
, (ck,ty,ti)
,((au,ed,tr),(re,it,pu'),(co,ce))
,((di',pg,vl,is),(nu,sc,ch))
, (di,pu,pp)
, (ac,uri)
) ->
ref { refId = ck `betterThen` take 10 (concat $ words ti)
, refType = if refType ref /= NoType then refType ref else ty
, title = ti
, author = au
, editor = ed `betterThen` editor ref
, translator = tr `betterThen` translator ref
, recipient = re `betterThen` recipient ref
, interviewer = it `betterThen` interviewer ref
, composer = co `betterThen` composer ref
, collectionEditor = ce `betterThen` collectionEditor ref
, publisherPlace = pp `betterThen` publisherPlace ref
, containerAuthor = containerAuthor ref
, url = uri
, accessed = ac
, issued = issued ref `betterThen` di `betterThen` di'
, page = page ref `betterThen` pg
, volume = volume ref `betterThen` vl
, issue = issue ref `betterThen` is
, number = number ref `betterThen` nu
, section = section ref `betterThen` sc
, chapterNumber = chapterNumber ref `betterThen` ch
, publisher = (foldr (<+>) [] . map show $ pu)
`betterThen` publisher ref
`betterThen` (foldr (<+>) [] . map show $ pu')
}
, \r -> ( r
, (refId r, refType r, title r)
,((author r, editor r, translator r)
,(recipient r, interviewer r, emptyAgents )
,(composer r, collectionEditor r))
,((issued r, page r, volume r, issue r)
,(number r, section r, chapterNumber r))
, (issued r, emptyAgents, publisherPlace r)
, (accessed r, url r)
)) $
xp6Tuple (xpDefault emptyReference xpRelatedItem)
(xpTriple xpCiteKey xpRefType xpTitle )
xpAgents xpPart xpOrigin xpUrl
xpCiteKey :: PU String
xpCiteKey
= xpDefault [] $
xpChoice (xpAttr "ID" xpText)
(xpIElem "identifier" xpText)
xpLift
xpOrigin :: PU ([RefDate],[Agent],String)
xpOrigin
= xpDefault ([],[],[]) . xpIElem "originInfo" $
xpTriple (xpDefault [] $ xpWrap (readDate,show) $
xpIElem "dateIssued" xpText0)
(xpDefault [] $ xpList $ xpWrap (\s -> Agent [] [] [] s [] [] False, show) $
xpIElem "publisher" xpText0)
(xpDefault [] $ xpIElem "place" $ xpIElem "placeTerm" xpText0)
xpRefType :: PU RefType
xpRefType
= xpDefault NoType $
xpWrap (readType, const []) xpGenre
where
readType [] = NoType
readType (t:_)
| "conference publication" <- t = PaperConference
| "periodical" <- t = ArticleJournal
| otherwise = Book
xpRefType' :: PU RefType
xpRefType'
= xpDefault NoType $
xpWrap (readTypeIn, const []) xpGenre
where
readTypeIn [] = NoType
readTypeIn t
| "book" `elem` t = Chapter
| "conference publication" `elem` t = PaperConference
| "academic journal" `elem` t = ArticleJournal
| "collection" `elem` t = Chapter
| otherwise = ArticleJournal
xpGenre :: PU [String]
xpGenre
= xpList $ xpIElem "genre" $
xpChoice xpZero
(xpPair (xpDefault [] $ xpAttr "authority" xpText) xpText)
$ xpLift . snd
xpRelatedItem :: PU Reference
xpRelatedItem
= xpIElem "relatedItem" . xpAddFixedAttr "type" "host" $
xpWrap ( \( (ty,ct)
,((ca,ed,tr),(re,it,pu'),(co,ce))
,((di,pg,vl,is),(nu,sc,ch))
, (di',pu,pp)
) ->
emptyReference { refType = ty
, containerAuthor = ca
, containerTitle = ct
, editor = ed
, translator = tr
, recipient = re
, interviewer = it
, publisher = foldr (<+>) [] . map show $ pu `betterThen` pu'
, publisherPlace = pp
, composer = co
, collectionEditor = ce
, issued = di `betterThen` di'
, page = pg
, volume = vl
, issue = is
, number = nu
, section = sc
, chapterNumber = ch
}
, \r -> ( (refType r, containerTitle r)
,((containerAuthor r, editor r, translator r)
,(recipient r, interviewer r, emptyAgents )
,(composer r, collectionEditor r))
,((issued r, page r, volume r, issue r)
,(number r, section r, chapterNumber r))
, (issued r, emptyAgents, publisherPlace r)
)) $
xp4Tuple (xpPair xpRefType' xpTitle)
xpAgents xpPart xpOrigin
xpTitle :: PU String
xpTitle
= xpWrap (uncurry (<+>), \s -> (s,[])) $
xpIElem "titleInfo" $
xpPair (xpIElem "title" xpText0)
(xpDefault [] $ xpIElem "subTitle" xpText0)
xpAgents :: PU (([Agent],[Agent],[Agent])
,([Agent],[Agent],[Agent])
,([Agent],[Agent]))
xpAgents
= xpTriple (xpTriple (xpAgent "author" "aut")
(xpAgent "editor" "edt")
(xpAgent "translator" "trl"))
(xpTriple (xpAgent "recipient" "rcp")
(xpAgent "interviewer" "ivr")
(xpAgent "publisher" "pbl"))
(xpPair (xpAgent "composer" "cmp")
(xpAgent "collector" "xol"))
xpAgent :: String -> String -> PU [Agent]
xpAgent sa sb
= xpDefault [] $ xpList $ xpIElem "name" $
xpChoice xpZero
(xpIElem "role" $ xpIElem "roleTerm" xpText0)
(\x -> if x == sa || x == sb then xpickle else xpZero)
instance XmlPickler Agent where
xpickle = xpWrap ( uncurry parseName
, \(Agent gn _ _ fn _ _ _) -> (gn,fn)) $
xpAddFixedAttr "type" "personal" xpNameData
parseName :: [String] -> String -> Agent
parseName gn fn
| ("!":sf:",":xs) <- gn = parse xs (sf ++ ".") True
| ("!":sf :xs) <- gn
, sf /= [] , last sf == ',' = parse xs sf True
| (sf:",":xs) <- gn = parse xs (sf ++ ".") False
| (sf :xs) <- gn
, sf /= [], last sf == ',' = parse xs sf False
| otherwise = parse gn "" False
where
parse g s b = Agent (getGiven g) (getDrop g) (getNonDrop fn) (getFamily fn) s [] b
getDrop = unwords . filter (and . map isLower)
getGiven = filter (not . and . map isLower)
getNonDrop = getDrop . words
getFamily = unwords . getGiven . words
xpNameData :: PU ([String],String)
xpNameData
= xpWrap (readName,const []) $
xpList $ xpElem "namePart" $ xpPair (xpAttr "type" xpText) xpText0
where
readName x = (readg x, readf x)
readf = foldr (\(k,v) xs -> if k == "family" then v else xs) []
readg = foldr (\(k,v) xs -> if k == "given" then v:xs else xs) []
xpPart :: PU (([RefDate],String,String,String)
,(String,String,String))
xpPart
= xpDefault none . xpIElem "part" .
xpWrap (readIt none,const []) $ xpList xpDetail
where
none = (([],"","",""),("","",""))
readIt r [] = r
readIt acc@((d,p,v,i),(n,s,c)) (x:xs)
| Date y <- x = readIt ((y,p,v,i),(n,s,c)) xs
| Page y <- x = readIt ((d,y,v,i),(n,s,c)) xs
| Volume y <- x = readIt ((d,p,y,i),(n,s,c)) xs
| Issue y <- x = readIt ((d,p,v,y),(n,s,c)) xs
| Number y <- x = readIt ((d,p,v,i),(y,s,c)) xs
| ChapterNr y <- x = readIt ((d,p,v,i),(n,s,y)) xs
| Section y <- x = readIt ((d,p,v,i),(n,y,c)) xs
| otherwise = acc
data Detail
= Date [RefDate]
| Page String
| Volume String
| Issue String
| Number String
| ChapterNr String
| Section String
deriving ( Eq, Show )
xpDetail :: PU Detail
xpDetail
= xpAlt tag ps
where
tag _ = 0
ps = [ xpWrap (Date, const []) $ xpDate
, xpWrap (Page, show) $ xpPage
, xpWrap (Volume, show) $ xp "volume"
, xpWrap (Issue, show) $ xp "issue"
, xpWrap (Number, show) $ xp "number"
, xpWrap (Section, show) $ xp "section"
, xpWrap (ChapterNr,show) $ xp "chapter"
]
xpDate = xpWrap (readDate,show) (xpElem "date" xpText0)
xp s = xpElemWithAttrValue "detail" "type" s $
xpElem "number" xpText
xpPage :: PU String
xpPage
= xpChoice (xpElemWithAttrValue "detail" "type" "page" $ xpIElem "number" xpText)
(xpElemWithAttrValue "extent" "unit" "page" $
xpPair (xpElem "start" xpText)
(xpElem "end" xpText))
(\(s,e) -> xpLift (s ++ "-" ++ e))
xpUrl :: PU ([RefDate],String)
xpUrl
= xpDefault ([],[]) . xpIElem "location" $
xpPair (xpWrap (readDate,show) $
xpDefault [] $ xpAttr "dateLastAccessed" xpText)
(xpDefault [] $ xpElem "url" xpText)
readDate :: String -> [RefDate]
readDate s = if takeWhile isDigit s /= []
then return $ RefDate (takeWhile isDigit s) [] [] [] [] []
else []
emptyAgents :: [Agent]
emptyAgents = []