-- | Defines Drasil generator functions.
module Drasil.Generator.Generate (
  -- * Generators
  exportSmithEtAlSrs, exportLessonPlan, exportWebsite,
  exportSmithEtAlSrsWCode, exportSmithEtAlSrsWCodeZoo,
  -- * Internal Functions
  codedDirName
) where

import Prelude hiding (id)
import Control.Lens ((^.))
import Data.Char (toLower)
import Data.List (intercalate)
import Data.Time.Clock (getCurrentTime, utctDay)
import Data.Time.Calendar (showGregorian)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.IO (hClose, hPutStrLn, openFile, IOMode(WriteMode))
import Text.PrettyPrint.HughesPJ (Doc, render)

import Build.Drasil (genMake)
import Drasil.DocLang (mkGraphInfo, LsnDecl, mkNb)
import Drasil.GOOL (unJC, unPC, unCSC, unCPPC, unSC, CodeType(..))
import Drasil.GProc (unJLC)
import Language.Drasil (Stage(Equational), Document, Space(..), programName)
import Language.Drasil.Code
import qualified Language.Drasil.Sentence.Combinators as S
import Language.Drasil.Printers (DocType(..), makeCSS, Format(..),
  makeRequirements, genHTML, genTeX, genJupyter, genMDBook, outputDot, makeBook)
import Drasil.SRSDocument (System, SRSDecl, defaultConfiguration, piSys,
  PrintingInformation, mkDoc)
import Drasil.System (System(SI, _sys))
import Utils.Drasil (createDirIfMissing)
import Drasil.Generator.ChunkDump (dumpEverything)
import Drasil.Generator.Formats (Filename, DocSpec(DocSpec), DocChoices(DC), docChoices)
import Drasil.Generator.TypeCheck (typeCheckSI)

-- | Generate an SRS softifact.
exportSmithEtAlSrs :: System -> SRSDecl -> String -> IO ()
exportSmithEtAlSrs :: System -> SRSDecl -> String -> IO ()
exportSmithEtAlSrs System
syst SRSDecl
srsDecl String
srsFileName = do
  let (Document
srs, System
syst') = System
-> SRSDecl
-> (IdeaDict -> IdeaDict -> Sentence)
-> (Document, System)
mkDoc System
syst SRSDecl
srsDecl IdeaDict -> IdeaDict -> Sentence
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> Sentence
S.forT
      printfo :: PrintingInformation
printfo = System -> Stage -> PrintingConfiguration -> PrintingInformation
piSys System
syst' Stage
Equational PrintingConfiguration
defaultConfiguration
  System -> PrintingInformation -> String -> IO ()
dumpEverything System
syst' PrintingInformation
printfo String
".drasil/"
  System -> IO ()
typeCheckSI System
syst' -- FIXME: This should be done on `System` creation *or* chunk creation!
  DocSpec -> Document -> PrintingInformation -> IO ()
genDoc (DocChoices -> String -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
docChoices DocType
SRS [Format
HTML, Format
TeX, Format
Jupyter, Format
MDBook]) String
srsFileName) Document
srs PrintingInformation
printfo
  System -> IO ()
genDot System
syst' -- FIXME: This *MUST* use syst', NOT syst (or else it misses things!)!

-- | Internal: Generate an ICO-style executable softifact.
exportCode :: System -> Choices -> [Mod] -> IO ()
exportCode :: System -> Choices -> [Mod] -> IO ()
exportCode System
syst Choices
chcs [Mod]
extraModules = do
  let code :: CodeSpec
code = System -> Choices -> [Mod] -> CodeSpec
codeSpec System
syst Choices
chcs [Mod]
extraModules
  Choices -> CodeSpec -> IO ()
genCode Choices
chcs CodeSpec
code

