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

module Text.CSL.Style where

import Data.Generics

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 )

data FormattedOutput
    = FO String Formatting [FormattedOutput]
    | Delimiter String
      deriving ( Eq, Show )

data Output
    = FS String             Formatting
    | FN String  [String]   Formatting -- ^ A name and its given name if needed
    | FY String   String    Formatting -- ^ The year and a suffix if needed
    | O [Output]            Formatting
    | FC String  [Output]   [[Output]] -- ^ The contributor(s) with additional names
    | S  String
      deriving ( Eq, Ord, Show, Typeable, Data )

data CitationGroup = CG Formatting String [Output] deriving ( Show, Eq, Typeable, Data )

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

data CiteData
    = CD
      { key       ::   String
      , collision ::  [Output]
      , disData   :: [[Output]]
      , disambed  ::  [Output]
      , citYear   ::   String
      } deriving ( Show, Typeable, Data )

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

formatOutput :: Output -> FormattedOutput
formatOutput o
    | S  s     <- o = Delimiter s
    | FS s   f <- o = FO s  f []
    | FN s _ f <- o = FO s  f []
    | FY s _ f <- o = FO s  f []
    | O   os f <- o = FO "" f               (format os)
    | FC _ s _ <- o = FO "" emptyFormatting (format  s)
    | otherwise     = FO "" emptyFormatting []
    where
      format  = map formatOutput

proc :: (Typeable a, Data b) => (a -> a) -> b -> b
proc f = everywhere (mkT f)

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

rmGivenNames :: Output -> Output
rmGivenNames o
    | FN s _ f <- o = FN s [] f
    | otherwise     = o

addGivenNames :: [Output] -> [Output]
addGivenNames
    = reverse . addGN True . reverse
    where
      addGN _ [] = []
      addGN b (o:os)
          | FN _ xs f <- o
          , xs /= []  = if b then FN (head xs) (tail xs) f : addGN False os else o:os
          | otherwise = o : addGN b os

addYearSuffix :: Output -> Output
addYearSuffix o
    | FY y s f <- o = FY (y ++ s) s f
    | otherwise     = o