{-# LANGUAGE FlexibleContexts, QuasiQuotes #-}

module Drasil.Generator.Code (
  -- * Generators
  genCode, genCodeZoo,
  -- * 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 Drasil.FileHandling (FileLayout, directory, ps)
import Drasil.GOOL (unJC, unPC, unCSC, unCPPC, unSC, CodeType(..))
import Drasil.GProc (unJLC)
import Language.Drasil (Space(..))
import Language.Drasil.Code (getSampleData, generateCode, generateCodeProc,
  generator, readWithDataDesc, sampleInputDD, codeSpec,
  Architecture(impType, modularity), Choices(Choices, maps, lang,
  architecture, optFeats, dataInfo), ConstantRepr(..),
  ConstantStructure(..), DataInfo(constRepr, inputStructure,
  constStructure), ImplementationType(..), LogConfig(logging), Logging,
  Maps(spaceMatch), Modularity(..), OptionalFeatures(logConfig), SpaceMatch,
  Structure(..), Lang(Julia, Java,
  Python, CSharp, Cpp, Swift, Matlab), HasOldCodeSpec(extInputsO))
import Language.Drasil.GOOL (unPP, unJP, unCSP, unCPPP, unSP, unJLP)
import Drasil.System (SmithEtAlSRS, programName)

-- | Generate an ICO-style executable software artifact.
genCode :: SmithEtAlSRS -> Choices -> IO FileLayout
genCode :: SmithEtAlSRS -> Choices -> IO FileLayout
genCode SmithEtAlSRS
syst Choices
chs = do
  let spec :: CodeSpec
spec = SmithEtAlSRS -> Choices -> CodeSpec
codeSpec SmithEtAlSRS
syst Choices
chs
  UTCTime
time <- IO UTCTime
getCurrentTime
  [Expr]
sampData <- IO [Expr] -> (FilePath -> IO [Expr]) -> Maybe FilePath -> 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 []) (\FilePath
sd -> FilePath -> DataDesc' -> IO [Expr]
readWithDataDesc FilePath
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 FilePath
getSampleData Choices
chs)
  let genLangCode :: Lang -> FileLayout
genLangCode Lang
Java = Lang
-> (JavaCode (Program JavaCode) -> ProgData)
-> (JavaProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr,
 InstanceVarSelfSym (LoggingFor progRepr)) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCall Lang
Java JavaCode ProgData -> ProgData
JavaCode (Program JavaCode) -> ProgData
forall a. JavaCode a -> a
unJC JavaProject PackageData -> PackageData
forall a. JavaProject a -> a
unJP
      genLangCode Lang
Python = Lang
-> (PythonCode (Program PythonCode) -> ProgData)
-> (PythonProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr,
 InstanceVarSelfSym (LoggingFor progRepr)) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCall Lang
Python PythonCode ProgData -> ProgData
PythonCode (Program PythonCode) -> ProgData
forall a. PythonCode a -> a
unPC PythonProject PackageData -> PackageData
forall a. PythonProject a -> a
unPP
      genLangCode Lang
CSharp = Lang
-> (CSharpCode (Program CSharpCode) -> ProgData)
-> (CSharpProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr,
 InstanceVarSelfSym (LoggingFor progRepr)) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCall Lang
CSharp CSharpCode ProgData -> ProgData
CSharpCode (Program CSharpCode) -> ProgData
forall a. CSharpCode a -> a
unCSC CSharpProject PackageData -> PackageData
forall a. CSharpProject a -> a
unCSP
      genLangCode Lang
Cpp = Lang
-> (CppCode
      CppSrcCode CppHdrCode (Program (CppCode CppSrcCode CppHdrCode))
    -> ProgData)
-> (CppProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr,
 InstanceVarSelfSym (LoggingFor progRepr)) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
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 PackageData -> PackageData
forall a. CppProject a -> a
unCPPP
      genLangCode Lang
Swift = Lang
-> (SwiftCode (Program SwiftCode) -> ProgData)
-> (SwiftProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr,
 InstanceVarSelfSym (LoggingFor progRepr)) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCall Lang
Swift SwiftCode ProgData -> ProgData
SwiftCode (Program SwiftCode) -> ProgData
forall a. SwiftCode a -> a
unSC SwiftProject PackageData -> PackageData
forall a. SwiftProject a -> a
unSP
      genLangCode Lang
Julia = Lang
-> (JuliaCode (Program JuliaCode) -> ProgData)
-> (JuliaProject PackageData -> PackageData)
-> FileLayout
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCallProc Lang
Julia JuliaCode ProgData -> ProgData
JuliaCode (Program JuliaCode) -> ProgData
forall a. JuliaCode a -> a
unJLC JuliaProject PackageData -> PackageData
forall a. JuliaProject a -> a
unJLP
      genLangCode Lang
Matlab = FilePath -> FileLayout
forall a. HasCallStack => FilePath -> a
error FilePath
"MatlabRenderer not yet implemented (plumbing only)"
      genCall :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> FileLayout
genCall Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, InstanceVarSelfSym (LoggingFor progRepr),
 SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
generateCode Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr PackageData -> PackageData
unPackRepr (DrasilState -> FileLayout) -> DrasilState -> FileLayout
forall a b. (a -> b) -> a -> b
$ Lang -> FilePath -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> FilePath
showGregorian (Day -> FilePath) -> Day -> FilePath
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 PackageData -> PackageData)
-> FileLayout
genCallProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
generateCodeProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr PackageData -> PackageData
unPackRepr (DrasilState -> FileLayout) -> DrasilState -> FileLayout
forall a b. (a -> b) -> a -> b
$ Lang -> FilePath -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> FilePath
showGregorian (Day -> FilePath) -> Day -> FilePath
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
time) [Expr]
sampData Choices
chs CodeSpec
spec
      layout :: FileLayout
