{-# LANGUAGE FlexibleContexts, QuasiQuotes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

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(..), ProgData, OOProg, LoggingFor (unLC))
import qualified Drasil.GOOL as OO
import Drasil.GProc (unJLC, unMLC, ProcProg)
import qualified Drasil.GProc as Proc
import Language.Drasil (Space(..), Expr)
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(LogVar), Maps(spaceMatch), Modularity(..),
  OptionalFeatures(logConfig), SpaceMatch, Structure(..),
  Lang(Julia, Java, Python, CSharp, Cpp, Swift, Matlab),
  HasOldCodeSpec(extInputsO), CodeSpec, SomeProgGenerator(..))
import Language.Drasil.GOOL (unPP, unJP, unCSP, unCPPP, unSP, unJLP, unMLP,
  PackageData, SoftwareDossierSym)
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 = PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory [ps|src|] ([FileLayout] -> FileLayout) -> IO [FileLayout] -> IO FileLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lang -> IO FileLayout) -> [Lang] -> IO [FileLayout]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Lang -> IO FileLayout
genLangCode (Choices -> [Lang]
lang Choices
chs)
  where
    genLangCode :: Lang -> IO FileLayout
    genLangCode :: Lang -> IO FileLayout
genLangCode Lang
Java = Lang
-> (JavaCode (Program JavaCode) -> ProgData)
-> (JavaProject PackageData -> PackageData)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO 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 = Lang
-> (MatlabCode (Program MatlabCode) -> ProgData)
-> (MatlabProject PackageData -> PackageData)
-> IO FileLayout
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO FileLayout
genCallProc Lang
Matlab MatlabCode ProgData -> ProgData
MatlabCode (Program MatlabCode) -> ProgData
forall a. MatlabCode a -> a
unMLC MatlabProject PackageData -> PackageData
forall a. MatlabProject a -> a
unMLP

    genCall
      :: (OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr)
      => Lang
      -> (progRepr (OO.Program progRepr) -> ProgData)
      -> (packRepr PackageData -> PackageData)
      -> IO FileLayout
    genCall :: forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO FileLayout
genCall Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = do
      String
time <- Day -> String
showGregorian (Day -> String) -> (UTCTime -> Day) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      [Expr]
samples <- IO [Expr]
readSampleData
      let loggingOpts :: [Logging]
loggingOpts = LogConfig -> [Logging]
logging (LogConfig -> [Logging]) -> LogConfig -> [Logging]
forall a b. (a -> b) -> a -> b
$ OptionalFeatures -> LogConfig
logConfig (OptionalFeatures -> LogConfig) -> OptionalFeatures -> LogConfig
forall a b. (a -> b) -> a -> b
$ Choices -> OptionalFeatures
optFeats Choices
chs
      let realUnProgRepr :: SomeProgGenerator
realUnProgRepr = if Logging
LogVar Logging -> [Logging] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Logging]
loggingOpts then (LoggingFor progRepr (Program (LoggingFor progRepr)) -> ProgData)
-> SomeProgGenerator
forall (repr :: * -> *).
OOProg repr =>
(repr (Program repr) -> ProgData) -> SomeProgGenerator
SomeProgGenerator (progRepr (Program progRepr) -> ProgData
progRepr (Program (LoggingFor progRepr)) -> ProgData
unProgRepr (progRepr (Program (LoggingFor progRepr)) -> ProgData)
-> (LoggingFor progRepr (Program (LoggingFor progRepr))
    -> progRepr (Program (LoggingFor progRepr)))
-> LoggingFor progRepr (Program (LoggingFor progRepr))
-> ProgData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingFor progRepr (Program (LoggingFor progRepr))
-> progRepr (Program (LoggingFor progRepr))
forall (lang :: * -> *) a. LoggingFor lang a -> lang a
unLC) else (progRepr (Program progRepr) -> ProgData) -> SomeProgGenerator
forall (repr :: * -> *).
OOProg repr =>
(repr (Program repr) -> ProgData) -> SomeProgGenerator
SomeProgGenerator progRepr (Program progRepr) -> ProgData
unProgRepr
      FileLayout -> IO FileLayout
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileLayout -> IO FileLayout) -> FileLayout -> IO FileLayout
forall a b. (a -> b) -> a -> b
$ Lang
-> SomeProgGenerator
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
forall (packRepr :: * -> *).
(SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> SomeProgGenerator
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> FileLayout
generateCode Lang
lng SomeProgGenerator
realUnProgRepr packRepr PackageData -> PackageData
unPackRepr (DrasilState -> FileLayout) -> DrasilState -> FileLayout
forall a b. (a -> b) -> a -> b
$ Lang -> String -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng String
time [Expr]
samples Choices
chs CodeSpec
spec

    genCallProc
      :: (ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr)
      => Lang
      -> (progRepr (Proc.Program progRepr) -> ProgData)
      -> (packRepr PackageData -> PackageData)
      -> IO FileLayout
    genCallProc :: forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO FileLayout
genCallProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = do
      String
time <- Day -> String
showGregorian (Day -> String) -> (UTCTime -> Day) -> UTCTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
      [Expr]
samples <- IO [Expr]
readSampleData
      FileLayout -> IO FileLayout
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileLayout -> IO FileLayout) -> FileLayout -> IO FileLayout
forall a b. (a -> b) -> a -> b
$ 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 -> String -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng String
time [Expr]
samples Choices
chs CodeSpec
spec

    spec :: CodeSpec
    spec :: CodeSpec
spec = SmithEtAlSRS -> Choices -> CodeSpec
codeSpec SmithEtAlSRS
syst Choices
chs

    readSampleData :: IO [Expr]
    readSampleData :: IO [Expr]
readSampleData =
      case Choices -> Maybe String
getSampleData Choices
chs of
        Just 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)
        Maybe String
Nothing -> [Expr] -> IO [Expr]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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 :: 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 (SmithEtAlSRS
syst SmithEtAlSRS -> Getting String SmithEtAlSRS String -> String
forall s a. s -> Getting a s a -> a
^. Getting String SmithEtAlSRS String
forall c. HasSmithEtAlSRS c => Lens' c String
Lens' SmithEtAlSRS String
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 :: 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"