-- | Internal: Generate a zoo of ICO-style executable softifact.
exportCodeZoo :: System -> [(Choices, [Mod])] -> IO ()
exportCodeZoo :: System -> [(Choices, [Mod])] -> IO ()
exportCodeZoo System
syst = ((Choices, [Mod]) -> IO ()) -> [(Choices, [Mod])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((Choices, [Mod]) -> IO ()) -> [(Choices, [Mod])] -> IO ())
-> ((Choices, [Mod]) -> IO ()) -> [(Choices, [Mod])] -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Choices
chcs, [Mod]
mods) -> do
  let dir :: String
dir = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> Choices -> String
codedDirName (System -> String
getSysName System
syst) Choices
chcs
      getSysName :: System -> String
getSysName SI{_sys :: ()
_sys = a
sysName} = a -> String
forall c. CommonIdea c => c -> String
programName a
sysName
  String
workingDir <- IO String
getCurrentDirectory
  Bool -> String -> IO ()
createDirIfMissing Bool
False String
dir
  String -> IO ()
setCurrentDirectory String
dir
  System -> Choices -> [Mod] -> IO ()
exportCode System
syst Choices
chcs [Mod]
mods
  String -> IO ()
setCurrentDirectory String
workingDir

-- | Generate an SRS softifact with a specific solution softifact.
exportSmithEtAlSrsWCode :: System -> SRSDecl -> String -> Choices -> [Mod] -> IO ()
exportSmithEtAlSrsWCode :: System -> SRSDecl -> String -> Choices -> [Mod] -> IO ()
exportSmithEtAlSrsWCode System
syst SRSDecl
srsDecl String
srsFileName Choices
chcs [Mod]
extraModules = do
  System -> SRSDecl -> String -> IO ()
exportSmithEtAlSrs System
syst SRSDecl
srsDecl String
srsFileName
  System -> Choices -> [Mod] -> IO ()
exportCode System
syst Choices
chcs [Mod]
extraModules

-- | Generate an SRS softifact with a zoo of solution softifacts.
exportSmithEtAlSrsWCodeZoo :: System -> SRSDecl -> String -> [(Choices, [Mod])] -> IO ()
exportSmithEtAlSrsWCodeZoo :: System -> SRSDecl -> String -> [(Choices, [Mod])] -> IO ()
exportSmithEtAlSrsWCodeZoo System
syst SRSDecl
srsDecl String
srsFileName [(Choices, [Mod])]
chcsMods = do
  System -> SRSDecl -> String -> IO ()
exportSmithEtAlSrs System
syst SRSDecl
srsDecl String
srsFileName
  System -> [(Choices, [Mod])] -> IO ()
exportCodeZoo System
syst [(Choices, [Mod])]
chcsMods

-- | Generate a JupyterNotebook-based lesson plan.
exportLessonPlan :: System -> LsnDecl -> String -> IO ()
exportLessonPlan :: System -> LsnDecl -> String -> IO ()
exportLessonPlan System
syst LsnDecl
nbDecl String
lsnFileName = do
  let nb :: Document
nb = LsnDecl -> (IdeaDict -> IdeaDict -> Sentence) -> System -> Document
mkNb LsnDecl
nbDecl IdeaDict -> IdeaDict -> Sentence
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> Sentence
S.forT System
syst
      printSetting :: PrintingInformation
printSetting = System -> Stage -> PrintingConfiguration -> PrintingInformation
piSys System
syst Stage
Equational PrintingConfiguration
defaultConfiguration
  DocSpec -> Document -> PrintingInformation -> IO ()
genDoc (DocChoices -> String -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
docChoices DocType
Lesson []) String
lsnFileName) Document
nb PrintingInformation
printSetting

-- | Generate a "website" (HTML file) softifact.
exportWebsite :: System -> Document -> Filename -> IO ()
exportWebsite :: System -> Document -> String -> IO ()
exportWebsite System
syst Document
doc String
fileName = do
  let printSetting :: PrintingInformation
printSetting = System -> Stage -> PrintingConfiguration -> PrintingInformation
piSys System
syst Stage
Equational PrintingConfiguration
defaultConfiguration
  DocSpec -> Document -> PrintingInformation -> IO ()
