-- | Defines Drasil generator functions.
module Language.Drasil.Generate (
  -- * Generator Functions
  gen, genDot, genCode, genLog,
  -- * Types (Printing Options)
  DocType(..), DocSpec(DocSpec), Format(TeX, HTML), DocChoices(DC),
  -- * Constructor
  docChoices) where

import System.IO (hClose, hPutStrLn, openFile, IOMode(WriteMode))
import Text.PrettyPrint.HughesPJ (Doc, render)
import Prelude hiding (id)
import System.Directory (createDirectoryIfMissing, getCurrentDirectory,
  setCurrentDirectory)
import Data.Time.Clock (getCurrentTime, utctDay)
import Data.Time.Calendar (showGregorian)

import Build.Drasil (genMake)
import Language.Drasil
import Drasil.DocLang (mkGraphInfo)
import SysInfo.Drasil (SystemInformation(SI, _sys))
import Language.Drasil.Printers (Format(TeX, HTML, JSON), 
 makeCSS, genHTML, genTeX, genJSON, PrintingInformation, outputDot, printAllDebugInfo)
import Language.Drasil.Code (generator, generateCode, Choices(..), CodeSpec(..),
  Lang(..), getSampleData, readWithDataDesc, sampleInputDD, 
  unPP, unJP, unCSP, unCPPP, unSP)
import Language.Drasil.Output.Formats(DocType(SRS, Website, Jupyter), Filename, DocSpec(DocSpec), DocChoices(DC))

import GOOL.Drasil (unJC, unPC, unCSC, unCPPC, unSC)
import Data.Char (isSpace)

-- | Generate a number of artifacts based on a list of recipes.
gen :: DocSpec -> Document -> PrintingInformation -> IO ()
gen :: DocSpec -> Document -> PrintingInformation -> IO ()
gen ds :: DocSpec
ds fn :: Document
fn sm :: PrintingInformation
sm = PrintingInformation -> DocSpec -> Document -> IO ()
prnt PrintingInformation
sm DocSpec
ds Document
fn -- FIXME: 'prnt' is just 'gen' with the arguments reordered

-- TODO: Include Jupyter into the SRS setup.
-- | Generate the output artifacts (TeX+Makefile or HTML).
prnt :: PrintingInformation -> DocSpec -> Document -> IO ()
prnt :: PrintingInformation -> DocSpec -> Document -> IO ()
prnt sm :: PrintingInformation
sm (DocSpec (DC Jupyter _) fn :: Filename
fn) body :: Document
body =
  do Document
-> PrintingInformation -> Filename -> DocType -> Format -> IO ()
prntDoc Document
body PrintingInformation
sm Filename
fn DocType
Jupyter Format
JSON
prnt sm :: PrintingInformation
sm (DocSpec (DC dtype :: DocType
dtype fmts :: [Format]
fmts) fn :: Filename
fn) body :: Document
body =
  do (Format -> IO ()) -> [Format] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Document
-> PrintingInformation -> Filename -> DocType -> Format -> IO ()
prntDoc Document
body PrintingInformation
sm Filename
fn DocType
dtype) [Format]
fmts

-- | Helper for writing the documents (TeX / HTML) to file.
prntDoc :: Document -> PrintingInformation -> String -> DocType -> Format -> IO ()
prntDoc :: Document
-> PrintingInformation -> Filename -> DocType -> Format -> IO ()
prntDoc d :: Document
d pinfo :: PrintingInformation
pinfo fn :: Filename
fn Jupyter _ = Filename
-> Filename -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' "Jupyter" Filename
fn Format
JSON Document
d PrintingInformation
pinfo
prntDoc d :: Document
d pinfo :: PrintingInformation
pinfo fn :: Filename
fn dtype :: DocType
dtype fmt :: Format
fmt =
  case Format
fmt of
    HTML -> do Filename
-> Filename -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' (DocType -> Filename
forall a. Show a => a -> Filename
show DocType
dtype Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/HTML") Filename
fn Format
HTML Document
d PrintingInformation
pinfo
               DocType -> Filename -> Document -> IO ()
prntCSS DocType
dtype Filename
fn Document
d
    TeX -> do Filename
-> Filename -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' (DocType -> Filename
forall a. Show a => a -> Filename
show DocType
dtype Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/PDF") Filename
fn Format
TeX Document
d PrintingInformation
pinfo
              DocSpec -> IO ()
