content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE CPP                        #-}
  {-# LANGUAGE DeriveDataTypeable         #-}
  {-# LANGUAGE DeriveGeneric              #-}
  {-# LANGUAGE ExistentialQuantification  #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE IncoherentInstances        #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE PatternGuards              #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  #if MIN_VERSION_base(4,8,0)
  #define OVERLAPS {-# OVERLAPPING #-}
  #else
  {-# LANGUAGE OverlappingInstances       #-}
  #define OVERLAPS
  #endif
  -----------------------------------------------------------------------------
  -- |
  -- 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 ( Literal(..)
                            , Value(..)
                            , ReferenceMap
                            , mkRefMap
                            , fromValue
                            , isValueSet
                            , Empty(..)
                            , Season(..)
                            , seasonToInt
                            , RefDate(..)
                            , handleLiteral
                            , toDatePart
                            , setCirca
                            , RefType(..)
                            , CNum(..)
                            , CLabel(..)
                            , Reference(..)
                            , emptyReference
                            , numericVars
                            , getReference
                            , processCites
                            , setPageFirst
                            , setNearNote
                            , parseEDTFDate
                            )
  where
  
  import Prelude
  import           Control.Applicative ((<|>))
  import           Control.Monad       (guard, mplus, msum)
  import           Data.Aeson          hiding (Value)
  import qualified Data.Aeson          as Aeson
  import           Data.Aeson.Types    (Parser)
  import           Data.Char           (isDigit, toLower, isPunctuation)
  import           Data.Either         (lefts, rights)
  import           Data.Generics       hiding (Generic)
  import qualified Data.HashMap.Strict as H
  import           Data.List           (find, elemIndex)
  import           Data.Maybe          (fromMaybe, isNothing)
  import           Data.String
  import           Data.Text           (Text)
  import qualified Data.Text           as T
  import qualified Data.Vector         as V
  import           Data.Yaml.Builder   (ToYaml (..))
  import qualified Data.Yaml.Builder   as Y
  import           GHC.Generics        (Generic)
  import           Text.CSL.Style      hiding (Number)
  import           Text.CSL.Util       (camelize, capitalize, inlinesToString,
                                        mapping', parseBool, parseInt, parseMaybeInt,
                                        parseString, readNum, safeRead, trim,
                                        uncamelize, AddYaml(..), splitStrWhen)
  import           Text.Pandoc         (Inline (Str))
  import qualified Text.Parsec         as P
  import qualified Text.Parsec.Text    as P
  
  newtype Literal = Literal { unLiteral :: Text }
    deriving ( Show, Read, Eq, Data, Typeable, Semigroup, Monoid, Generic )
  
  instance AddYaml Literal
    where x &= (Literal y) = x &= y
  
  instance FromJSON Literal where
    parseJSON v             = Literal `fmap` parseString v
  
  instance ToJSON Literal where
    toJSON = toJSON . unLiteral
  
  instance ToYaml Literal where
    toYaml = Y.string . unLiteral
  
  instance IsString Literal where
    fromString = Literal . T.pack
  
  -- | 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 = [(Text, Value)]
  
  mkRefMap :: Maybe Reference -> ReferenceMap
  mkRefMap Nothing  = []
  mkRefMap (Just r) = zip fields (gmapQ Value r)
        where fields = map (T.pack . uncamelize) . constrFields . toConstr $ r
  
  fromValue :: Data a => Value -> Maybe a
  fromValue (Value a) = cast a
  
  isValueSet :: Value -> Bool
  isValueSet val
      | Just v <- fromValue val :: Maybe Literal   = v /= mempty
      | Just v <- fromValue val :: Maybe String    = v /= mempty
      | Just v <- fromValue val :: Maybe Formatted = v /= mempty
      | 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 CLabel    = v /= mempty
      | Just _ <- fromValue val :: Maybe Empty     = True
      | otherwise = False
  
  data Empty = Empty deriving ( Typeable, Data, Generic )
  
  data Season = Spring | Summer | Autumn | Winter | RawSeason Text
       deriving (Show, Read, Eq, Typeable, Data, Generic)
  
  instance ToYaml Season where
    toYaml Spring = toYaml (1 :: Int)
    toYaml Summer = toYaml (2 :: Int)
    toYaml Autumn = toYaml (3 :: Int)
    toYaml Winter = toYaml (4 :: Int)
    toYaml (RawSeason s) = toYaml s
  
  seasonToInt :: Season -> Maybe Int
  seasonToInt Spring = Just 1
  seasonToInt Summer = Just 2
  seasonToInt Autumn = Just 3
  seasonToInt Winter = Just 4
  seasonToInt _      = Nothing
  
  intToSeason :: Int -> Maybe Season
  intToSeason 1 = Just Spring
  intToSeason 2 = Just Summer
  intToSeason 3 = Just Autumn
  intToSeason 4 = Just Winter
  intToSeason _  = Nothing
  
  pseudoMonthToSeason :: Int -> Maybe Season
  pseudoMonthToSeason n
    | n >= 13 && n <= 16 = intToSeason (n - 12)
    | n >= 21 && n <= 24 = intToSeason (n - 20)
    | otherwise          = Nothing
  
  -- | Parse JSON value as Maybe Season.
  parseMaybeSeason :: Maybe Aeson.Value -> Parser (Maybe Season)
  parseMaybeSeason Nothing = return Nothing
  parseMaybeSeason (Just x) = do
    mbn <- parseMaybeInt (Just x) <|> return Nothing
    case mbn of
         Just n -> case intToSeason n of
                        Just s  -> return $ Just s
                        Nothing -> fail $ "Could not read season: " ++ show n
         Nothing -> do
           s <- parseString x
           if T.null s
              then return Nothing
              else return $ Just $ RawSeason s
  
  data RefDate =
      RefDate { year   :: Maybe Int
              , month  :: Maybe Int
              , season :: Maybe Season
              , day    :: Maybe Int
              , other  :: Literal
              , circa  :: Bool
              } deriving ( Show, Read, Eq, Typeable, Data, Generic )
  
  instance AddYaml RefDate where
    _ &= (RefDate Nothing Nothing Nothing Nothing o _) | o == mempty = id
    x &= y = x &= y
  
  instance FromJSON RefDate where
    parseJSON (Array v) = handlePseudoMonths <$>
       case fromJSON (Array v) of
            Success [y]     -> RefDate <$> parseMaybeInt y <*>
                      pure Nothing <*> pure Nothing <*> pure Nothing <*>
                      pure "" <*> pure False
            Success [y,m]   -> RefDate <$> parseMaybeInt y <*> parseMaybeInt m <*>
                      pure Nothing <*> pure Nothing <*> pure "" <*> pure False
            Success [y,m,d] -> RefDate <$> parseMaybeInt y <*> parseMaybeInt m <*>
                      pure Nothing <*> parseMaybeInt d <*> pure "" <*> pure False
            Error e         -> fail $ "Could not parse RefDate: " ++ e
            _               -> fail "Could not parse RefDate"
       where handlePseudoMonths r =
                case month r >>= pseudoMonthToSeason of
                     Just s  -> r{ month = Nothing, season = Just s }
                     Nothing -> r
    parseJSON (Object v) = RefDate <$>
                (v .:? "year" >>= parseMaybeInt) <*>
                (v .:? "month" >>= parseMaybeInt) <*>
                (v .:? "season" >>= parseMaybeSeason) <*>
                (v .:? "day" >>= parseMaybeInt) <*>
                v .:? "literal" .!= "" <*>
                ((v .: "circa" >>= parseBool) <|> pure False)
    parseJSON _ = fail "Could not parse RefDate"
  
  {-
  instance ToJSON RefDate where
    toJSON refdate = object' $ [
        "year" .= year refdate
      , "month" .= month refdate
      , "season" .= season refdate
      , "day" .= day refdate
      , "literal" .= other refdate ] ++
      [ "circa" .= circa refdate | circa refdate ]
  -}
  
  instance ToYaml RefDate where
    toYaml r = mapping'
                 [ "year" &= year r
                 , "month" &= month r
                 , "season" &= season r
                 , "day" &= day r
                 , "literal" &= other r
                 , "circa" &= circa r
                 ]
  
  instance OVERLAPS
           FromJSON [RefDate] where
    parseJSON (Array xs) = mapM parseJSON $ V.toList xs
    parseJSON (Object v) = do
      raw' <- v .:? "raw"
      dateParts <- v .:? "date-parts"
      circa' <- (v .: "circa" >>= parseBool) <|> pure False
      season' <- v .:? "season" >>= parseMaybeSeason
      case dateParts of
           Just (Array y) | isNothing raw' ->
             case V.toList y of
                []           -> return []
                [Null]       -> return []
                [Array x]
                  | V.null x -> return []
                     -- [ null ] and [ [] ] are sometimes seen. See
                     -- https://github.com/greenelab/manubot/issues/66
                ys           -> mapM (fmap (setCirca circa' .
                                  maybe id setSeason season') . parseJSON) ys
           _ -> case raw' of
                    Nothing -> handleLiteral <$> parseJSON (Object v)
                    Just r  -> return $ parseRawDate r
    parseJSON x  = parseRawDate <$> parseJSON x
  
  instance OVERLAPS
           ToJSON [RefDate] where
    toJSON = toJSONDate
  
  toJSONDate :: [RefDate] -> Aeson.Value
  toJSONDate [] = Array V.empty
  toJSONDate ds = object' $
    [ "date-parts" .= dateparts | not (null dateparts) ] ++
    ["circa" .= (1 :: Int) | any circa ds] ++
    (case msum (map season ds) of
          Just (RawSeason s) -> ["season" .= s]
          _                  -> []) ++
    (case mconcat (map other ds) of
          Literal l | not (T.null l) -> ["literal" .= l]
          _                          -> [])
    where dateparts = filter (not . emptyDatePart) $ map toDatePart ds
          emptyDatePart [] = True
          emptyDatePart xs = all (== 0) xs
  
  toDatePart :: RefDate -> [Int]
  toDatePart refdate =
      case (year refdate, month refdate
             `mplus`
            ((12+) <$> (season refdate >>= seasonToInt)),
            day refdate) of
           (Just (y :: Int), Just (m :: Int), Just (d :: Int))
                                       -> [y, m, d]
           (Just y, Just m, Nothing)   -> [y, m]
           (Just y, Nothing, Nothing)  -> [y]
           _                           -> []
  
  
  -- Zotero doesn't properly support date ranges, so a common
  -- workaround is 2005_2007 or 2005_; support this as date range:
  handleLiteral :: RefDate -> [RefDate]
  handleLiteral d@(RefDate Nothing Nothing Nothing Nothing (Literal xs) b)
    = case T.splitOn "_" xs of
        [x,y] | T.all isDigit x && T.all isDigit y &&
                not (T.null x) ->
                  [RefDate (safeRead x) Nothing Nothing Nothing mempty b,
                   RefDate (safeRead y) Nothing Nothing Nothing mempty b]
        _ -> [d]
  handleLiteral d = [d]
  
  setCirca :: Bool -> RefDate -> RefDate
  setCirca circa' rd = rd{ circa = circa' }
  
  setSeason :: Season -> RefDate -> RefDate
  setSeason season' rd = rd{ season = Just season' }
  
  data RefType
      = NoType
      | Article
      | ArticleMagazine
      | ArticleNewspaper
      | ArticleJournal
      | Bill
      | Book
      | Broadcast
      | Chapter
      | Dataset
      | 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, Generic )
  
  instance Show RefType where
      show x = map toLower . uncamelize . showConstr . toConstr $ x
  
  instance FromJSON RefType where
    -- found in one of the test cases:
    parseJSON (String "film") = return MotionPicture
    parseJSON (String t) =
      safeRead (capitalize . T.pack . camelize $ t) <|>
      fail ("'" ++ T.unpack t ++ "' is not a valid reference type")
    parseJSON v@(Array _) =
      fmap (capitalize . T.pack . camelize . inlinesToString) (parseJSON v) >>= \t ->
        safeRead t <|>
         fail ("'" ++ T.unpack t ++ "' is not a valid reference type")
    parseJSON _ = fail "Could not parse RefType"
  
  instance ToJSON RefType where
    toJSON reftype = toJSON (handleSpecialCases $ show reftype)
  
  instance ToYaml RefType where
    toYaml r = Y.string (T.pack $ handleSpecialCases $ show r)
  
  -- For some reason, CSL is inconsistent about hyphens and underscores:
  handleSpecialCases :: String -> String
  handleSpecialCases "motion-picture"         = "motion_picture"
  handleSpecialCases "musical-score"          = "musical_score"
  handleSpecialCases "personal-communication" = "personal_communication"
  handleSpecialCases "legal-case"             = "legal_case"
  handleSpecialCases x                        = x
  
  newtype CNum = CNum { unCNum :: Int }
    deriving ( Show, Read, Eq, Ord, Num, Typeable, Data, Generic )
  
  instance FromJSON CNum where
    parseJSON x = CNum `fmap` parseInt x
  
  instance ToJSON CNum where
    toJSON (CNum n) = toJSON n
  
  instance ToYaml CNum where
    toYaml r = Y.string (T.pack $ show $ unCNum r)
  
  newtype CLabel = CLabel { unCLabel :: Text }
    deriving ( Show, Read, Eq, Typeable, Data, Generic, Semigroup, Monoid )
  
  instance FromJSON CLabel where
    parseJSON x = CLabel `fmap` parseString x
  
  instance ToJSON CLabel where
    toJSON (CLabel s) = toJSON s
  
  instance ToYaml CLabel where
    toYaml (CLabel s) = toYaml s
  
  -- | The 'Reference' record.
  data Reference =
      Reference
      { refId                    :: Literal
      , refOtherIds              :: [Literal]
      , refType                  :: RefType
  
      , author                   :: [Agent]
      , editor                   :: [Agent]
      , translator               :: [Agent]
      , recipient                :: [Agent]
      , interviewer              :: [Agent]
      , composer                 :: [Agent]
      , director                 :: [Agent]
      , illustrator              :: [Agent]
      , originalAuthor           :: [Agent]
      , containerAuthor          :: [Agent]
      , collectionEditor         :: [Agent]
      , editorialDirector        :: [Agent]
      , reviewedAuthor           :: [Agent]
  
      , issued                   :: [RefDate]
      , eventDate                :: [RefDate]
      , accessed                 :: [RefDate]
      , container                :: [RefDate]
      , originalDate             :: [RefDate]
      , submitted                :: [RefDate]
  
      , title                    :: Formatted
      , titleShort               :: Formatted
      , reviewedTitle            :: Formatted
      , containerTitle           :: Formatted
      , volumeTitle              :: Formatted
      , collectionTitle          :: Formatted
      , containerTitleShort      :: Formatted
      , collectionNumber         :: Formatted --Int
      , originalTitle            :: Formatted
      , publisher                :: Formatted
      , originalPublisher        :: Formatted
      , publisherPlace           :: Formatted
      , originalPublisherPlace   :: Formatted
      , authority                :: Formatted
      , jurisdiction             :: Formatted
      , archive                  :: Formatted
      , archivePlace             :: Formatted
      , archiveLocation          :: Formatted
      , event                    :: Formatted
      , eventPlace               :: Formatted
      , page                     :: Formatted
      , pageFirst                :: Formatted
      , numberOfPages            :: Formatted
      , version                  :: Formatted
      , volume                   :: Formatted
      , numberOfVolumes          :: Formatted --Int
      , issue                    :: Formatted
      , chapterNumber            :: Formatted
      , medium                   :: Formatted
      , status                   :: Formatted
      , edition                  :: Formatted
      , section                  :: Formatted
      , source                   :: Formatted
      , genre                    :: Formatted
      , note                     :: Formatted
      , annote                   :: Formatted
      , abstract                 :: Formatted
      , keyword                  :: Formatted
      , number                   :: Formatted
      , references               :: Formatted
      , url                      :: Literal
      , doi                      :: Literal
      , isbn                     :: Literal
      , issn                     :: Literal
      , pmcid                    :: Literal
      , pmid                     :: Literal
      , callNumber               :: Literal
      , dimensions               :: Literal
      , scale                    :: Literal
      , categories               :: [Literal]
      , language                 :: Literal
  
      , citationNumber           :: CNum
      , firstReferenceNoteNumber :: Int
      , citationLabel            :: CLabel
      } deriving ( Eq, Show, Read, Typeable, Data, Generic )
  
  instance FromJSON Reference where
    parseJSON (Object v') = do
       v <- parseSuppFields v' <|> return v'
       (Reference <$>
         v .:? "id" .!= "" <*>
         v .:? "other-ids" .!= [] <*>
         v .:? "type" .!= NoType <*>
         v .:? "author" .!= [] <*>
         v .:? "editor" .!= [] <*>
         v .:? "translator" .!= [] <*>
         v .:? "recipient" .!= [] <*>
         v .:? "interviewer" .!= [] <*>
         v .:? "composer" .!= [] <*>
         v .:? "director" .!= [] <*>
         v .:? "illustrator" .!= [] <*>
         v .:? "original-author" .!= [] <*>
         v .:? "container-author" .!= [] <*>
         v .:? "collection-editor" .!= [] <*>
         v .:? "editorial-director" .!= [] <*>
         v .:? "reviewed-author" .!= [] <*>
         v .:? "issued" .!= [] <*>
         v .:? "event-date" .!= [] <*>
         v .:? "accessed" .!= [] <*>
         v .:? "container" .!= [] <*>
         v .:? "original-date" .!= [] <*>
         v .:? "submitted" .!= [] <*>
         v .:? "title" .!= mempty <*>
         (v .: "shortTitle" <|> (v .:? "title-short" .!= mempty)) <*>
         v .:? "reviewed-title" .!= mempty <*>
         v .:? "container-title" .!= mempty <*>
         v .:? "volume-title" .!= mempty <*>
         v .:? "collection-title" .!= mempty <*>
         (v .: "journalAbbreviation" <|> v .:? "container-title-short" .!= mempty) <*>
         v .:? "collection-number" .!= mempty <*>
         v .:? "original-title" .!= mempty <*>
         v .:? "publisher" .!= mempty <*>
         v .:? "original-publisher" .!= mempty <*>
         v .:? "publisher-place" .!= mempty <*>
         v .:? "original-publisher-place" .!= mempty <*>
         v .:? "authority" .!= mempty <*>
         v .:? "jurisdiction" .!= mempty <*>
         v .:? "archive" .!= mempty <*>
         v .:? "archive-place" .!= mempty <*>
         v .:? "archive_location" .!= mempty <*>
         v .:? "event" .!= mempty <*>
         v .:? "event-place" .!= mempty <*>
         v .:? "page" .!= mempty <*>
         v .:? "page-first" .!= mempty <*>
         v .:? "number-of-pages" .!= mempty <*>
         v .:? "version" .!= mempty <*>
         v .:? "volume" .!= mempty <*>
         v .:? "number-of-volumes" .!= mempty <*>
         v .:? "issue" .!= mempty <*>
         v .:? "chapter-number" .!= mempty <*>
         v .:? "medium" .!= mempty <*>
         v .:? "status" .!= mempty <*>
         v .:? "edition" .!= mempty <*>
         v .:? "section" .!= mempty <*>
         v .:? "source" .!= mempty <*>
         v .:? "genre" .!= mempty <*>
         v .:? "note" .!= mempty <*>
         v .:? "annote" .!= mempty <*>
         v .:? "abstract" .!= mempty <*>
         v .:? "keyword" .!= mempty <*>
         v .:? "number" .!= mempty <*>
         v .:? "references" .!= mempty <*>
         v .:? "URL" .!= "" <*>
         v .:? "DOI" .!= "" <*>
         v .:? "ISBN" .!= "" <*>
         v .:? "ISSN" .!= "" <*>
         v .:? "PMCID" .!= "" <*>
         v .:? "PMID" .!= "" <*>
         v .:? "call-number" .!= "" <*>
         v .:? "dimensions" .!= "" <*>
         v .:? "scale" .!= "" <*>
         v .:? "categories" .!= [] <*>
         v .:? "language" .!= "" <*>
         v .:? "citation-number" .!= CNum 0 <*>
         ((v .: "first-reference-note-number" >>= parseInt) <|> return 0) <*>
         v .:? "citation-label" .!= mempty)
    parseJSON _ = fail "Could not parse Reference"
  
  -- Syntax for adding supplementary fields in note variable
  -- {:authority:Superior Court of California}{:section:A}{:original-date:1777}
  -- or
  -- Foo\nissued: 2016-03-20/2016-07-31\nbar
  -- see http://gsl-nagoya-u.net/http/pub/citeproc-doc.html#supplementary-fields
  parseSuppFields :: Aeson.Object -> Parser Aeson.Object
  parseSuppFields o = do
    nt <- o .: "note"
    case P.parse noteFields "note" nt of
         Left err -> fail (show err)
         Right fs -> return $ foldr (\(k,v) x -> H.insert k v x) o fs
  
  noteFields :: P.Parser [(Text, Aeson.Value)]
  noteFields = do
    fs <- P.many (Right <$> (noteField <|> lineNoteField) <|> Left <$> regText)
    P.spaces
    let rest = T.unwords (lefts fs)
    return (("note", Aeson.String rest) : rights fs)
  
  noteField :: P.Parser (Text, Aeson.Value)
  noteField = P.try $ do
    _ <- P.char '{'
    _ <- P.char ':'
    k <- P.manyTill (P.letter <|> P.char '-') (P.char ':')
    _ <- P.skipMany (P.char ' ')
    v <- P.manyTill P.anyChar (P.char '}')
    return (T.pack k, Aeson.String (T.pack v))
  
  lineNoteField :: P.Parser (Text, Aeson.Value)
  lineNoteField = P.try $ do
    _ <- P.char '\n'
    k <- P.manyTill (P.letter <|> P.char '-') (P.char ':')
    _ <- P.skipMany (P.char ' ')
    v <- P.manyTill P.anyChar (P.char '\n' <|> '\n' <$ P.eof)
    return (T.pack k, Aeson.String (T.pack v))
  
  regText :: P.Parser Text
  regText = (T.pack <$> P.many1 (P.noneOf "\n{")) <|> (T.singleton <$> P.anyChar)
  
  instance ToJSON Reference where
    toJSON ref = object' [
        "id" .= refId ref
      , "other-ids" .= refOtherIds ref
      , "type" .= refType ref
      , "author" .= author ref
      , "editor" .= editor ref
      , "translator" .= translator ref
      , "recipient" .= recipient ref
      , "interviewer" .= interviewer ref
      , "composer" .= composer ref
      , "director" .= director ref
      , "illustrator" .= illustrator ref
      , "original-author" .= originalAuthor ref
      , "container-author" .= containerAuthor ref
      , "collection-editor" .= collectionEditor ref
      , "editorial-director" .= editorialDirector ref
      , "reviewed-author" .= reviewedAuthor ref
      , "issued" .= issued ref
      , "event-date" .= eventDate ref
      , "accessed" .= accessed ref
      , "container" .= container ref
      , "original-date" .= originalDate ref
      , "submitted" .= submitted ref
      , "title" .= title ref
      , "title-short" .= titleShort ref
      , "reviewed-title" .= reviewedTitle ref
      , "container-title" .= containerTitle ref
      , "volume-title" .= volumeTitle ref
      , "collection-title" .= collectionTitle ref
      , "container-title-short" .= containerTitleShort ref
      , "collection-number" .= collectionNumber ref
      , "original-title" .= originalTitle ref
      , "publisher" .= publisher ref
      , "original-publisher" .= originalPublisher ref
      , "publisher-place" .= publisherPlace ref
      , "original-publisher-place" .= originalPublisherPlace ref
      , "authority" .= authority ref
      , "jurisdiction" .= jurisdiction ref
      , "archive" .= archive ref
      , "archive-place" .= archivePlace ref
      , "archive_location" .= archiveLocation ref
      , "event" .= event ref
      , "event-place" .= eventPlace ref
      , "page" .= page ref
      , "page-first" .= (if page ref == mempty then pageFirst ref else mempty)
      , "number-of-pages" .= numberOfPages ref
      , "version" .= version ref
      , "volume" .= volume ref
      , "number-of-volumes" .= numberOfVolumes ref
      , "issue" .= issue ref
      , "chapter-number" .= chapterNumber ref
      , "medium" .= medium ref
      , "status" .= status ref
      , "edition" .= edition ref
      , "section" .= section ref
      , "source" .= source ref
      , "genre" .= genre ref
      , "note" .= note ref
      , "annote" .= annote ref
      , "abstract" .= abstract ref
      , "keyword" .= keyword ref
      , "number" .= number ref
      , "references" .= references ref
      , "URL" .= url ref
      , "DOI" .= doi ref
      , "ISBN" .= isbn ref
      , "ISSN" .= issn ref
      , "PMCID" .= pmcid ref
      , "PMID" .= pmid ref
      , "call-number" .= callNumber ref
      , "dimensions" .= dimensions ref
      , "scale" .= scale ref
      , "categories" .= categories ref
      , "language" .= language ref
      , "citation-number" .= citationNumber ref
      , "first-reference-note-number" .= firstReferenceNoteNumber ref
      , "citation-label" .= citationLabel ref
      ]
  
  instance ToYaml Reference where
    toYaml ref = mapping' [
        "id" &= refId ref
      , "other-ids" &= refOtherIds ref
      , (("type" Y..= refType ref) :)
      , "author" &= author ref
      , "editor" &= editor ref
      , "translator" &= translator ref
      , "recipient" &= recipient ref
      , "interviewer" &= interviewer ref
      , "composer" &= composer ref
      , "director" &= director ref
      , "illustrator" &= illustrator ref
      , "original-author" &= originalAuthor ref
      , "container-author" &= containerAuthor ref
      , "collection-editor" &= collectionEditor ref
      , "editorial-director" &= editorialDirector ref
      , "reviewed-author" &= reviewedAuthor ref
      , "issued" &= issued ref
      , "event-date" &= eventDate ref
      , "accessed" &= accessed ref
      , "container" &= container ref
      , "original-date" &= originalDate ref
      , "submitted" &= submitted ref
      , "title" &= title ref
      , "title-short" &= titleShort ref
      , "reviewed-title" &= reviewedTitle ref
      , "container-title" &= containerTitle ref
      , "volume-title" &= volumeTitle ref
      , "collection-title" &= collectionTitle ref
      , "container-title-short" &= containerTitleShort ref
      , "collection-number" &= collectionNumber ref
      , "original-title" &= originalTitle ref
      , "publisher" &= publisher ref
      , "original-publisher" &= originalPublisher ref
      , "publisher-place" &= publisherPlace ref
      , "original-publisher-place" &= originalPublisherPlace ref
      , "authority" &= authority ref
      , "jurisdiction" &= jurisdiction ref
      , "archive" &= archive ref
      , "archive-place" &= archivePlace ref
      , "archive_location" &= archiveLocation ref
      , "event" &= event ref
      , "event-place" &= eventPlace ref
      , "page" &= page ref
      , "page-first" &= (if page ref == mempty then pageFirst ref else mempty)
      , "number-of-pages" &= numberOfPages ref
      , "version" &= version ref
      , "volume" &= volume ref
      , "number-of-volumes" &= numberOfVolumes ref
      , "issue" &= issue ref
      , "chapter-number" &= chapterNumber ref
      , "medium" &= medium ref
      , "status" &= status ref
      , "edition" &= edition ref
      , "section" &= section ref
      , "source" &= source ref
      , "genre" &= genre ref
      , "note" &= note ref
      , "annote" &= annote ref
      , "abstract" &= abstract ref
      , "keyword" &= keyword ref
      , "number" &= number ref
      , "references" &= references ref
      , "URL" &= url ref
      , "DOI" &= doi ref
      , "ISBN" &= isbn ref
      , "ISSN" &= issn ref
      , "PMCID" &= pmcid ref
      , "PMID" &= pmid ref
      , "call-number" &= callNumber ref
      , "dimensions" &= dimensions ref
      , "scale" &= scale ref
      , "categories" &= categories ref
      , "language" &= language ref
      , if citationNumber ref == CNum 0
           then id
           else (("citation-number" Y..= citationNumber ref) :)
      , if firstReferenceNoteNumber ref == 0
           then id
           else (("first-reference-note-number" Y..=
                  firstReferenceNoteNumber ref) :)
      , if citationLabel ref == mempty
           then id
           else (("citation-label" Y..= citationLabel ref) :)
      ]
  
  emptyReference :: Reference
  emptyReference =
      Reference
      { refId               = mempty
      , refOtherIds         = mempty
      , refType             = NoType
  
      , author              = []
      , editor              = []
      , translator          = []
      , recipient           = []
      , interviewer         = []
      , composer            = []
      , director            = []
      , illustrator         = []
      , originalAuthor      = []
      , containerAuthor     = []
      , collectionEditor    = []
      , editorialDirector   = []
      , reviewedAuthor      = []
  
      , issued              = []
      , eventDate           = []
      , accessed            = []
      , container           = []
      , originalDate        = []
      , submitted           = []
  
      , title               = mempty
      , titleShort          = mempty
      , reviewedTitle       = mempty
      , containerTitle      = mempty
      , volumeTitle         = mempty
      , collectionTitle     = mempty
      , containerTitleShort = mempty
      , collectionNumber    = mempty
      , originalTitle       = mempty
      , publisher           = mempty
      , originalPublisher   = mempty
      , publisherPlace      = mempty
      , originalPublisherPlace = mempty
      , authority           = mempty
      , jurisdiction        = mempty
      , archive             = mempty
      , archivePlace        = mempty
      , archiveLocation     = mempty
      , event               = mempty
      , eventPlace          = mempty
      , page                = mempty
      , pageFirst           = mempty
      , numberOfPages       = mempty
      , version             = mempty
      , volume              = mempty
      , numberOfVolumes     = mempty
      , issue               = mempty
      , chapterNumber       = mempty
      , medium              = mempty
      , status              = mempty
      , edition             = mempty
      , section             = mempty
      , source              = mempty
      , genre               = mempty
      , note                = mempty
      , annote              = mempty
      , abstract            = mempty
      , keyword             = mempty
      , number              = mempty
      , references          = mempty
      , url                 = mempty
      , doi                 = mempty
      , isbn                = mempty
      , issn                = mempty
      , pmcid               = mempty
      , pmid                = mempty
      , callNumber          = mempty
      , dimensions          = mempty
      , scale               = mempty
      , categories          = mempty
      , language            = mempty
  
      , citationNumber           = CNum 0
      , firstReferenceNoteNumber = 0
      , citationLabel            = mempty
      }
  
  numericVars :: [Text]
  numericVars = [ "edition", "volume", "number-of-volumes", "number", "issue", "citation-number"
                , "chapter-number", "collection-number", "number-of-pages"]
  
  getReference :: [Reference] -> Cite -> Maybe Reference
  getReference  rs c
      = case (hasId (citeId c)) `find` rs of
          Just r  -> Just $ setPageFirst r
          Nothing -> Nothing
    where hasId :: Text -> Reference -> Bool
          hasId ident r = ident `elem` (map unLiteral (refId r : refOtherIds r))
  
  processCites :: [Reference] -> [[Cite]] -> [[(Cite, Maybe Reference)]]
  processCites rs cs
      = procGr [] cs
      where
        procRef r = case filter ((==) (unLiteral $ refId r) . citeId) $ concat cs of
                      x:_ -> r { firstReferenceNoteNumber = readNum $ citeNoteNumber x}
                      []  -> r
  
        procGr _ [] = []
        procGr acc (x:xs) = let (a',res) = procCs acc x
                            in res : procGr ([] : a') xs
  
        -- process, given the accumulated history, the current group's cites
        procCs acc [] = (acc,[])
        procCs acc (c:xs) = let (a, rest) = procCs addCite xs
                                ref       = procRef <$> getReference rs c
                                c'        = c { citePosition = getCitePosition }
                            in  (a, (c', ref) : rest)
            where
              addCite = case acc of
                          []     -> [[c]]
                          (a:as) -> (c : a) : as
  
              -- http://docs.citationstyles.org/en/stable/specification.html#locators
              getCitePosition = fromMaybe notIbid (ibidPosition <$> prevSameCite)
                  where
                      notIbid = if citeId c `elem` map citeId (concat acc)
                                   then "subsequent"
                                   else "first"
  
              ibidPosition x = let hasL k   = citeLocator k /= ""
                                   withIf b = if b then "ibid-with-locator" else "ibid"
                                   diffLoc  = citeLocator x /= citeLocator c
                                             || citeLabel x /= citeLabel c
                               in  case (hasL x, hasL c) of
                                     (False, cur)  -> withIf cur
                                     (True, True)  -> withIf diffLoc
                                     (True, False) -> "subsequent"
  
              -- x is previous cite in current group
              -- zs is the previous group
              prevSameCite = case acc of
                               []     -> Nothing
                               (a:as) -> psc a as
                where
                  -- you can't have an ibid at the start of your document
                  psc [] []     = Nothing
  
                  -- a. the current cite immediately follows on another cite,
                  --    within the same citation, that references the same item
                  psc (x:_) _   = if citeId c == citeId x
                                     then Just x
                                     else Nothing
  
                  -- b.  [] => the current cite is the first cite in the citation
                  --     zs => and the previous citation consists of a single cite
                  --           that refs the same item
                  -- The spec appears to be concerned that you cannot know the
                  -- correct one to match the locator against.
                  -- It is a super clunky if you have [@a, 1; @a, 2] then [@a, 3],
                  -- where the second citation gets "subsequent" even though there were
                  -- only @a keys.
                  -- This is silly. We will use the last one to match against.
                  psc [] (zs:_) = case zs of
                                    [] -> Nothing
                                    (z:_) -> if all (== citeId c) (map citeId zs)
                                                then Just z
                                                else Nothing
  
  setPageFirst :: Reference -> Reference
  setPageFirst ref =
    let Formatted ils = page ref
        ils' = takeWhile (\i -> i /= Str "–" && i /= Str "-") $
                splitStrWhen isPunctuation ils
    in  if ils == ils'
           then ref
           else ref{ pageFirst = Formatted ils' }
  
  setNearNote :: Style -> [[Cite]] -> [[Cite]]
  setNearNote s cs
      = procGr [] cs
      where
        near_note   = let nn = lookup "near-note-distance" . citOptions . citation $ s
                      in maybe 5 readNum nn
        procGr _ [] = []
        procGr a (x:xs) = let (a',res) = procCs a x
                          in res : procGr a' xs
  
        procCs a []     = (a,[])
        procCs a (c:xs) = (a', c { nearNote = isNear} : rest)
            where
              (a', rest) = procCs (c:a) xs
              isNear     = case filter ((==) (citeId c) . citeId) a of
                             x:_ -> citeNoteNumber c /= "0" &&
                                    citeNoteNumber x /= "0" &&
                                    readNum (citeNoteNumber c) - readNum (citeNoteNumber x) <= near_note
                             _   -> False
  
  parseRawDate :: Text -> [RefDate]
  parseRawDate o =
    case P.parse rawDate "raw date" o of
         Left _   -> [RefDate Nothing Nothing Nothing Nothing (Literal o) False]
         Right ds -> ds
  
  rawDate :: P.Parser [RefDate]
  rawDate = rawDateISO <|> rawDateOld
  
  parseEDTFDate :: Text -> [RefDate]
  parseEDTFDate o =
    case handleRanges (trim o) of
         "" -> []
         o' -> case P.parse rawDateISO "date" o' of
                  Left _   -> []
                  Right ds -> ds
      where handleRanges s =
              case T.splitOn "/" s of
                   -- 199u EDTF format for a range
                   [x] | T.any (== 'u') x ->
                        T.map (\c -> if c == 'u' then '0' else c) x
                        <> "/" <>
                        T.map (\c -> if c == 'u' then '9' else c) x
                   [x, "open"] -> x <> "/"    -- EDTF
                   [x, "unknown"] -> x <> "/" -- EDTF
                   _  -> s
  
  rawDateISO :: P.Parser [RefDate]
  rawDateISO = do
    d1 <- isoDate
    P.option [d1] (P.char '/' >>
                    (\x -> [d1, x]) <$>
                     (  isoDate <|> return emptydate )) <* P.eof
     where emptydate = RefDate Nothing Nothing Nothing Nothing mempty False
  
  isoDate :: P.Parser RefDate
  isoDate = P.try $ do
    extyear <- P.option False (True <$ P.char 'y')  -- EDTF year > 4 digits
    -- needed for bibtex
    y <- do
      sign <- P.option "" (P.string "-")
      rest <- P.count 4 P.digit
      extended <- if extyear
                     then P.many P.digit
                     else return []
      return $ case safeRead (T.pack $ sign ++ rest ++ extended) of
                      Just x | x <= 0 -> Just (x - 1)  -- 0 = -1 AD
                      x               -> x
    m' <- P.option Nothing $ Just <$> P.try (P.char '-' >> P.many1 P.digit)
    (m,s) <- case m' >>= safeRead . T.pack of
                     Just (n::Int)
                            | n >= 1 && n <= 12  -> return (Just n, Nothing)
                            | n >= 13 && n <= 16 -> return (Nothing, pseudoMonthToSeason n)
                            | n >= 21 && n <= 24 -> return (Nothing, pseudoMonthToSeason n)
                     Nothing | isNothing m' -> return (Nothing, Nothing)
                     _ -> fail "Improper month"
    d <- P.option Nothing $ safeRead . T.pack <$> P.try (P.char '-' >> P.many1 P.digit)
    guard $ case d of
             Nothing -> True
             Just (n::Int) | n >= 1 && n <= 31 -> True
             _ -> False
    P.optional $ do
      _ <- P.char 'T'
      _ <- P.many (P.digit <|> P.char ':')
      P.optional $ (P.oneOf "+-" >> P.many1 (P.digit <|> P.char ':'))
                <|> P.string "Z"
    _ <- P.optional (P.char '?')
    c <- P.option False (True <$ P.char '~')
    return RefDate{ year = y, month = m,
                    season = s, day = d,
                    other = mempty, circa = c }
  
  rawDateOld :: P.Parser [RefDate]
  rawDateOld = do
    let months   = ["jan","feb","mar","apr","may","jun","jul","aug",
                    "sep","oct","nov","dec"]
    let seasons  = ["spr","sum","fal","win"]
    let pmonth = P.try $ do
          xs <- P.many1 P.letter <|> P.many1 P.digit
          if all isDigit xs
             then case safeRead (T.pack xs) of
                        Just (n::Int) | n >= 1 && n <= 12 -> return (Just n)
                        _ -> fail "Improper month"
             else case elemIndex (map toLower $ take 3 xs) months of
                       Nothing -> fail "Improper month"
                       Just n  -> return (Just (n+1))
    let pseason = P.try $ do
          xs <- P.many1 P.letter
          case elemIndex (map toLower $ take 3 xs) seasons of
               Just 0  -> return (Just Spring)
               Just 1  -> return (Just Summer)
               Just 2  -> return (Just Autumn)
               Just 3  -> return (Just Winter)
               _       -> fail "Improper season"
    let pday = P.try $ do
          xs <- P.many1 P.digit
          case safeRead (T.pack xs) of
               Just (n::Int) | n >= 1 && n <= 31 -> return (Just n)
               _ -> fail "Improper day"
    let pyear = safeRead . T.pack <$> P.many1 P.digit
    let sep = P.oneOf [' ','/',','] >> P.spaces
    let rangesep = P.try $ P.spaces >> P.char '-' >> P.spaces
    let refDate = RefDate Nothing Nothing Nothing Nothing mempty False
    let date = P.choice $ map P.try
                  [ do s <- pseason
                       sep
                       y <- pyear
                       return refDate{ year = y, season = s }
                  , do m <- pmonth
                       sep
                       d <- pday
                       sep
                       y <- pyear
                       return refDate{ year = y, month = m, day = d }
                  , do m <- pmonth
                       sep
                       y <- pyear
                       return refDate{ year = y, month = m }
                  , do y <- pyear
                       return refDate{ year = y }
                  ]
    d1 <- date
    P.option [d1] ((\x -> [d1,x]) <$> (rangesep >> date))
  
  