{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Reference
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- 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