genDoc (DocChoices -> String -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
docChoices DocType
Website [Format
HTML]) String
fileName) Document
doc PrintingInformation
printSetting

-- | Generate a document in one or many flavours (HTML, TeX+Makefile,
-- mdBook+Makefile, or Jupyter Notebook, up to document type).
genDoc :: DocSpec -> Document -> PrintingInformation -> IO ()
genDoc :: DocSpec -> Document -> PrintingInformation -> IO ()
genDoc (DocSpec (DC DocType
Lesson [Format]
_) String
fn) Document
body PrintingInformation
sm = Document
-> PrintingInformation -> String -> DocType -> Format -> IO ()
prntDoc Document
body PrintingInformation
sm String
fn DocType
Lesson Format
Jupyter
genDoc (DocSpec (DC DocType
dt [Format]
fmts) String
fn)  Document
body PrintingInformation
sm = (Format -> IO ()) -> [Format] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Document
-> PrintingInformation -> String -> DocType -> Format -> IO ()
prntDoc Document
body PrintingInformation
sm String
fn DocType
dt) [Format]
fmts

-- | Helper for writing the documents (TeX / HTML / Jupyter) to file.
prntDoc :: Document -> PrintingInformation -> String -> DocType -> Format -> IO ()
prntDoc :: Document
-> PrintingInformation -> String -> DocType -> Format -> IO ()
prntDoc Document
d PrintingInformation
pinfo String
fn DocType
Lesson Format
Jupyter = DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
Lesson String
"Lesson" String
fn Format
Jupyter Document
d PrintingInformation
pinfo
prntDoc Document
_ PrintingInformation
_     String
_  DocType
Lesson Format
_       =
  String -> IO ()
forall a. HasCallStack => String -> a
error String
"Lesson-plan rendering only supports Jupyter Notebook output type."
prntDoc Document
d PrintingInformation
pinfo String
fn DocType
dtype Format
fmt =
  case Format
fmt of
    Format