prntMake (DocSpec -> IO ()) -> DocSpec -> IO ()
forall a b. (a -> b) -> a -> b
$ DocChoices -> Filename -> DocSpec
DocSpec (DocType -> [Format] -> DocChoices
DC DocType
dtype []) Filename
fn
    _ -> IO ()
forall a. Monoid a => a
mempty

-- | Helper that takes the directory name, document name, format of documents,
-- document information and printing information. Then generates the document file.
prntDoc' :: String -> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' :: Filename
-> Filename -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' dt' :: Filename
dt' fn :: Filename
fn format :: Format
format body' :: Document
body' sm :: PrintingInformation
sm = do
  Bool -> Filename -> IO ()
createDirectoryIfMissing Bool
True Filename
dt'
  Handle
outh <- Filename -> IOMode -> IO Handle
openFile (Filename
dt' Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/" Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ Filename
fn Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ Format -> Filename
getExt Format
format) IOMode
WriteMode
  Handle -> Filename -> IO ()
hPutStrLn Handle
outh (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Filename
render (Doc -> Filename) -> Doc -> Filename
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Format -> Filename -> Document -> Doc
writeDoc PrintingInformation
sm Format
format Filename
fn Document
body'
  Handle -> IO ()
hClose Handle
outh
  where getExt :: Format -> Filename
getExt TeX  = ".tex"
        getExt HTML = ".html"
        getExt JSON = ".ipynb"
        getExt _    = Filename -> Filename
forall a. HasCallStack => Filename -> a
error "We can only write in TeX, HTML and in Python Notebooks (for now)."

-- | Helper for writing the Makefile(s).
prntMake :: DocSpec -> IO ()
prntMake :: DocSpec -> IO ()
prntMake ds :: DocSpec
ds@(DocSpec (DC dt :: DocType
dt _) _) =
  do Handle
outh <- Filename -> IOMode -> IO Handle
openFile (DocType -> Filename
forall a. Show a => a -> Filename
show DocType
dt Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/PDF/Makefile") IOMode
WriteMode
     Handle -> Filename -> IO ()
hPutStrLn Handle
outh (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Filename
render (Doc -> Filename) -> Doc -> Filename
forall a b. (a -> b) -> a -> b
$ [DocSpec] -> Doc
forall c. RuleTransformer c => [c] -> Doc
genMake [DocSpec
ds]
     Handle -> IO ()
hClose Handle
outh

-- | 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 -> Filename -> Document -> IO ()
prntCSS docType :: DocType
docType fn :: Filename
fn body :: Document
body = do
  Handle
outh2 <- Filename -> IOMode -> IO Handle
openFile (DocType -> Filename
forall a. Show a => a -> Filename
getFD DocType
docType Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ Filename
fn Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ ".css") IOMode
WriteMode
  Handle -> Filename -> IO ()
hPutStrLn Handle
outh2 (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Filename
render (Document -> Doc
makeCSS Document
body)
  Handle -> IO ()
hClose Handle
outh2
  where
    getFD :: a -> Filename
getFD dtype :: a
dtype = a -> Filename
forall a. Show a => a -> Filename
show a
dtype Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/HTML/"

-- | Renders the documents.
writeDoc :: PrintingInformation -> Format -> Filename -> Document -> Doc
writeDoc :: PrintingInformation -> Format -> Filename -> Document -> Doc
writeDoc s :: PrintingInformation
s TeX  _  doc :: Document
doc = Document -> PrintingInformation -> Doc
genTeX Document
doc PrintingInformation
s
writeDoc s :: PrintingInformation
s HTML fn :: Filename
fn doc :: Document
doc = PrintingInformation -> Filename -> Document -> Doc
genHTML PrintingInformation
s Filename
fn Document
doc
writeDoc s :: PrintingInformation
s JSON _ doc :: Document
doc  = PrintingInformation -> Document -> Doc
genJSON PrintingInformation
s Document
doc
writeDoc _    _  _   _ = Filename -> Doc
forall a. HasCallStack => Filename -> a
error "we can only write TeX/HTML (for now)"

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

-- | Generates debugging logs to show all of the 'UID's used in an example.
genLog :: SystemInformation -> PrintingInformation -> IO ()
genLog :: SystemInformation -> PrintingInformation -> IO ()
genLog SI{_sys :: ()
_sys = a
sysName} pinfo :: PrintingInformation
pinfo = do
  Filename
workingDir <- IO Filename
getCurrentDirectory
  Bool -> Filename -> IO ()
createDirectoryIfMissing Bool
True (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ "../../debug/" Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> Filename -> Filename
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (a -> Filename
forall c. CommonIdea c => c -> Filename
abrv a
sysName) Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/SRSlogs"
  Filename -> IO ()
setCurrentDirectory (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ "../../debug/" Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> Filename -> Filename
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (a -> Filename
forall c. CommonIdea c => c -> Filename
abrv a
sysName) Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "/SRSlogs"
  Handle
handle <- Filename -> IOMode -> IO Handle
openFile ((Char -> Bool) -> Filename -> Filename
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace) (a -> Filename
forall c. CommonIdea c => c -> Filename
abrv a
sysName) Filename -> Filename -> Filename
forall a. [a] -> [a] -> [a]
++ "_SRS.log") IOMode
WriteMode
  (Doc -> IO ()) -> [Doc] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Filename -> IO ()
hPutStrLn Handle
handle (Filename -> IO ()) -> (Doc -> Filename) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Filename
render) ([Doc] -> IO ()) -> [Doc] -> IO ()
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> [Doc]
printAllDebugInfo PrintingInformation
pinfo
  Handle -> IO ()
hClose Handle
handle
  Filename -> IO ()
setCurrentDirectory Filename
workingDir

-- | Calls the code generator.
genCode :: Choices -> CodeSpec -> IO ()
genCode :: Choices -> CodeSpec -> IO ()
genCode chs :: Choices
chs spec :: CodeSpec
spec = do 
  Filename
workingDir <- IO Filename
getCurrentDirectory
  UTCTime
time <- IO UTCTime
getCurrentTime
  [Expr]
sampData <- IO [Expr] -> (Filename -> IO [Expr]) -> Maybe Filename -> IO [Expr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Expr] -> IO [Expr]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\sd :: Filename
sd -> Filename -> DataDesc' -> IO [Expr]
readWithDataDesc Filename
sd (DataDesc' -> IO [Expr]) -> DataDesc' -> IO [Expr]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk] -> DataDesc'
sampleInputDD 
    (CodeSpec -> [CodeVarChunk]
extInputs CodeSpec
spec)) (Choices -> Maybe Filename
getSampleData Choices
chs)
  Bool -> Filename -> IO ()
createDirectoryIfMissing Bool
False "src"
  Filename -> IO ()
setCurrentDirectory "src"
  let genLangCode :: Lang -> IO ()
genLangCode 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 (Program JavaCode) -> ProgData
forall a. JavaCode a -> a
unJC JavaProject (Package JavaProject) -> PackData
forall a. JavaProject a -> a
unJP
      genLangCode 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 (Program PythonCode) -> ProgData
forall a. PythonCode a -> a
unPC PythonProject (Package PythonProject) -> PackData
forall a. PythonProject a -> a
unPP
      genLangCode 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 (Program CSharpCode) -> ProgData
forall a. CSharpCode a -> a
unCSC CSharpProject (Package CSharpProject) -> PackData
forall a. CSharpProject a -> a
unCSP
      genLangCode 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 (Program (CppCode CppSrcCode CppHdrCode))
-> ProgData
forall a. CppCode CppSrcCode CppHdrCode a -> a
unCPPC CppProject (Package CppProject) -> PackData
forall a. CppProject a -> a
unCPPP
      genLangCode 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 (Program SwiftCode) -> ProgData
forall a. SwiftCode a -> a
unSC SwiftProject (Package SwiftProject) -> PackData
forall a. SwiftProject a -> a
unSP
      genCall :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (Package packRepr) -> PackData)
-> IO ()
genCall lng :: Lang
lng unProgRepr :: progRepr (Program progRepr) -> ProgData
unProgRepr unPackRepr :: 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 -> Filename -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> Filename
showGregorian (Day -> Filename) -> Day -> Filename
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)
  Filename -> IO ()
setCurrentDirectory Filename
workingDir

-- | Constructor for users to choose their document options
docChoices :: DocType -> [Format] -> DocChoices
docChoices :: DocType -> [Format] -> DocChoices
docChoices = DocType -> [Format] -> DocChoices
DC