Merge with master and drop the Haskell runtime completely

src/compiler/GF/Compiler.hs

@@ -1,11 +1,12 @@
 module GF.Compiler (mainGFC, linkGrammars, writeGrammar, writeOutputs) where
 
-import PGF
-import PGF.Internal(unionPGF,writePGF,writeConcr)
+import PGF2
+import PGF2.Internal(unionPGF,writePGF,writeConcr)
 import GF.Compile as S(batchCompile,link,srcAbsName)
 import GF.CompileInParallel as P(parallelBatchCompile)
 import GF.Compile.Export
 import GF.Compile.ConcreteToHaskell(concretes2haskell)
+import GF.Compile.GrammarToCanonical--(concretes2canonical)
 import GF.Compile.CFGtoPGF
 import GF.Compile.GetGrammar
 import GF.Grammar.BNFC
@@ -16,12 +17,13 @@ import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.Data.ErrM
 import GF.System.Directory
-import GF.Text.Pretty(render)
+import GF.Text.Pretty(render,render80)
 
 import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.ByteString.Lazy as BSL
+import GF.Grammar.CanonicalJSON (encodeJSON)
 import System.FilePath
 import Control.Monad(when,unless,forM_)
 
@@ -46,7 +48,7 @@ mainGFC opts fs = do
 compileSourceFiles :: Options -> [FilePath] -> IOE ()
 compileSourceFiles opts fs = 
     do output <- batchCompile opts fs
-       cncs2haskell output
+       exportCanonical output
        unless (flag optStopAfterPhase opts == Compile) $
            linkGrammars opts output
   where
@@ -54,15 +56,35 @@ compileSourceFiles opts fs =
     batchCompile' opts fs = do (t,cnc_gr) <- S.batchCompile opts fs
                                return (t,[cnc_gr])
 
-    cncs2haskell output =
-      when (FmtHaskell `elem` flag optOutputFormats opts &&
-            haskellOption opts HaskellConcrete) $
-        mapM_ cnc2haskell (snd output)
+    exportCanonical (_time, canonical) =
+      do when (FmtHaskell `elem` ofmts && haskellOption opts HaskellConcrete) $
+           mapM_ cnc2haskell canonical
+         when (FmtCanonicalGF `elem` ofmts) $
+           do createDirectoryIfMissing False "canonical"
+              mapM_ abs2canonical canonical
+              mapM_ cnc2canonical canonical
+         when (FmtCanonicalJson `elem` ofmts) $ mapM_ grammar2json canonical
+      where
+        ofmts = flag optOutputFormats opts
 
     cnc2haskell (cnc,gr) =
-        mapM_ writeHs $ concretes2haskell opts (srcAbsName gr cnc) gr
+      do mapM_ writeExport $ concretes2haskell opts (srcAbsName gr cnc) gr
 
-    writeHs (path,s) = writing opts path $ writeUTF8File path s
+    abs2canonical (cnc,gr) =
+        writeExport ("canonical/"++render absname++".gf",render80 canAbs)
+      where
+        absname = srcAbsName gr cnc
+        canAbs = abstract2canonical absname gr
+
+    cnc2canonical (cnc,gr) =
+      mapM_ (writeExport.fmap render80) $
+            concretes2canonical opts (srcAbsName gr cnc) gr
+
+    grammar2json (cnc,gr) = encodeJSON (render absname ++ ".json") gr_canon
+      where absname = srcAbsName gr cnc
+            gr_canon = grammar2canonical opts absname gr
+
+    writeExport (path,s) = writing opts path $ writeUTF8File path s
 
 
 -- | Create a @.pgf@ file (and possibly files in other formats, if specified
@@ -113,7 +135,7 @@ unionPGFFiles opts fs =
     doIt =
       do pgfs <- mapM readPGFVerbose fs
          let pgf = foldl1 (\one two -> fromMaybe two (unionPGF one two)) pgfs
-             pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
+         let pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
          if pgfFile `elem` fs
            then putStrLnE $ "Refusing to overwrite " ++ pgfFile
            else writeGrammar opts pgf
@@ -135,7 +157,7 @@ writeOutputs opts pgf = do
 -- A split PGF file is output if the @-split-pgf@ option is used.
 writeGrammar :: Options -> PGF -> IOE ()
 writeGrammar opts pgf =
-    if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
+  if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
   where
     writeNormalPGF =
        do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
@@ -144,9 +166,9 @@ writeGrammar opts pgf =
     writeSplitPGF =
       do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
          writing opts outfile $ writePGF outfile pgf
-         forM_ (languages pgf) $ \lang -> do
-           let outfile = outputPath opts (showCId lang <.> "pgf_c")
-           writing opts outfile (writeConcr outfile pgf lang)
+         forM_ (Map.toList (languages pgf)) $ \(concrname,concr) -> do
+           let outfile = outputPath opts (concrname <.> "pgf_c")
+           writing opts outfile (writeConcr outfile concr)
 
 
 writeOutput :: Options -> FilePath-> String -> IOE ()
@@ -156,7 +178,7 @@ writeOutput opts file str = writing opts path $ writeUTF8File path str
 -- * Useful helper functions
 
 grammarName :: Options -> PGF -> String
-grammarName opts pgf = grammarName' opts (showCId (abstractName pgf))
+grammarName opts pgf = grammarName' opts (abstractName pgf)
 grammarName' opts abs = fromMaybe abs (flag optName opts)
 
 outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)