----------------------------------------------------------------------
-- Module      : PGFtoPython
-- Maintainer  : Peter Ljunglöf
--
-- exports a GF grammar into a Python module
-----------------------------------------------------------------------------

module GF.Compile.PGFtoPython (pgf2python) where

import PGF.CId
import PGF.Data
import qualified PGF.Macros as M

import qualified Data.Array.IArray as Array
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.List (intersperse)

pgf2python :: PGF -> String
pgf2python pgf = "# -*- coding: UTF-8 -*-\n" ++ 
                 "# This file was automatically generated by GF\n\n" ++ 
                 showCId name ++ " = " ++ grammar ++ "\n"
    where
      name  = absname pgf
      start = M.lookStartCat pgf
      abs = abstract pgf
      cncs = concretes pgf
      grammar = pyDict 1 [(qs "abstract", pyDict 2 [(qs "name", qcid name), 
                                                    (qs "start", qcid start), 
                                                    (qs "flags", pyDict 0 [(qcid k, lit2py v) | 
                                                                           (k, v) <- Map.toList (aflags abs)]),
                                                    (qs "funs", pyDict 3 [(qcid f, absdef2py def) | 
                                                                          (f, def) <- Map.assocs  (funs abs)])]),
                          (qs "concretes", pyDict 2 [(qcid cname, concrete2py cnc) | 
                                                     (cname, cnc) <- Map.assocs cncs])]

absdef2py :: (Type, Int, Maybe [Equation], Double) -> String
absdef2py (typ, _, _, _) = pyTuple 0 [qcid cat, pyList 0 (map qcid args)]
    where (args, cat) = M.catSkeleton typ 

lit2py :: Literal -> String
lit2py (LStr s) = qs s
lit2py (LInt n) = show n
lit2py (LFlt d) = show d

concrete2py :: Concr -> String
concrete2py cnc = pyDict 3 [(qs "flags", pyDict 0 [(qcid k, lit2py v) | (k, v) <- Map.toList (cflags cnc)]),
                            (qs "prods", pyDict 4 [(show cat, pyList 0 (map frule2py (Set.toList set))) | 
                                                   (cat, set) <- IntMap.toList (productions cnc)]),
                            (qs "cfuns", pyList 4 [ffun2py f | f <- Array.elems (cncfuns cnc)]),
                            (qs "seqs",  pyList 4 [seq2py s | s <- Array.elems (sequences cnc)]),
                            (qs "ccats", pyDict 4 [(qcid cat, pyTuple 0 [show start, show end]) |
                                                   (cat, CncCat start end _) <- Map.assocs (cnccats cnc)]),
                            (qs "size",  show (totalCats cnc))]

frule2py :: Production -> String
frule2py (PApply funid args) = pyTuple 0 [show funid, pyList 0 (map parg2py args)]
frule2py (PCoerce arg)       = show arg

parg2py :: PArg -> String
parg2py (PArg [] fid) = show fid
parg2py (PArg hypos fid) = pyTuple 0 (show fid : map (show . snd) hypos)

ffun2py :: CncFun -> String
ffun2py (CncFun f lins) = pyTuple 0 [pyList 0 (map show (Array.elems lins)), qcid f]

seq2py :: Array.Array DotPos Symbol -> String
seq2py seq = pyList 0 [sym2py s | s <- Array.elems seq]

sym2py :: Symbol -> String
sym2py (SymCat n l)    = pyTuple 0 [show n, show l]
sym2py (SymLit n l)    = pyDict 0 [(qs "lit", pyTuple 0 [show n, show l])]
sym2py (SymVar n l)    = pyDict 0 [(qs "var", pyTuple 0 [show n, show l])]
sym2py (SymKS ts)      = join "," (map qs ts)
sym2py (SymKP ts alts) = pyDict 0 [(qs "pre", pyList 0 (map show ts)), 
                                   (qs "alts", pyList 0 (map alt2py alts))]
    where alt2py (Alt ps ts) = pyTuple 0 [pyList 0 (map show ps), pyList 0 (map show ts)]

----------------------------------------------------------------------
-- python helpers 

pyDict :: Int -> [(String, String)] -> String
pyDict n xys = "{" ++ indent n ++ join ("," ++ indent n) [x ++ ":" ++ y | (x, y) <- xys] ++ indent n ++ "}"

pyList :: Int -> [String] -> String
pyList n xs = "[" ++ indent n ++ join ("," ++ indent n) xs ++ indent n ++ "]"

pyTuple :: Int -> [String] -> String
pyTuple n [x] = "(" ++ indent n ++ x ++ "," ++ indent n ++ ")"
pyTuple n xs = "(" ++ indent n ++ join ("," ++ indent n) xs ++ indent n ++ ")"

qs :: String -> String
qs s = "u\"" ++ qs' s
    where qs' ('"':s)  = "\\\"" ++ qs' s
          qs' ('\\':s) = "\\\\" ++ qs' s
          qs' (c:s)    = c : qs' s
          qs' []       = "\""

qcid :: CId -> String
qcid = qs . showCId

indent :: Int -> String
indent n | n > 0 = "\n" ++ replicate n ' '
         | otherwise = ""

join :: String -> [String] -> String
join a bs = concat (intersperse a bs)