HTML    -> do DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
dtype (DocType -> String
forall a. Show a => a -> String
show DocType
dtype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/HTML") String
fn Format
HTML Document
d PrintingInformation
pinfo
                  DocType -> String -> Document -> IO ()
prntCSS DocType
dtype String
fn Document
d
    Format
TeX     -> do DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
dtype (DocType -> String
forall a. Show a => a -> String
show DocType
dtype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/PDF") String
fn Format
TeX Document
d PrintingInformation
pinfo
                  DocSpec -> IO ()
prntMake (DocSpec -> IO ()) -> DocSpec -> IO ()
forall a b. (a -> b) -> a -> b
$ DocChoices -> String -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
DC DocType
dtype [Format
TeX]) String
fn
    Format
Jupyter -> do DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
dtype (DocType -> String
forall a. Show a => a -> String
show DocType
dtype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/Jupyter") String
fn Format
Jupyter Document
d PrintingInformation
pinfo
    Format
MDBook  -> do DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
dtype (DocType -> String
forall a. Show a => a -> String
show DocType
dtype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/mdBook") String
fn Format
MDBook Document
d PrintingInformation
pinfo
                  DocSpec -> IO ()
prntMake (DocSpec -> IO ()) -> DocSpec -> IO ()
forall a b. (a -> b) -> a -> b
$ DocChoices -> String -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
DC DocType
dtype [Format
MDBook]) String
fn
                  DocType -> Document -> PrintingInformation -> IO ()
prntBook DocType
dtype Document
d PrintingInformation
pinfo
                  DocType -> PrintingInformation -> IO ()
prntCSV  DocType
dtype PrintingInformation
pinfo
    Format
Plain   -> String -> IO ()
putStrLn String
"Plain-rendering is not supported."

-- | Common error for when an unsupported SRS format is attempted.
srsFormatError :: a
srsFormatError :: forall a. a
srsFormatError = String -> a
forall a. HasCallStack => String -> a
error String
"We can only write TeX/HTML/JSON/MDBook (for now)."

-- | Helper that takes the document type, directory name, document name, format of documents,
-- document information and printing information. Then generates the document file.
prntDoc' :: DocType -> String -> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' :: DocType
-> String
-> String
-> Format
-> Document
-> PrintingInformation
-> IO ()
prntDoc' DocType
_ String
dt' String
_ Format
MDBook Document
body' PrintingInformation
sm = do
  Bool -> String -> IO ()
createDirIfMissing Bool
True String
dir
  ((String, Doc) -> IO ()) -> [(String, Doc)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, Doc) -> IO ()
writeDocToFile [(String, Doc)]
con
  where
    con :: [(String, Doc)]
con = PrintingInformation -> Format -> Document -> [(String, Doc)]
writeDoc' PrintingInformation
sm Format
MDBook Document
body'
    dir :: String
dir = String
dt' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/src"
    writeDocToFile :: (String, Doc) -> IO ()
writeDocToFile (String
fp, Doc
d) = do
      Handle
outh <- String -> IOMode -> IO Handle
openFile (String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".md") IOMode
WriteMode
      Handle -> String -> IO ()
hPutStrLn Handle
outh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
d
      Handle -> IO ()
hClose Handle
outh
prntDoc' DocType
dt String
dt' String
fn Format
format Document
body' PrintingInformation
sm = do
  Bool -> String -> IO ()
createDirIfMissing Bool
True String
dt'
  Handle
outh <- String -> IOMode -> IO Handle
openFile (String
dt' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
getExt Format
format) IOMode
WriteMode
  Handle -> String -> IO ()
hPutStrLn Handle
outh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PrintingInformation
-> DocType -> Format -> String -> Document -> Doc
writeDoc PrintingInformation
sm DocType
dt Format
format String
fn Document
body'
  Handle -> IO ()
hClose Handle
outh
  where
    -- | Gets extension for a particular format.
    -- MDBook case is handled above.
    getExt :: Format -> String
getExt  Format
TeX         = String
".tex"
    getExt  Format
HTML        = String
".html"
    getExt  Format
Jupyter     = String
".ipynb"
    getExt Format
_            = String
forall a. a
srsFormatError

-- | Helper for writing the Makefile(s).
prntMake :: DocSpec -> IO ()
prntMake :: DocSpec -> IO ()
prntMake ds :: DocSpec
ds@(DocSpec (DC DocType
dt [Format]
f) String
_) =
  do Handle
outh <- String -> IOMode -> IO Handle
openFile (DocType -> String
forall a. Show a => a -> String
show DocType
dt String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Format] -> String
dir [Format]
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/Makefile") IOMode
WriteMode
     Handle -> String -> IO ()
hPutStrLn Handle
outh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [DocSpec] -> Doc
forall c. RuleTransformer c => [c] -> Doc
genMake [DocSpec
ds]
     Handle -> IO ()
hClose Handle
outh
  where
    dir :: [Format] -> String
dir [Format
TeX]    = String
"/PDF"
    dir [Format
MDBook] = String
"/mdBook"
    dir [Format]
_        = String -> String
forall a. HasCallStack => String -> a
error String
"Makefile(s) only supported for TeX/MDBook."

-- | Helper that creates a CSS file to accompany an HTML file.
-- Takes in the folder name, generated file name, and the document.
prntCSS :: DocType -> String -> Document -> IO ()
prntCSS :: DocType -> String -> Document -> IO ()
prntCSS DocType
docType String
fn Document
body = do
  Handle
outh2 <- String -> IOMode -> IO Handle
openFile (DocType -> String
forall a. Show a => a -> String
getFD DocType
docType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".css") IOMode
WriteMode
  Handle -> String -> IO ()
hPutStrLn Handle
outh2 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Document -> Doc
makeCSS Document
body)
  Handle -> IO ()
hClose Handle
outh2
  where
    getFD :: a -> String
getFD a
dtype = a -> String
forall a. Show a => a -> String
show a
dtype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/HTML/"

-- | Helper for generating the .toml config file for mdBook.
prntBook :: DocType -> Document -> PrintingInformation -> IO()
prntBook :: DocType -> Document -> PrintingInformation -> IO ()
prntBook DocType
dt Document
doc PrintingInformation
sm = do
  Handle
outh <- String -> IOMode -> IO Handle
openFile String
fp IOMode
WriteMode
  Handle -> String -> IO ()
hPutStrLn Handle
outh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Document -> PrintingInformation -> Doc
makeBook Document
doc PrintingInformation
sm)
  Handle -> IO ()
