module Drasil.Generator.Code (
  -- * Generators
  exportCode, exportCodeZoo,
  -- * 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 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), CodeSpec, HasOldCodeSpec(extInputsO))
import Language.Drasil.GOOL (unPP, unJP, unCSP, unCPPP, unSP, unJLP)
import Drasil.System (System, programName)
import Utils.Drasil (createDirIfMissing)

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

-- | Internal: Generate a zoo of ICO-style executable softifact.
exportCodeZoo :: System -> [Choices] -> IO ()
exportCodeZoo :: System -> [Choices] -> IO ()
exportCodeZoo System
syst = (Choices -> IO ()) -> [Choices] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Choices -> IO ()) -> [Choices] -> IO ())
-> (Choices -> IO ()) -> [Choices] -> IO ()
forall a b. (a -> b) -> a -> b
$ \Choices
chcs -> do
  let dir :: [Char]
dir = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Choices -> [Char]
codedDirName (System
syst System -> Getting [Char] System [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. Getting [Char] System [Char]
forall c. HasSystem c => Lens' c [Char]
Lens' System [Char]
programName) Choices
chcs
  [Char]
workingDir <- IO [Char]
getCurrentDirectory
  Bool -> [Char] -> IO ()
createDirIfMissing Bool
False [Char]
dir
  [Char] -> IO ()
setCurrentDirectory [Char]
dir
  System -> Choices -> IO ()
exportCode System
syst Choices
chcs
  [Char] -> IO ()
setCurrentDirectory [Char]
workingDir

-- | Calls the code generator.
genCode :: Choices -> CodeSpec -> IO ()
genCode :: Choices -> CodeSpec -> IO ()
genCode Choices
chs CodeSpec
spec = do
  [Char]
workingDir <- IO [Char]
getCurrentDirectory
  UTCTime
time <- IO UTCTime
getCurrentTime
  [Expr]
sampData <- IO [Expr] -> ([Char] -> IO [Expr]) -> Maybe [Char] -> 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 []) (\[Char]
sd -> [Char] -> DataDesc' -> IO [Expr]
readWithDataDesc [Char]
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 [Char]
getSampleData Choices
chs)
  Bool -> [Char] -> IO ()
createDirIfMissing Bool
False [Char]
"src"
  [Char] -> IO ()
setCurrentDirectory [Char]
"src"
  let genLangCode :: Lang -> IO ()
genLangCode Lang
Java = Lang
-> (JavaCode (Program JavaCode) -> ProgData)
-> (JavaProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCall Lang
Java JavaCode ProgData -> ProgData
JavaCode (Program JavaCode) -> ProgData
forall a. JavaCode a -> a
unJC JavaProject (PackageData ProgData) -> PackageData ProgData
forall a. JavaProject a -> a
unJP
      genLangCode Lang
Python = Lang
-> (PythonCode (Program PythonCode) -> ProgData)
-> (PythonProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCall Lang
Python PythonCode ProgData -> ProgData
PythonCode (Program PythonCode) -> ProgData
forall a. PythonCode a -> a
unPC PythonProject (PackageData ProgData) -> PackageData ProgData
forall a. PythonProject a -> a
unPP
      genLangCode Lang
CSharp = Lang
-> (CSharpCode (Program CSharpCode) -> ProgData)
-> (CSharpProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCall Lang
CSharp CSharpCode ProgData -> ProgData
CSharpCode (Program CSharpCode) -> ProgData
forall a. CSharpCode a -> a
unCSC CSharpProject (PackageData ProgData) -> PackageData ProgData
forall a. CSharpProject a -> a
unCSP
      genLangCode Lang
Cpp = Lang
-> (CppCode
      CppSrcCode CppHdrCode (Program (CppCode CppSrcCode CppHdrCode))
    -> ProgData)
-> (CppProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> 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 (PackageData ProgData) -> PackageData ProgData
forall a. CppProject a -> a
unCPPP
      genLangCode Lang
Swift = Lang
-> (SwiftCode (Program SwiftCode) -> ProgData)
-> (SwiftProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCall Lang
Swift SwiftCode ProgData -> ProgData
SwiftCode (Program SwiftCode) -> ProgData
forall a. SwiftCode a -> a
unSC SwiftProject (PackageData ProgData) -> PackageData ProgData
forall a. SwiftProject a -> a
unSP
      genLangCode Lang
Julia = Lang
-> (JuliaCode (Program JuliaCode) -> ProgData)
-> (JuliaProject (PackageData ProgData) -> PackageData ProgData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(ProcProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCallProc Lang
Julia JuliaCode ProgData -> ProgData
JuliaCode (Program JuliaCode) -> ProgData
forall a. JuliaCode a -> a
unJLC JuliaProject (PackageData ProgData) -> PackageData ProgData
forall a. JuliaProject a -> a
unJLP
      genCall :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> IO ()
genCall Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr (PackageData ProgData) -> PackageData ProgData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> DrasilState
-> IO ()
generateCode Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr (PackageData ProgData) -> PackageData ProgData
unPackRepr (DrasilState -> IO ()) -> DrasilState -> IO ()
forall a b. (a -> b) -> a -> b
$ Lang -> [Char] -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> [Char]
showGregorian (Day -> [Char]) -> Day -> [Char]
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 ProgData) -> PackageData ProgData)
-> IO ()
genCallProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr (PackageData ProgData) -> PackageData ProgData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, AuxiliarySym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr (PackageData ProgData) -> PackageData ProgData)
-> DrasilState
-> IO ()
generateCodeProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr (PackageData ProgData) -> PackageData ProgData
unPackRepr (DrasilState -> IO ()) -> DrasilState -> IO ()
forall a b. (a -> b) -> a -> b
$ Lang -> [Char] -> [Expr] -> Choices -> CodeSpec -> DrasilState
generator Lang
lng (Day -> [Char]
showGregorian (Day -> [Char]) -> Day -> [Char]
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)
  [Char] -> IO ()
setCurrentDirectory [Char]
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 :: [Char] -> Choices -> [Char]
codedDirName [Char]
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} =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"_" [[Char]
n, Modularity -> [Char]
codedMod (Modularity -> [Char]) -> Modularity -> [Char]
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity Architecture
a, ImplementationType -> [Char]
codedImpTp (ImplementationType -> [Char]) -> ImplementationType -> [Char]
forall a b. (a -> b) -> a -> b
$ Architecture -> ImplementationType
impType Architecture
a, [Logging] -> [Char]
codedLog ([Logging] -> [Char]) -> [Logging] -> [Char]
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 -> [Char]
codedStruct (Structure -> [Char]) -> Structure -> [Char]
forall a b. (a -> b) -> a -> b
$ DataInfo -> Structure
inputStructure DataInfo
d, ConstantStructure -> [Char]
codedConStruct (ConstantStructure -> [Char]) -> ConstantStructure -> [Char]
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantStructure
constStructure DataInfo
d,
    ConstantRepr -> [Char]
codedConRepr (ConstantRepr -> [Char]) -> ConstantRepr -> [Char]
forall a b. (a -> b) -> a -> b
$ DataInfo -> ConstantRepr
constRepr DataInfo
d, SpaceMatch -> [Char]
codedSpaceMatch (SpaceMatch -> [Char]) -> SpaceMatch -> [Char]
forall a b. (a -> b) -> a -> b
$ Maps -> SpaceMatch
spaceMatch Maps
m]

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

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

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

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

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

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

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