module GF.GFCC.DataGFCC where

import GF.GFCC.CId
import GF.Infra.CompactPrint
import GF.Text.UTF8
import GF.Formalism.FCFG
import GF.Parsing.FCFG.PInfo

import Data.Map
import Data.List

-- internal datatypes for GFCC

data GFCC = GFCC {
  absname   :: CId ,
  cncnames  :: [CId] ,
  gflags    :: Map CId String,   -- value of a global flag
  abstract  :: Abstr ,
  concretes :: Map CId Concr
  }

data Abstr = Abstr {
  aflags  :: Map CId String,     -- value of a flag
  funs    :: Map CId (Type,Exp), -- type and def of a fun
  cats    :: Map CId [Hypo],     -- context of a cat
  catfuns :: Map CId [CId]       -- funs to a cat (redundant, for fast lookup)
  }

data Concr = Concr {
  cflags  :: Map CId String,    -- value of a flag
  lins    :: Map CId Term,      -- lin of a fun
  opers   :: Map CId Term,      -- oper generated by subex elim
  lincats :: Map CId Term,      -- lin type of a cat
  lindefs :: Map CId Term,      -- lin default of a cat
  printnames :: Map CId Term,   -- printname of a cat or a fun
  paramlincats :: Map CId Term, -- lin type of cat, with printable param names
  parser  :: Maybe FCFPInfo     -- parser
  }

data Type =
   DTyp [Hypo] CId [Exp]
  deriving (Eq,Ord,Show)

data Exp =
   DTr [CId] Atom [Exp]
 | EEq [Equation]
  deriving (Eq,Ord,Show)

data Atom =
   AC CId
 | AS String
 | AI Integer
 | AF Double
 | AM Integer
 | AV CId
  deriving (Eq,Ord,Show)

data Term =
   R [Term]
 | P Term Term
 | S [Term]
 | K Tokn
 | V Int
 | C Int
 | F CId
 | FV [Term]
 | W String Term
 | TM String
 | RP Term Term
  deriving (Eq,Ord,Show)

data Tokn =
   KS String
 | KP [String] [Variant]
  deriving (Eq,Ord,Show)

data Variant =
   Var [String] [String]
  deriving (Eq,Ord,Show)

data Hypo =
   Hyp CId Type
  deriving (Eq,Ord,Show)

data Equation =
   Equ [Exp] Exp
  deriving (Eq,Ord,Show)

-- print statistics

statGFCC :: GFCC -> String
statGFCC gfcc = unlines [
  "Abstract\t" ++ pr (absname gfcc), 
  "Concretes\t" ++ unwords (lmap pr (cncnames gfcc)), 
  "Categories\t" ++ unwords (lmap pr (keys (cats (abstract gfcc)))) 
  ]
 where pr (CId s) = s

printCId :: CId -> String
printCId (CId s) = s

-- merge two GFCCs; fails is differens absnames; priority to second arg

unionGFCC :: GFCC -> GFCC -> GFCC
unionGFCC one two = case absname one of
  CId "" -> two                  -- extending empty grammar
  n | n == absname two -> one {  -- extending grammar with same abstract
      concretes = Data.Map.union (concretes two) (concretes one),
      cncnames  = Data.List.union (cncnames two) (cncnames one)
    }
  _ -> one   -- abstracts don't match ---- print error msg

emptyGFCC :: GFCC
emptyGFCC = GFCC {
  absname   = CId "",
  cncnames  = [] ,
  gflags    = empty,
  abstract  = error "empty grammar, no abstract",
  concretes = empty
  }

-- default map and filter are for Map here
lmap = Prelude.map
lfilter = Prelude.filter
mmap = Data.Map.map

-- encode idenfifiers and strings in UTF8

utf8GFCC :: GFCC -> GFCC
utf8GFCC gfcc = gfcc {
  concretes = mmap u8concr (concretes gfcc)
  }
 where 
   u8concr cnc = cnc {
     lins = mmap u8term (lins cnc),
     opers = mmap u8term (opers cnc)
     }
   u8term = convertStringsInTerm encodeUTF8

---- TODO: convert identifiers and flags

convertStringsInTerm conv t = case t of
  K (KS s) -> K (KS (conv s))
  W s r    -> W (conv s) (convs r)
  R ts     -> R $ lmap convs ts
  S ts     -> S $ lmap convs ts
  FV ts    -> FV $ lmap convs ts
  P u v    -> P (convs u) (convs v)
  _        -> t
 where
  convs = convertStringsInTerm conv

