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

import Language.Drasil (Space(..), abrv)
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 [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
genCodeWithChoices (c :: Choices
c:cs :: [Choices]
cs) = 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 (SystemInformation -> [Char]
getSysName SystemInformation
fullSI) Choices
c
                                getSysName :: SystemInformation -> [Char]
getSysName SI{_sys :: ()
_sys = a
sysName} = a -> [Char]
forall c. CommonIdea c => c -> [Char]
abrv 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 n :: [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]
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 Unmodular = "U"
codedMod (Modular Combined) = "C"
codedMod (Modular Separated) = "S"

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

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

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

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

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

codedSpaceMatch :: SpaceMatch -> String
codedSpaceMatch :: SpaceMatch -> [Char]
codedSpaceMatch sm :: SpaceMatch
sm = case SpaceMatch
sm Space
Real of [Double, Float] -> "D"
                                     [Float, Double] -> "F" 
                                     _ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error 
                                       "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 ([(ConstQDef, [CodeConcept])] -> ConceptMatchMap
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] "log.txt")
      [[Char] -> AuxFile
SampleInput "../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME]
  },
  Choices
baseChoices {
    dataInfo :: DataInfo
dataInfo = Structure -> ConstantStructure -> ConstantRepr -> DataInfo
makeData Structure
Bundled ConstantStructure
WithInputs ConstantRepr
Var,
    maps :: Maps
maps = ConceptMatchMap -> SpaceMatch -> Maps
makeMaps ([(ConstQDef, [CodeConcept])] -> ConceptMatchMap
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] "log.txt")
      [[Char] -> AuxFile
SampleInput "../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME]
  }]

matchToFloats :: SpaceMatch
matchToFloats :: SpaceMatch
matchToFloats = [(Space, [CodeType])] -> SpaceMatch
matchSpaces ((Space -> (Space, [CodeType])) -> [Space] -> [(Space, [CodeType])]
forall a b. (a -> b) -> [a] -> [b]
map (,[CodeType
Float, CodeType
Double]) [Space
Real, Space
Radians, 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 ([(ConstQDef, [CodeConcept])] -> ConceptMatchMap
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 [] "log.txt")
    [[Char] -> AuxFile
SampleInput "../../../datafiles/projectile/sampleInput.txt", AuxFile
ReadME],
  srsConstraints :: Constraints
srsConstraints = ConstraintBehaviour -> ConstraintBehaviour -> Constraints
makeConstraints ConstraintBehaviour
Warning ConstraintBehaviour
Warning
}