module GF.Compile.Export where

import PGF
import PGF.Internal(ppPGF)
import GF.Compile.PGFtoHaskell
--import GF.Compile.PGFtoAbstract
import GF.Compile.PGFtoJava
import GF.Compile.PGFtoProlog
import GF.Compile.PGFtoJS
import GF.Compile.PGFtoJSON
import GF.Compile.PGFtoPython
import GF.Infra.Option
--import GF.Speech.CFG
import GF.Speech.PGFToCFG
import GF.Speech.SRGS_ABNF
import GF.Speech.SRGS_XML
import GF.Speech.JSGF
import GF.Speech.GSL
import GF.Speech.SRG
import GF.Speech.VoiceXML
import GF.Speech.SLF
import GF.Speech.PrRegExp

import Data.Maybe
import System.FilePath
import GF.Text.Pretty

-- top-level access to code generation

-- | Export a PGF to the given 'OutputFormat'. For many output formats,
-- additional 'Options' can be used to control the output.
exportPGF :: Options
          -> OutputFormat 
          -> PGF 
          -> [(FilePath,String)] -- ^ List of recommended file names and contents.
exportPGF :: Options -> OutputFormat -> PGF -> [(FilePath, FilePath)]
exportPGF Options
opts OutputFormat
fmt PGF
pgf = 
    case OutputFormat
fmt of
      OutputFormat
FmtPGFPretty    -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"txt" (Doc -> FilePath
forall a. Pretty a => a -> FilePath
render (Doc -> FilePath) -> (PGF -> Doc) -> PGF -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Doc
ppPGF)
      OutputFormat
FmtCanonicalGF  -> [] -- canon "gf" (render80 . abstract2canonical)
      OutputFormat
FmtCanonicalJson-> []
      OutputFormat
FmtJavaScript   -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"js"  PGF -> FilePath
pgf2js
      OutputFormat
FmtJSON         -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"json"  PGF -> FilePath
pgf2json
      OutputFormat
FmtPython       -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"py"  PGF -> FilePath
pgf2python
      OutputFormat
FmtHaskell      -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"hs"  (Options -> FilePath -> PGF -> FilePath
grammar2haskell Options
opts FilePath
name)
      OutputFormat
FmtJava         -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"java" (Options -> FilePath -> PGF -> FilePath
grammar2java Options
opts FilePath
name)
      OutputFormat
FmtProlog       -> FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
"pl"  PGF -> FilePath
grammar2prolog
      OutputFormat
FmtBNF          -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"bnf"   PGF -> CId -> FilePath
bnfPrinter
      OutputFormat
FmtEBNF         -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"ebnf"  (Options -> PGF -> CId -> FilePath
ebnfPrinter Options
opts)
      OutputFormat
FmtSRGS_XML     -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"grxml" (Options -> PGF -> CId -> FilePath
srgsXmlPrinter Options
opts)
      OutputFormat
FmtSRGS_XML_NonRec -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"grxml" (Options -> PGF -> CId -> FilePath
srgsXmlNonRecursivePrinter Options
opts)
      OutputFormat
FmtSRGS_ABNF    -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"gram" (Options -> PGF -> CId -> FilePath
srgsAbnfPrinter Options
opts)
      OutputFormat
FmtSRGS_ABNF_NonRec -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"gram" (Options -> PGF -> CId -> FilePath
srgsAbnfNonRecursivePrinter Options
opts)
      OutputFormat
FmtJSGF         -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"jsgf"  (Options -> PGF -> CId -> FilePath
jsgfPrinter Options
opts)
      OutputFormat
FmtGSL          -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"gsl"   (Options -> PGF -> CId -> FilePath
gslPrinter Options
opts)
      OutputFormat
FmtVoiceXML     -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"vxml"  PGF -> CId -> FilePath
grammar2vxml
      OutputFormat
FmtSLF          -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"slf"  PGF -> CId -> FilePath
slfPrinter
      OutputFormat
FmtRegExp       -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"rexp" PGF -> CId -> FilePath
regexpPrinter
      OutputFormat
FmtFA           -> FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
"dot"  PGF -> CId -> FilePath
slfGraphvizPrinter
 where
   name :: FilePath
name = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (CId -> FilePath
showCId (PGF -> CId
abstractName PGF
pgf)) ((Flags -> Maybe FilePath) -> Options -> Maybe FilePath
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe FilePath
optName Options
opts)

   multi :: String -> (PGF -> String) -> [(FilePath,String)]
   multi :: FilePath -> (PGF -> FilePath) -> [(FilePath, FilePath)]
multi FilePath
ext PGF -> FilePath
pr = [(FilePath
name FilePath -> FilePath -> FilePath
<.> FilePath
ext, PGF -> FilePath
pr PGF
pgf)]

-- canon ext pr = [("canonical"</>name<.>ext,pr pgf)]

   single :: String -> (PGF -> CId -> String) -> [(FilePath,String)]
   single :: FilePath -> (PGF -> CId -> FilePath) -> [(FilePath, FilePath)]
single FilePath
ext PGF -> CId -> FilePath
pr = [(CId -> FilePath
showCId CId
cnc FilePath -> FilePath -> FilePath
<.> FilePath
ext, PGF -> CId -> FilePath
pr PGF
pgf CId
cnc) | CId
cnc <- PGF -> [CId]
languages PGF
pgf]


-- | Get the name of the concrete syntax to generate output from.
-- FIXME: there should be an option to change this.
outputConcr :: PGF -> CId
outputConcr :: PGF -> CId
outputConcr PGF
pgf = case PGF -> [CId]
languages PGF
pgf of
                    []     -> FilePath -> CId
forall a. HasCallStack => FilePath -> a
error FilePath
"No concrete syntax."
                    CId
cnc:[CId]
_  -> CId
cnc