hClose Handle
outh
  where
    fp :: String
fp = DocType -> String
forall a. Show a => a -> String
show DocType
dt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/mdBook/book.toml"

prntCSV :: DocType -> PrintingInformation -> IO()
prntCSV :: DocType -> PrintingInformation -> IO ()
prntCSV DocType
dt PrintingInformation
sm = do
  Handle
outh <- String -> IOMode -> IO Handle
openFile String
fp IOMode
WriteMode
  Handle -> String -> IO ()
hPutStrLn Handle
outh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (PrintingInformation -> Doc
makeRequirements PrintingInformation
sm)
  Handle -> IO ()
hClose Handle
outh
  where
    fp :: String
fp = DocType -> String
forall a. Show a => a -> String
show DocType
dt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/mdBook/.drasil-requirements.csv"

-- | Renders single-page documents.
writeDoc :: PrintingInformation -> DocType -> Format -> Filename -> Document -> Doc
writeDoc :: PrintingInformation
-> DocType -> Format -> String -> Document -> Doc
writeDoc PrintingInformation
s DocType
_  Format
TeX     String
_  Document
doc = Document -> PrintingInformation -> Doc
genTeX Document
doc PrintingInformation
s
writeDoc PrintingInformation
s DocType
_  Format
HTML    String
fn Document
doc = PrintingInformation -> String -> Document -> Doc
genHTML PrintingInformation
s String
fn Document
doc
writeDoc PrintingInformation
s DocType
dt Format
Jupyter String
_  Document
doc = PrintingInformation -> DocType -> Document -> Doc
genJupyter PrintingInformation
s DocType
dt Document
doc
writeDoc PrintingInformation
_ DocType
_  Format
_       String
_  Document
_   = Doc
forall a. a
srsFormatError

-- | Renders multi-page documents.
writeDoc' :: PrintingInformation -> Format -> Document -> [(Filename, Doc)]
writeDoc' :: PrintingInformation -> Format -> Document -> [(String, Doc)]
writeDoc' PrintingInformation
s Format
MDBook Document
doc = PrintingInformation -> Document -> [(String, Doc)]
genMDBook PrintingInformation
s Document
doc
writeDoc' PrintingInformation
_ Format
_      Document
_   = [(String, Doc)]
forall a. a
srsFormatError

-- | Generates traceability graphs as .dot files.
genDot :: System -> IO ()
genDot :: System -> IO ()
genDot System
si = do
    String
workingDir <- IO String
getCurrentDirectory
    let gi :: GraphInfo
gi = System -> GraphInfo
mkGraphInfo System
si
    String -> GraphInfo -> IO ()
outputDot String
"TraceyGraph" GraphInfo
gi
    String -> IO ()
setCurrentDirectory String
workingDir

-- | Calls the code generator.
genCode :: Choices -> CodeSpec -> IO ()
genCode :: Choices -> CodeSpec -> IO ()
genCode Choices
chs CodeSpec
spec = do
  String
workingDir <- IO String
getCurrentDirectory
  UTCTime
time <- IO UTCTime
getCurrentTime
  [Expr]
sampData <- IO [Expr] -> (String -> IO [Expr]) -> Maybe String -> IO [Expr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Expr] -> IO [Expr]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\String
sd -> String -> DataDesc' -> IO [Expr]
readWithDataDesc String
sd (DataDesc' -> IO [Expr]) -> DataDesc' -> IO [Expr]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk] -> DataDesc'
sampleInputDD
    (CodeSpec
spec CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
extInputsO)) (Choices -> Maybe String
getSampleData Choices
chs)
  Bool -> String -> IO ()
