module Drasil.Generator.SRS (
  -- * Generators
  exportSmithEtAlSrs
) where

import Prelude hiding (id)
import Control.Lens ((^.))
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)
import Language.Drasil (Stage(Equational), Document(Document, Notebook),
  ShowTableOfContents, checkToC)
import qualified Language.Drasil.Sentence.Combinators as S
import Language.Drasil.Printers (makeCSS, makeRequirements, genHTML, genTeX,
  genMDBook, makeBook, defaultConfiguration, piSys, PrintingInformation,
  genJupyterSRS)
import Drasil.SRSDocument (SRSDecl, mkDoc)
import Language.Drasil.Printing.Import (makeDocument, makeProject)
import Drasil.System (System, refTable, systemdb)
import Utils.Drasil (createDirIfMissing)

import Drasil.Generator.ChunkDump (dumpEverything)
import Drasil.Generator.Formats (DocSpec(..), DocChoices(DC), Filename,
  docChoices, Format(..))
import Drasil.Generator.SRS.TraceabilityGraphs (outputDot)
import Drasil.Generator.SRS.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 -> CI -> Sentence) -> (Document, System)
mkDoc System
syst SRSDecl
srsDecl IdeaDict -> CI -> Sentence
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> Sentence
S.forT
      printfo :: PrintingInformation
printfo = ChunkDB
-> Map UID Reference
-> Stage
-> PrintingConfiguration
-> PrintingInformation
piSys (System
syst' System -> Getting ChunkDB System ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB System ChunkDB
forall c. HasSystem c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb) (System
syst' System
-> Getting (Map UID Reference) System (Map UID Reference)
-> Map UID Reference
forall s a. s -> Getting a s a -> a
^. Getting (Map UID Reference) System (Map UID Reference)
forall c. HasSystem c => Lens' c (Map UID Reference)
Lens' System (Map UID Reference)
refTable) 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 ([Format] -> DocChoices
docChoices [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!)!

-- | 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 [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 -> Format -> IO ()
prntDoc Document
body PrintingInformation
sm String
fn) [Format]
fmts

-- | Helper for writing the documents (TeX / HTML / Jupyter) to file.
prntDoc :: Document -> PrintingInformation -> String -> Format -> IO ()
prntDoc :: Document -> PrintingInformation -> String -> Format -> IO ()
prntDoc Document
d PrintingInformation
pinfo String
fn Format
fmt =
  case Format
fmt of
    Format
HTML    -> do String
-> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' String
"SRS/HTML" String
fn Format
HTML Document
d PrintingInformation
pinfo
                  String -> Document -> IO ()
prntCSS String
fn Document
d
    Format
TeX     -> do String
-> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' String
"SRS/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 ([Format] -> DocChoices
DC [Format
TeX]) String
fn
    Format
Jupyter ->    String
-> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' String
"SRS/Jupyter" String
fn Format
Jupyter Document
d PrintingInformation
pinfo
    Format
MDBook  -> do String
-> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' String
"SRS/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 ([Format] -> DocChoices
DC [Format
MDBook]) String
fn
                  Document -> PrintingInformation -> IO ()
prntBook Document
d PrintingInformation
pinfo
                  PrintingInformation -> IO ()
prntCSV  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' :: String -> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' :: String
-> String -> Format -> Document -> PrintingInformation -> IO ()
prntDoc' 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' 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 -> Format -> String -> Document -> Doc
writeDoc PrintingInformation
sm 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 [Format]
f) String
_) =
  do Handle
outh <- String -> IOMode -> IO Handle
openFile (String
"SRS" 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 :: String -> Document -> IO ()
prntCSS :: String -> Document -> IO ()
prntCSS String
fn Document
body = do
  Handle
outh2 <- String -> IOMode -> IO Handle
openFile (String
"SRS/HTML/" 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

-- | Helper for generating the .toml config file for mdBook.
prntBook :: Document -> PrintingInformation -> IO()
prntBook :: Document -> PrintingInformation -> IO ()
prntBook 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 = String
"SRS/mdBook/book.toml"

prntCSV :: PrintingInformation -> IO()
prntCSV :: PrintingInformation -> IO ()
prntCSV PrintingInformation
sm = do
  Handle
outh <- String -> IOMode -> IO Handle
openFile String
"SRS/mdBook/.drasil-requirements.csv" 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

-- | Renders single-page documents.
writeDoc :: PrintingInformation -> Format -> Filename -> Document -> Doc
writeDoc :: PrintingInformation -> Format -> String -> Document -> Doc
writeDoc PrintingInformation
s  Format
TeX     String
_  Document
doc = Document -> ShowTableOfContents -> PrintingInformation -> Doc
genTeX (PrintingInformation -> Document -> Document
makeDocument PrintingInformation
s Document
dd) ShowTableOfContents
mToC PrintingInformation
s
  where
    getDoc :: Document -> (Document, ShowTableOfContents)
    getDoc :: Document -> (Document, ShowTableOfContents)
getDoc d :: Document
d@(Document Sentence
_ Sentence
_ ShowTableOfContents
st [Section]
_) = (Document
d , ShowTableOfContents
st)
    getDoc   (Notebook{})        = String -> (Document, ShowTableOfContents)
forall a. HasCallStack => String -> a
error String
"cannot render notebooks into LaTeX"
    (Document
dd , ShowTableOfContents
mToC) = Document -> (Document, ShowTableOfContents)
getDoc (Document -> (Document, ShowTableOfContents))
-> Document -> (Document, ShowTableOfContents)
forall a b. (a -> b) -> a -> b
$ Document -> Document
checkToC Document
doc
writeDoc PrintingInformation
s  Format
HTML    String
fn Document
doc = String -> Document -> Doc
genHTML String
fn (Document -> Doc) -> Document -> Doc
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Document -> Document
makeDocument PrintingInformation
s Document
doc
writeDoc PrintingInformation
s Format
Jupyter String
_  Document
doc = Document -> Doc
genJupyterSRS (Document -> Doc) -> Document -> Doc
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Document -> Document
makeDocument PrintingInformation
s Document
doc
writeDoc PrintingInformation
_  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 = Project -> [(String, Doc)]
genMDBook (Project -> [(String, Doc)]) -> Project -> [(String, Doc)]
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Document -> Project
makeProject 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