Style.hs

{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Style
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The Style types
--
-----------------------------------------------------------------------------

module Text.CSL.Style where

import Data.Generics

-- | The representation of a parsed CSL style.
data Style
    = Style
      { styleClass  ::  String
      , styleInfo   ::  Maybe CSInfo
      , styleLang   ::  String
      , styleLocale ::  String
      , csTerms     :: [TermMap]
      , csMacros    :: [MacroMap]
      , citation    ::  Citation
      , biblio      ::  Maybe Bibliography
      } deriving ( Show, Typeable, Data )

type TermMap
    = ((String,Form),(String,String))

type MacroMap
    = (String,[Element])

data Citation
    = Citation
      { citOptions :: [Option]
      , citSort    :: [Sort]
      , citLayout  ::  Layout
      } deriving ( Show, Typeable, Data )

data Bibliography
    = Bibliography
      { bibOptions :: [Option]
      , bibSort    :: [Sort]
      , bibLayout  ::  Layout
      } deriving ( Show, Typeable, Data )

type Option = (String,String)

data Layout
    = Layout
      { layFormat ::  Formatting
      , layDelim  ::  Delimiter
      , elements  :: [Element]
      } deriving ( Show, Typeable, Data )

data Element
    = Choose       IfThen   [IfThen]     [Element]
    | Macro        String     Form        Formatting
    | Const        String                 Formatting
    | PointLocator String     Form        Formatting
    | Variable    [String]    Form        Formatting Delimiter
    | Term         String     Form        Formatting Bool Bool
    | Label        String     Form        Formatting Bool Bool
    | Number       String     NumericForm Formatting
    | ShortNames  [String]                Formatting Delimiter
    | Names       [String]   [Name]       Formatting Delimiter [Element]
    | Substitute  [Element]
    | Group        Formatting Delimiter   String    [Element]
    | Date        [String]    Formatting  Delimiter [DatePart]
      deriving ( Show, Eq, Typeable, Data )

data IfThen
    = IfThen Condition Match [Element]
      deriving ( Eq, Show, Typeable, Data )

data Condition
    = Condition
      { isType         :: [String]
      , isSet          :: [String]
      , isNumeric      :: [String]
      , isDate         :: [String]
      , isPosition     :: [String]
      , disambiguation :: [String]
      , isLocator      :: [String]
      }
      deriving ( Eq, Show, Typeable, Data )

type Delimiter
    = String

data Match
    = Any
    | All
    | None
      deriving ( Show, Read, Eq, Typeable, Data )

match :: Match -> [Bool] -> Bool
match All  = and
match Any  = or
match None = and . map not

data DatePart
    = DatePart String String Formatting
      deriving ( Show, Eq, Typeable, Data )

defaultDate :: [DatePart]
defaultDate
    = [ DatePart "year"  "" emptyFormatting
      , DatePart "month" "" emptyFormatting
      , DatePart "day"   "" emptyFormatting]

data Sort
    = SortVariable String Sorting
    | SortMacro    String Sorting
      deriving ( Eq, Show, Typeable, Data )

data Sorting
    = Ascending  String
    | Descending String
      deriving ( Eq, Read, Typeable, Data )

instance Show Sorting where
    show (Ascending  s) = s
    show (Descending s) = s

instance Ord Sorting where
    compare (Ascending  a) (Ascending  b) = compare a b
    compare (Descending a) (Descending b) = compare b a
    compare             _              _  = EQ

data Form
    = Long
    | Verb
    | Short
    | VerbShort
    | Symbol
      deriving ( Eq, Show, Read, Typeable, Data )

data NumericForm
    = Numeric
    | Ordinal
    | Roman
      deriving ( Eq, Show, Read, Typeable, Data )

data Name
    = Name      Form Formatting NameFormatting Delimiter
    | NameLabel Form Formatting Bool Bool
      deriving ( Eq, Show, Typeable, Data )

isName :: Name -> Bool
isName x = case x of Name {} -> True; _ -> False

data NameFormatting
    = NameFormatting
      { andConnector          :: String
      , delimiterPrecedesLast :: String
      , nameAsSortOrder       :: String
      , sortSeparator         :: String
      , initializeWith        :: String
      } deriving ( Eq, Show, Typeable, Data )

defaultNameFormatting :: NameFormatting
defaultNameFormatting
    = NameFormatting
      { andConnector          = "text"
      , delimiterPrecedesLast = ""
      , nameAsSortOrder       = ""
      , sortSeparator         = ""
      , initializeWith        = ""
      }

data Formatting
    = Formatting
      { prefix         :: String
      , suffix         :: String
      , fontFamily     :: String
      , fontStyle      :: String
      , fontVariant    :: String
      , fontWeight     :: String
      , textDecoration :: String
      , verticalAlign  :: String
      , textCase       :: String
      , display        :: String
      , quotes         :: Bool
      } deriving ( Eq, Ord, Read, Show, Typeable, Data )

emptyFormatting :: Formatting
emptyFormatting
    = Formatting [] [] [] [] [] [] [] [] [] [] False

data CSInfo
    = CSInfo
      { csiTitle      :: String
      , csiAuthor     :: CSAuthor
      , csiCategories :: [CSCategory]
      , csiId         :: String
      , csiUpdated    :: String
      } deriving ( Show, Read, Typeable, Data )

data CSAuthor   = CSAuthor   String String String deriving ( Show, Read, Eq, Typeable, Data )
data CSCategory = CSCategory String String String deriving ( Show, Read, Eq, Typeable, Data )

-- | The formatted output, produced after post-processing the
-- evaluated citations.
data FormattedOutput
    = FO String Formatting [FormattedOutput]
    | Delimiter String
      deriving ( Eq, Show )

-- | The 'Output' generated by the evaluation of a style. Must be
-- further processed for disambiguation and collapsing.
data Output
    = OStr     String             Formatting -- ^ A simple 'String'
    | OName    String  [String]   Formatting -- ^ A (family) name with the list of given names.
    | OYear    String   String    Formatting -- ^ The year and a suffix if needed
    | OCitNum  Int                Formatting -- ^ The citation number
    | Output  [Output]            Formatting -- ^ Some nested 'Output'
    | OContrib String  [Output]   [[Output]] -- ^ The citation key with the contributor(s), and everything
                                             -- used for disambiguation.
    | ODel     String                        -- ^ A delimiter string.
      deriving ( Eq, Ord, Show, Typeable, Data )

-- | A citation group: a list of evaluated citations, the 'Formatting'
-- to be applied to them, and the 'Delimiter' between individual
-- citations.
data CitationGroup = CG Formatting String [Output] deriving ( Show, Eq, Typeable, Data )

data BiblioData
    = BD
      { citations    :: [[FormattedOutput]]
      , bibliography :: [[FormattedOutput]]
      } deriving ( Show )

-- | A record with all the data to produce the 'FormattedOutput' of a
-- citation: the citation key, the part of the citation that may be
-- colliding with other citations (the list of contributors for the
-- same year), the data to disambiguate it (all possible contributors
-- and all possible given names), and the disambiguated citation and
-- its year.
data CiteData
    = CD
      { key        ::   String
      , collision  ::  [Output]
      , disambData :: [[Output]]
      , disambed   ::  [Output]
      , citYear    ::   String
      } deriving ( Show, Typeable, Data )

instance Eq CiteData where
    (==) (CD ka ca _ _ _)
         (CD kb cb _ _ _) = ka == kb && ca == cb

-- | Convert evaluated 'Output' into 'FormattedOutput', ready for the
-- output filters.
formatOutput :: Output -> FormattedOutput
formatOutput o
    | ODel     s     <- o = Delimiter s
    | OStr     s   f <- o = FO s  f []
    | OName    s _ f <- o = FO s  f []
    | OYear    s _ f <- o = FO s  f []
    | Output   os  f <- o = FO "" f               (format os)
    | OContrib _ s _ <- o = FO "" emptyFormatting (format  s)
    | OCitNum  i   f <- o = FO (show i) f []
    | otherwise     = FO "" emptyFormatting []
    where
      format  = map formatOutput

-- | Map the evaluated output of a citation group.
mapGroupOutput :: (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput f (CG _ _ os) = concatMap f os

-- | A generic processing function.
proc :: (Typeable a, Data b) => (a -> a) -> b -> b
proc f = everywhere (mkT f)

-- | A generic query function.
query :: (Typeable a, Data b) => (a -> [c]) -> b -> [c]
query f = everything (++) ([] `mkQ` f)

-- | Removes all given names form a 'OName' element with 'proc'.
rmGivenNames :: Output -> Output
rmGivenNames o
    | OName s _ f <- o = OName s [] f
    | otherwise     = o

-- | Removes all contributors' names.
rmContribs :: Output -> Output
rmContribs o
    | OContrib s _ _ <- o = OContrib s [] []
    | otherwise           = o

-- | Add, with 'proc', a give name to the family name. Needed for
-- disambiguation.
addGivenNames :: [Output] -> [Output]
addGivenNames
    = reverse . addGN True . reverse
    where
      addGN _ [] = []
      addGN b (o:os)
          | OName _ xs f <- o
          , xs /= []  = if b then OName (head xs) (tail xs) f : addGN False os else o:os
          | otherwise = o : addGN b os

-- | Add the year suffix to the year. Needed for disambiguation.
addYearSuffix :: Output -> Output
addYearSuffix o
    | OYear y s f <- o = OYear (y ++ s) s f
    | otherwise        = o