createDirIfMissing Bool
False String
"src"
  String -> IO ()
setCurrentDirectory String
"src"
  let genLangCode :: Lang -> IO ()
genLangCode Lang
Java = Lang
-> (JavaCode (Program JavaCode) -> ProgData)
-> (JavaProject (Package JavaProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
Java JavaCode ProgData -> ProgData
JavaCode (Program JavaCode) -> ProgData
forall a. JavaCode a -> a
unJC JavaProject PackData -> PackData
JavaProject (Package JavaProject) -> PackData
forall a. JavaProject a -> a
unJP
      genLangCode Lang
Python = Lang
-> (PythonCode (Program PythonCode) -> ProgData)
-> (PythonProject (Package PythonProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
Python PythonCode ProgData -> ProgData
PythonCode (Program PythonCode) -> ProgData
forall a. PythonCode a -> a
unPC PythonProject PackData -> PackData
PythonProject (Package PythonProject) -> PackData
forall a. PythonProject a -> a
unPP
      genLangCode Lang
CSharp = Lang
-> (CSharpCode (Program CSharpCode) -> ProgData)
-> (CSharpProject (Package CSharpProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
CSharp CSharpCode ProgData -> ProgData
CSharpCode (Program CSharpCode) -> ProgData
forall a. CSharpCode a -> a
unCSC CSharpProject PackData -> PackData
CSharpProject (Package CSharpProject) -> PackData
forall a. CSharpProject a -> a
unCSP
      genLangCode Lang
Cpp = Lang
-> (CppCode
      CppSrcCode CppHdrCode (Program (CppCode CppSrcCode CppHdrCode))
    -> ProgData)
-> (CppProject (Package CppProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
Cpp CppCode CppSrcCode CppHdrCode ProgData -> ProgData
CppCode
  CppSrcCode CppHdrCode (Program (CppCode CppSrcCode CppHdrCode))
-> ProgData
forall a. CppCode CppSrcCode CppHdrCode a -> a
unCPPC CppProject PackData -> PackData
CppProject (Package CppProject) -> PackData
forall a. CppProject a -> a
unCPPP
      genLangCode Lang
Swift = Lang
-> (SwiftCode (Program SwiftCode) -> ProgData)
-> (SwiftProject (Package SwiftProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
Swift SwiftCode ProgData -> ProgData
SwiftCode (Program SwiftCode) -> ProgData
forall a. SwiftCode a -> a
unSC SwiftProject PackData -> PackData
SwiftProject (Package SwiftProject) -> PackData
forall a. SwiftProject a -> a
unSP
      genLangCode Lang
Julia = Lang
-> (JuliaCode (Program JuliaCode) -> ProgData)
-> (JuliaProject (Package JuliaProject) -> PackData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(ProcProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCallProc Lang
Julia JuliaCode ProgData -> ProgData
JuliaCode (Program JuliaCode) -> ProgData
forall a. JuliaCode a -> a
unJLC JuliaProject PackData -> PackData
JuliaProject (Package JuliaProject) -> PackData
forall a. JuliaProject a -> a
unJLP
      genCall :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr (Package packRepr) -> PackData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> DrasilState
-> IO ()
generateCode Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr (Package packRepr) -> PackData
unPackRepr (DrasilState -> IO ()) -> DrasilState -> IO ()
forall a b. (a -> b) -> a -> b
$ Lang -> String -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> String
showGregorian (Day -> String) -> Day -> String
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
time) [Expr]
sampData Choices
chs CodeSpec
spec
      genCallProc :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCallProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr (Package packRepr) -> PackData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, PackageSym packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> DrasilState
-> IO ()
generateCodeProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr (Package packRepr) -> PackData
unPackRepr (DrasilState -> IO ()) -> DrasilState -> IO ()
forall a b. (a -> b) -> a -> b
$ Lang -> String -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> String
showGregorian (Day -> String) -> Day -> String
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
time) [Expr]
sampData Choices
chs CodeSpec
spec
  (Lang -> IO ()) -> [Lang] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lang -> IO ()
genLangCode (Choices -> [Lang]
lang Choices
chs)
  String -> IO ()
setCurrentDirectory String
workingDir

-- | Find name of folders created for a "zoo" of executable softifacts.
--
-- FIXME: This is a hack. The generation phase should emit what artifacts it
-- created.
codedDirName :: String -> Choices -> String
codedDirName :: String -> Choices -> String
codedDirName String
n Choices {
  architecture :: Choices -> Architecture
architecture = Architecture
a,
  optFeats :: Choices -> OptionalFeatures
optFeats = OptionalFeatures
o,
  dataInfo :: Choices -> DataInfo
dataInfo = DataInfo
d,
  maps :: Choices -> Maps
maps = Maps
m} =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" [String
n, Modularity -> String
codedMod (Modularity -> String) -> Modularity -> String
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity Architecture
a, ImplementationType -> String
codedImpTp (ImplementationType -> String) -> ImplementationType -> String
forall a b. (a -> b) -> a -> b
$ Architecture -> ImplementationType
impType Architecture
a, [Logging] -> String
codedLog ([Logging] -> String) -> [Logging] -> String
forall a b. (a -> b) -> a -> b
$ LogConfig -> [Logging]
logging (LogConfig -> [Logging]) -> LogConfig -> [Logging]
forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> LogConfig
logConfig OptionalFeatures
o,
    Structure -> String
codedStruct (Structure -> String) -> Structure -> String
forall a b. (a -> b) -> a -> b
$ DataInfo -> Structure
inputStructure DataInfo
d, ConstantStructure -> String
codedConStruct (ConstantStructure -> String) -> ConstantStructure -> String
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantStructure
constStructure DataInfo
d,
    ConstantRepr -> String
codedConRepr (ConstantRepr -> String) -> ConstantRepr -> String
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantRepr
constRepr DataInfo
d, SpaceMatch -> String
codedSpaceMatch (SpaceMatch -> String) -> SpaceMatch -> String
forall a b. (a -> b) -> a -> b
$ Maps -> SpaceMatch
spaceMatch Maps
m]

codedMod :: Modularity -> String
codedMod :: Modularity -> String
codedMod Modularity
Unmodular = String
"U"
codedMod Modularity
Modular = String
"M"

codedImpTp :: ImplementationType -> String
codedImpTp :: ImplementationType -> String
codedImpTp ImplementationType
Program = String
"P"
codedImpTp ImplementationType
Library = String
"L"

codedLog :: [Logging] -> String
codedLog :: [Logging] -> String
codedLog [] = String
"NoL"
codedLog [Logging]
_ = String
"L"

codedStruct :: Structure -> String
codedStruct :: Structure -> String
codedStruct Structure
Bundled = String
"B"
codedStruct Structure
Unbundled = String
"U"

codedConStruct :: ConstantStructure -> String
codedConStruct :: ConstantStructure -> String
codedConStruct ConstantStructure
Inline = String
"I"
codedConStruct ConstantStructure
WithInputs = String
"WI"
codedConStruct (Store Structure
s) = Structure -> String
codedStruct Structure
s

codedConRepr :: ConstantRepr -> String
codedConRepr :: ConstantRepr -> String
codedConRepr ConstantRepr
Var = String
"V"
codedConRepr ConstantRepr
Const = String
"C"

codedSpaceMatch :: SpaceMatch -> String
codedSpaceMatch :: SpaceMatch -> String
codedSpaceMatch SpaceMatch
sm = case SpaceMatch
sm Space
Real of [CodeType
Double, CodeType
Float] -> String
"D"
                                     [CodeType
Float, CodeType
Double] -> String
"F"
                                     [CodeType]
_ -> String -> String
forall a. HasCallStack => String -> a
error
                                       String
"Unexpected SpaceMatch for Projectile"