{-# LANGUAGE TupleSections #-}
module Drasil.Projectile.Choices where

import Language.Drasil (Space(..), programName)
import Language.Drasil.Code (Choices(..), Comments(..), 
  Verbosity(..), ConstraintBehaviour(..), ImplementationType(..), Lang(..), 
  Logging(..), Modularity(..), Structure(..), ConstantStructure(..), 
  ConstantRepr(..), InputModule(..), CodeConcept(..), matchConcepts, SpaceMatch,
  matchSpaces, AuxFile(..), Visibility(..), defaultChoices, codeSpec, makeArchit, 
  Architecture(..), makeData, DataInfo(..), Maps(..), makeMaps, spaceToCodeType,
  makeConstraints, makeDocConfig, makeLogConfig, LogConfig(..), OptionalFeatures(..), 
  makeOptFeats)
import Language.Drasil.Generate (genCode)
import GOOL.Drasil (CodeType(..))
import Data.Drasil.Quantities.Math (piConst)
import Drasil.Projectile.Body (fullSI)
import SysInfo.Drasil (SystemInformation(SI, _sys))

import Data.List (intercalate)
import System.Directory (createDirectoryIfMissing, getCurrentDirectory, 
  setCurrentDirectory)
import Data.Char (toLower)

genCodeWithChoices :: [Choices] -> IO ()
genCodeWithChoices :: [Choices] -> IO ()
genCodeWithChoices [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
genCodeWithChoices (Choices
c:[Choices]
cs) = let dir :: [Char]
dir = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ [Char] -> Choices -> [Char]
codedDirName (SystemInformation -> [Char]
getSysName SystemInformation
fullSI) Choices
c
                                getSysName :: SystemInformation -> [Char]
getSysName SI{_sys :: ()
_sys = a
sysName} = forall c. CommonIdea c => c -> [Char]
programName a
sysName
  in do
    [Char]
workingDir <- IO [Char]
getCurrentDirectory
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
dir
    [Char] -> IO ()
setCurrentDirectory [Char]
dir
    Choices -> CodeSpec -> IO ()
genCode Choices
c (SystemInformation -> Choices -> [Mod] -> CodeSpec
codeSpec SystemInformation
fullSI Choices
c [])
    [Char] -> IO ()
setCurrentDirectory [Char]
workingDir
    [Choices] -> IO ()
genCodeWithChoices [Choices]
cs

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

codedMod :: Modularity -> String
codedMod :: Modularity -> [Char]
codedMod Modularity
Unmodular = [Char]
"U"
codedMod (Modular InputModule
Combined) = [Char]
"C"
codedMod (Modular InputModule
Separated) = [Char]
"S"

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]
_ -> forall a. HasCallStack => [Char] -> a
error 
                                       [Char]
"Unexpected SpaceMatch for Projectile"

choiceCombos :: [Choices]
choiceCombos :: [Choices]
choiceCombos = [Choices
baseChoices, 
  Choices
baseChoices {
    architecture :: Architecture
architecture = Modularity -> ImplementationType -> Architecture
makeArchit (InputModule -> Modularity
Modular InputModule
Combined) ImplementationType
Program,
    dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Bundled (Structure -> ConstantStructure
Store Structure
Unbundled) ConstantRepr
Var
  },
  Choices
baseChoices {
    architecture :: Architecture
architecture = Modularity -> ImplementationType -> Architecture
makeArchit (InputModule -> Modularity
Modular InputModule
Separated) ImplementationType
Library,
    dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Unbundled (Structure -> ConstantStructure
Store Structure
Unbundled) ConstantRepr
Var,
    maps :: Maps
maps = ConceptMatchMap -> SpaceMatch -> Maps
makeMaps (forall c. HasUID c => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts [(ConstQDef
piConst, [CodeConcept
Pi])]) SpaceMatch
matchToFloats
  },
  Choices
baseChoices {
    dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Bundled (Structure -> ConstantStructure
Store Structure
Bundled) ConstantRepr
Const,
    optFeats :: OptionalFeatures
optFeats = DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats
      ([Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig [Comments
CommentFunc, Comments
CommentClass, Comments
CommentMod] Verbosity
Quiet Visibility
Hide)
      ([Logging] -> [Char] -> LogConfig
makeLogConfig [Logging
LogVar, Logging
LogFunc] [Char]
"log.txt")
      [[Char] -> AuxFile
SampleInput [Char]
"../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME],
    folderVal :: Int
folderVal = Int
5
  },
  Choices
baseChoices {
    dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Bundled ConstantStructure
WithInputs ConstantRepr
Var,
    maps :: Maps
maps = ConceptMatchMap -> SpaceMatch -> Maps
makeMaps (forall c. HasUID c => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts [(ConstQDef
piConst, [CodeConcept
Pi])]) SpaceMatch
matchToFloats,
    optFeats :: OptionalFeatures
optFeats = DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats
      ([Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig [Comments
CommentFunc, Comments
CommentClass, Comments
CommentMod] Verbosity
Quiet Visibility
Hide)
      ([Logging] -> [Char] -> LogConfig
makeLogConfig [Logging
LogVar, Logging
LogFunc] [Char]
"log.txt")
      [[Char] -> AuxFile
SampleInput [Char]
"../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME],
    folderVal :: Int
folderVal = Int
5
  }]

matchToFloats :: SpaceMatch
matchToFloats :: SpaceMatch
matchToFloats = [(Space, [CodeType])] -> SpaceMatch
matchSpaces (forall a b. (a -> b) -> [a] -> [b]
map (,[CodeType
Float, CodeType
Double]) [Space
Real, Space
Rational])

baseChoices :: Choices
baseChoices :: Choices
baseChoices = Choices
defaultChoices {
  lang :: [Lang]
lang = [Lang
Python, Lang
Cpp, Lang
CSharp, Lang
Java, Lang
Swift],
  architecture :: Architecture
architecture = Modularity -> ImplementationType -> Architecture
makeArchit Modularity
Unmodular ImplementationType
Program,
  dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Unbundled ConstantStructure
WithInputs ConstantRepr
Var,
  maps :: Maps
maps = ConceptMatchMap -> SpaceMatch -> Maps
makeMaps (forall c. HasUID c => [(c, [CodeConcept])] -> ConceptMatchMap
matchConcepts [(ConstQDef
piConst, [CodeConcept
Pi])]) SpaceMatch
spaceToCodeType,
  optFeats :: OptionalFeatures
optFeats = DocConfig -> LogConfig -> [AuxFile] -> OptionalFeatures
makeOptFeats
    ([Comments] -> Verbosity -> Visibility -> DocConfig
makeDocConfig [Comments
CommentFunc, Comments
CommentClass, Comments
CommentMod] Verbosity
Quiet Visibility
Hide)
    ([Logging] -> [Char] -> LogConfig
makeLogConfig [] [Char]
"log.txt")
    [[Char] -> AuxFile
SampleInput [Char]
"../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME],
  srsConstraints :: Constraints
srsConstraints = ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints ConstraintBehaviour
Warning ConstraintBehaviour
Warning,
  folderVal :: Int
folderVal = Int
5
}