{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Reference -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- The Reference type -- ----------------------------------------------------------------------------- module Text.CSL.Reference where import Data.Char ( isUpper, toLower ) import Data.List ( elemIndex, isPrefixOf ) import Data.Maybe ( fromJust ) import Data.Generics -- | An existential type to wrap the different types a 'Reference' is -- made of. This way we can create a map to make queries easier. data Value = forall a . Data a => Value a -- for debuging instance Show Value where show (Value a) = gshow a type ReferenceMap = [(String, Value)] mkRefMap :: Data a => a -> ReferenceMap mkRefMap a = zip fields (gmapQ Value a) where fields = map formatField . constrFields . toConstr $ a formatField :: String -> String formatField = foldr f [] . g where f x xs = if isUpper x then '-' : toLower x : xs else x : xs g (x:xs) = toLower x : xs g [] = [] fromValue :: Data a => Value -> Maybe a fromValue (Value a) = cast a isValueSet :: Value -> Bool isValueSet val | Just v <- fromValue val :: Maybe String = v /= [] | Just v <- fromValue val :: Maybe [Agent] = v /= [] | Just v <- fromValue val :: Maybe [RefDate] = v /= [] | Just v <- fromValue val :: Maybe Int = v /= 0 | Just v <- fromValue val :: Maybe CNum = v /= 0 | Just v <- fromValue val :: Maybe Locator = v /= NoneLoc | otherwise = False data Empty = Empty deriving ( Typeable, Data ) data Agent = Entity String | Person { namePrefix :: String , givenName :: [String] , initials :: String , articular :: String , familyName :: String , nameSuffix :: String } deriving ( Show, Read, Eq, Typeable, Data ) data RefDate = RefDate { year :: Int , month :: Int , day :: Int , other :: String } deriving ( Show, Read, Eq, Typeable, Data ) data RefType = NoType | Article | ArticleMagazine | ArticleNewspaper | ArticleJournal | Bill | Book | Broadcast | Chapter | Entry | EntryDictionary | EntryEncyclopedia | Figure | Graphic | Interview | Legislation | LegalCase | Manuscript | Map | MotionPicture | MusicalScore | Pamphlet | PaperConference | Patent | Post | PostWeblog | PersonalCommunication | Report | Review | ReviewBook | Song | Speech | Thesis | Treaty | Webpage deriving ( Read, Eq, Typeable, Data ) instance Show RefType where show = map toLower . formatField . showConstr . toConstr newtype CNum = CNum { unCNum :: Int } deriving ( Show, Read, Eq, Num, Typeable, Data ) -- | The 'Reference' record. data Reference = Reference { citeKey :: String , refType :: RefType , author :: [Agent] , editor :: [Agent] , translator :: [Agent] , recipient :: [Agent] , interviewer :: [Agent] , publisher :: [Agent] , composer :: [Agent] , originalPublisher :: [Agent] , originalAuthor :: [Agent] , containerAuthor :: [Agent] , collectionEditor :: [Agent] , issued :: [RefDate] , eventDate :: [RefDate] , accessed :: [RefDate] , container :: [RefDate] , originalDate :: [RefDate] , title :: String , containerTitle :: String , collectionTitle :: String , collectionNumber :: Int , originalTitle :: String , publisherPlace :: String , archive :: String , archivePlace :: String , archiveLocation :: String , event :: String , eventPlace :: String , page :: String , locator :: Locator , version :: String , volume :: String , numberOfVolumes :: Int , issue :: String , chapterNumber :: String , medium :: String , status :: String , edition :: String , section :: String , genre :: String , note :: String , annote :: String , abstract :: String , keyword :: String , number :: String , references :: String , url :: String , doi :: String , isbn :: String , citationNumber :: CNum , yearSuffix :: String , citationLabel :: String } deriving ( Eq, Show, Read, Typeable, Data ) emptyReference :: Reference emptyReference = Reference { citeKey = [] , refType = NoType , author = [] , editor = [] , translator = [] , recipient = [] , interviewer = [] , publisher = [] , composer = [] , originalPublisher = [] , originalAuthor = [] , containerAuthor = [] , collectionEditor = [] , issued = [] , eventDate = [] , accessed = [] , container = [] , originalDate = [] , title = [] , containerTitle = [] , collectionTitle = [] , collectionNumber = 0 , originalTitle = [] , publisherPlace = [] , archive = [] , archivePlace = [] , archiveLocation = [] , event = [] , eventPlace = [] , page = [] , locator = NoneLoc , version = [] , volume = [] , numberOfVolumes = 0 , issue = [] , chapterNumber = [] , medium = [] , status = [] , edition = [] , section = [] , genre = [] , note = [] , annote = [] , abstract = [] , keyword = [] , number = [] , references = [] , url = [] , doi = [] , isbn = [] , citationNumber = CNum 0 , yearSuffix = [] , citationLabel = [] } -- | With the list of 'Reference's and the tuple (citation key, -- locator), return the needed reference with the correct locator set. getReference :: [Reference] -> (String,String) -> Reference getReference r = snd . getReference' r . flip (,) ("",0) -- | With the 'Reference' list and the generated position for each -- tuple of citation key and locator, produce a list of 'Reference's -- with their positions (which come first. getReference' :: [Reference] -> ((String,String),(String,Int)) -> (String, Reference) getReference' r ((c,l),(p,n)) = case c `elemIndex` map citeKey r of Just i -> (,) p $ (r !! i) { locator = parseLocator l , citationNumber = CNum n } Nothing -> (,) p $ emptyReference { title = c ++ " not found!" , citationNumber = CNum n } data Locator = NoneLoc | BookLoc String | ChapterLoc String | ColumnLoc String | FigureLoc String | FolioLoc String | IssueLoc String | LineLoc String | NoteLoc String | OpusLoc String | PageLoc String | PageFstLoc String | ParaLoc String | PartLoc String | SecLoc String | SubVerbLoc String | VolLoc String | VerseLoc String deriving ( Read, Eq, Typeable, Data ) instance Show Locator where show = map toLower . reverse . drop 3 . reverse . showConstr . toConstr locString :: Locator -> String locString l | BookLoc s <- l = s | ChapterLoc s <- l = s | ColumnLoc s <- l = s | FigureLoc s <- l = s | FolioLoc s <- l = s | IssueLoc s <- l = s | LineLoc s <- l = s | NoteLoc s <- l = s | OpusLoc s <- l = s | PageLoc s <- l = s | PageFstLoc s <- l = s | ParaLoc s <- l = s | PartLoc s <- l = s | SecLoc s <- l = s | SubVerbLoc s <- l = s | VolLoc s <- l = s | VerseLoc s <- l = s | otherwise = [] parseLocator :: String -> Locator parseLocator s | "b" `isPrefixOf` formatField s = mk BookLoc | "ch" `isPrefixOf` formatField s = mk ChapterLoc | "co" `isPrefixOf` formatField s = mk ColumnLoc | "fi" `isPrefixOf` formatField s = mk FigureLoc | "fo" `isPrefixOf` formatField s = mk FolioLoc | "i" `isPrefixOf` formatField s = mk IssueLoc | "l" `isPrefixOf` formatField s = mk LineLoc | "n" `isPrefixOf` formatField s = mk NoteLoc | "o" `isPrefixOf` formatField s = mk OpusLoc | "para" `isPrefixOf` formatField s = mk ParaLoc | "part" `isPrefixOf` formatField s = mk PartLoc | "p" `isPrefixOf` formatField s = mk PageLoc | "sec" `isPrefixOf` formatField s = mk SecLoc | "sub" `isPrefixOf` formatField s = mk SubVerbLoc | "ve" `isPrefixOf` formatField s = mk VerseLoc | "v" `isPrefixOf` formatField s = mk VolLoc -- | "p" `isPrefixOf` formatField s = mk PageFstLoc | otherwise = NoneLoc where mk c = if null s then NoneLoc else c . concat . tail . words $ s -- | For each citation group generate the position and the citation -- number of each citation. generatePosition :: [[(String,String)]] -> [[((String,String),(String,Int))]] generatePosition = getPos ([],[]) getPos :: (Eq a) => ([a], [a]) -> [[(a, String)]] -> [[((a, String), (String, Int))]] getPos _ [] = [] getPos (ac,cl) (x:xs) = doGroup : getPos (ac ++ (map fst x), cl ++ fstcits) xs where fstcits = map (fst . fst) . filter ((==) "first" . fst . snd) $ doGroup doGroup = doGet (ac,cl) x doGet _ [] = [] doGet (a,c) ((k,l):ys) | isIbid , isSet = ((k, l), ("ibid-with-locator", citNum)) : doGet (a ++ [k], c ) ys | isIbid = ((k, l), ("ibid" , citNum)) : doGet (a ++ [k], c ) ys | isElem = ((k, l), ("subsequent" , citNum)) : doGet (a ++ [k], c ) ys | otherwise = ((k, l), ("first" , newCit)) : doGet (a ++ [k], c ++ [k]) ys where newCit = 1 + length c citNum = (+) 1 . fromJust . elemIndex k $ c isSet = l /= "" isElem = k `elem` a isIbid = isElem && k == last a