layout = PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory [ps|src|] ([FileLayout] -> FileLayout) -> [FileLayout] -> FileLayout
forall a b. (a -> b) -> a -> b
$ (Lang -> FileLayout) -> [Lang] -> [FileLayout]
forall a b. (a -> b) -> [a] -> [b]
map Lang -> FileLayout
genLangCode (Choices -> [Lang]
lang Choices
chs)
  FileLayout -> IO FileLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileLayout
layout

genCodeZoo :: SmithEtAlSRS -> [Choices] -> IO [FileLayout]
genCodeZoo :: SmithEtAlSRS -> [Choices] -> IO [FileLayout]
genCodeZoo SmithEtAlSRS
syst = (Choices -> IO FileLayout) -> [Choices] -> IO [FileLayout]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Choices -> IO FileLayout) -> [Choices] -> IO [FileLayout])
-> (Choices -> IO FileLayout) -> [Choices] -> IO [FileLayout]
forall a b. (a -> b) -> a -> b
$ \Choices
chcs -> do
    let dir :: FilePath
dir = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Choices -> FilePath
codedDirName (SmithEtAlSRS
syst SmithEtAlSRS -> Getting FilePath SmithEtAlSRS FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath SmithEtAlSRS FilePath
forall c. HasSmithEtAlSRS c => Lens' c FilePath
Lens' SmithEtAlSRS FilePath
programName) Choices
chcs
    FileLayout
layout <- SmithEtAlSRS -> Choices -> IO FileLayout
genCode SmithEtAlSRS
syst Choices
chcs
    FileLayout -> IO FileLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileLayout -> IO FileLayout) -> FileLayout -> IO FileLayout
forall a b. (a -> b) -> a -> b
$ PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory [ps|{dir}|] [FileLayout
layout]

-- | 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 :: FilePath -> Choices -> FilePath
codedDirName FilePath
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} =
  FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_" [FilePath
n, Modularity -> FilePath
codedMod (Modularity -> FilePath) -> Modularity -> FilePath
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity Architecture
a, ImplementationType -> FilePath
codedImpTp (ImplementationType -> FilePath) -> ImplementationType -> FilePath
forall a b. (a -> b) -> a -> b
$ Architecture -> ImplementationType
impType Architecture
a, [Logging] -> FilePath
codedLog ([Logging] -> FilePath) -> [Logging] -> FilePath
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 -> FilePath
codedStruct (Structure -> FilePath) -> Structure -> FilePath
forall a b. (a -> b) -> a -> b
$ DataInfo -> Structure
inputStructure DataInfo
d, ConstantStructure -> FilePath
codedConStruct (ConstantStructure -> FilePath) -> ConstantStructure -> FilePath
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantStructure
constStructure DataInfo
d,
    ConstantRepr -> FilePath
codedConRepr (ConstantRepr -> FilePath) -> ConstantRepr -> FilePath
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantRepr
constRepr DataInfo
d, SpaceMatch -> FilePath
codedSpaceMatch (SpaceMatch -> FilePath) -> SpaceMatch -> FilePath
forall a b. (a -> b) -> a -> b
$ Maps -> SpaceMatch
spaceMatch Maps
m]

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

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

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

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

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

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

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