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 -> PackageData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
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 ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
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 ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
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 ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> 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 -> PackageData
forall a. CppProject a -> a
unCPPP
      genLangCode Lang
Swift = Lang
-> (SwiftCode (Program SwiftCode) -> ProgData)
-> (SwiftProject PackageData -> PackageData)
-> IO ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
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 ()
forall {progRepr :: * -> *} {packRepr :: * -> *}.
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
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
      genCall :: Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> IO ()
genCall Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(OOProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> IO ()
generateCode Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr PackageData -> PackageData
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 -> PackageData)
-> IO ()
genCallProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr packRepr PackageData -> PackageData
unPackRepr = Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> IO ()
forall (progRepr :: * -> *) (packRepr :: * -> *).
(ProcProg progRepr, SoftwareDossierSym packRepr, Monad packRepr) =>
Lang
-> (progRepr (Program progRepr) -> ProgData)
-> (packRepr PackageData -> PackageData)
-> DrasilState
-> IO ()
generateCodeProc Lang
lng progRepr (Program progRepr) -> ProgData
unProgRepr
        packRepr PackageData -> PackageData
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"