-- | Defines description generators for common SCS functions, classes, and
-- modules.
module Language.Drasil.Code.Imperative.Descriptions (
  modDesc, unmodularDesc, inputParametersDesc, inputConstructorDesc,
  inputFormatDesc, derivedValuesDesc, inputConstraintsDesc, constModDesc,
  outputFormatDesc, inputClassDesc, constClassDesc, inFmtFuncDesc,
  inConsFuncDesc, dvFuncDesc, calcModDesc, woFuncDesc
) where

import Utils.Drasil (stringList)

import Language.Drasil
import Language.Drasil.Chunk.CodeBase
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  inMod)
import Language.Drasil.Choices (ImplementationType(..), InputModule(..),
  Structure(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Mod (Description)
import Language.Drasil.Printers (SingleLine(OneLine), sentenceDoc)

import Data.Map (member)
import qualified Data.Map as Map (filter, lookup, null)
import Data.Maybe (mapMaybe)
import Control.Lens ((^.))
import Control.Monad.State (get)

-- | Returns a module description based on a list of descriptions of what is
-- contained in the module.
modDesc :: GenState [Description] -> GenState Description
modDesc :: GenState [String] -> GenState String
modDesc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a] -> [a]
(++) String
"Provides " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
stringList)

-- | Returns description of what is contained in the module that is generated
-- when the user chooses an Unmodular design. Module is described as either a
-- program or library, depending on the user's choice of implementation type.
unmodularDesc :: GenState Description
unmodularDesc :: GenState String
unmodularDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let spec :: CodeSpec
spec = DrasilState -> CodeSpec
codeSpec DrasilState
g
      implTypeStr :: ImplementationType -> String
implTypeStr ImplementationType
Program = String
"program"
      implTypeStr ImplementationType
Library = String
"library"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (CodeSpec -> ChunkDB
sysinfodb CodeSpec
spec) Stage
Implementation SingleLine
OneLine forall a b. (a -> b) -> a -> b
$ Sentence -> Sentence
capSent forall a b. (a -> b) -> a -> b
$
    [Sentence] -> Sentence
foldlSent ([String -> Sentence
S String
"a", String -> Sentence
S (ImplementationType -> String
implTypeStr (DrasilState -> ImplementationType
implType DrasilState
g)), String -> Sentence
S String
"to"] forall a. [a] -> [a] -> [a]
++ CodeSpec -> [Sentence]
purpose CodeSpec
spec)

-- | Returns description of what is contained in the Input Parameters module.
-- If user chooses the 'Bundled' input parameter, this module will include the structure for holding the
-- input values. Does not include the structure if they choose 'Unbundled'.
-- If the user chooses the 'Combined' input parameter, this module includes the input-related functions.
-- Does not inlcude those functions if they choose 'Separated'.
inputParametersDesc :: GenState [Description]
inputParametersDesc :: GenState [String]
inputParametersDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  String
ifDesc <- GenState String
inputFormatDesc
  String
dvDesc <- GenState String
derivedValuesDesc
  String
icDesc <- GenState String
inputConstraintsDesc
  let im :: InputModule
im = DrasilState -> InputModule
inMod DrasilState
g
      st :: Structure
st = DrasilState -> Structure
inStruct DrasilState
g
      ipDesc :: InputModule -> [String]
ipDesc InputModule
Separated = Structure -> [String]
inDesc Structure
st
      ipDesc InputModule
Combined = Structure -> [String]
inDesc Structure
st forall a. [a] -> [a] -> [a]
++ [String
ifDesc, String
dvDesc, String
icDesc]
      inDesc :: Structure -> [String]
inDesc Structure
Bundled = [String
"the structure for holding input values"]
      inDesc Structure
Unbundled = [String
""]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InputModule -> [String]
ipDesc InputModule
im

-- | Returns a description of the input constructor, checking whether each
-- possible method that may be called by the constructor is defined, and
-- including it in the description if so.
inputConstructorDesc :: GenState Description
inputConstructorDesc :: GenState String
inputConstructorDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  String
pAndS <- GenState String
physAndSfwrCons
  let ifDesc :: Bool -> String
ifDesc Bool
False = String
""
      ifDesc Bool
True = String
"reading inputs"
      idDesc :: Bool -> String
idDesc Bool
False = String
""
      idDesc Bool
True = String
"calculating derived values"
      icDesc :: Bool -> String
icDesc Bool
False = String
""
      icDesc Bool
True = String
"checking " forall a. [a] -> [a] -> [a]
++ String
pAndS forall a. [a] -> [a] -> [a]
++ String
" on the input"
      dl :: [String]
dl = DrasilState -> [String]
defList DrasilState
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"Initializes input object by " forall a. [a] -> [a] -> [a]
++ [String] -> String
stringList [
    Bool -> String
ifDesc (String
"get_input" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
dl),
    Bool -> String
idDesc (String
"derived_values" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
dl),
    Bool -> String
icDesc (String
"input_constraints" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
dl)]

-- | Returns a description of what is contained in the Input Format module,
-- if it exists.
inputFormatDesc :: GenState Description
inputFormatDesc :: GenState String
inputFormatDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let ifDesc :: Bool -> String
ifDesc Bool
False = String
""
      ifDesc Bool
_ = String
"the function for reading inputs"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
ifDesc forall a b. (a -> b) -> a -> b
$ String
"get_input" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description of what is contained in the Derived Values module,
-- if it exists.
derivedValuesDesc :: GenState Description
derivedValuesDesc :: GenState String
derivedValuesDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let dvDesc :: Bool -> String
dvDesc Bool
False = String
""
      dvDesc Bool
_ = String
"the function for calculating derived values"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
dvDesc forall a b. (a -> b) -> a -> b
$ String
"derived_values" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description of what is contained in the Input Constraints module,
-- if it exists.
inputConstraintsDesc :: GenState Description
inputConstraintsDesc :: GenState String
inputConstraintsDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  String
pAndS <- GenState String
physAndSfwrCons
  let icDesc :: Bool -> String
icDesc Bool
False = String
""
      icDesc Bool
_ = String
"the function for checking the " forall a. [a] -> [a] -> [a]
++ String
pAndS forall a. [a] -> [a] -> [a]
++
        String
" on the input"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
icDesc forall a b. (a -> b) -> a -> b
$ String
"input_constraints" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description of what is contained in the Constants module,
-- if it exists.
constModDesc :: GenState Description
constModDesc :: GenState String
constModDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: String
cname = String
"Constants"
      cDesc :: [a] -> String
cDesc [] = String
""
      cDesc [a]
_ = String
"the structure for holding constant values"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> String
cDesc forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
member (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cname forall a. Eq a => a -> a -> Bool
==)
    (DrasilState -> ClassDefinitionMap
clsMap DrasilState
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
codeName) (CodeSpec -> [Const]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)

-- | Returns a description of what is contained in the Output Format module,
-- if it exists.
outputFormatDesc :: GenState Description
outputFormatDesc :: GenState String
outputFormatDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let ofDesc :: Bool -> String
ofDesc Bool
False = String
""
      ofDesc Bool
_ = String
"the function for writing outputs"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
ofDesc forall a b. (a -> b) -> a -> b
$ String
"write_output" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description for the generated function that stores inputs,
-- if it exists. Checks whether explicit inputs, derived inputs, and constants
-- are defined in the InputParameters class and includes each in the
-- description if so.
inputClassDesc :: GenState Description
inputClassDesc :: GenState String
inputClassDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: String
cname = String
"InputParameters"
      ipMap :: ClassDefinitionMap
ipMap = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cname forall a. Eq a => a -> a -> Bool
==) (DrasilState -> ClassDefinitionMap
clsMap DrasilState
g)
      inIPMap :: [Input] -> [Input]
inIPMap = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall k a. Ord k => k -> Map k a -> Bool
`member` ClassDefinitionMap
ipMap) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
codeName)
      inClassD :: Bool -> String
inClassD Bool
True = String
""
      inClassD Bool
_ = String
"Structure for holding the " forall a. [a] -> [a] -> [a]
++ [String] -> String
stringList [
        forall {a}. [a] -> String
inPs forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Input]
extInputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g,
        forall {a}. [a] -> String
dVs forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Const]
derivedInputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g,
        forall {a}. [a] -> String
cVs forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Const]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g]
      inPs :: [a] -> String
inPs [] = String
""
      inPs [a]
_ = String
"input values"
      dVs :: [a] -> String
dVs [] = String
""
      dVs [a]
_ = String
"derived values"
      cVs :: [a] -> String
cVs [] = String
""
      cVs [a]
_ = String
"constant values"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
inClassD forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Bool
Map.null ClassDefinitionMap
ipMap

-- | Returns a description for the generated class that stores constants,
-- if it exists. If no constants are defined in the Constants class, then it
-- does not exist and an empty description is returned.
constClassDesc :: GenState Description
constClassDesc :: GenState String
constClassDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: String
cname = String
"Constants"
      ccDesc :: [a] -> String
ccDesc [] = String
""
      ccDesc [a]
_ = String
"Structure for holding the constant values"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> String
ccDesc forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
member (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cname forall a. Eq a => a -> a -> Bool
==)
    (DrasilState -> ClassDefinitionMap
clsMap DrasilState
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
codeName) (CodeSpec -> [Const]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)

-- | Returns a description for the generated function that reads input from a file,
-- if it exists.
inFmtFuncDesc :: GenState Description
inFmtFuncDesc :: GenState String
inFmtFuncDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let ifDesc :: Bool -> String
ifDesc Bool
False = String
""
      ifDesc Bool
_ = String
"Reads input from a file with the given file name"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
ifDesc forall a b. (a -> b) -> a -> b
$ String
"get_input" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description for the generated function that checks input constraints,
-- if it exists.
inConsFuncDesc :: GenState Description
inConsFuncDesc :: GenState String
inConsFuncDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  String
pAndS <- GenState String
physAndSfwrCons
  let icDesc :: Bool -> String
icDesc Bool
False = String
""
      icDesc Bool
_ = String
"Verifies that input values satisfy the " forall a. [a] -> [a] -> [a]
++ String
pAndS
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
icDesc forall a b. (a -> b) -> a -> b
$ String
"input_constraints" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns a description for the generated function that calculates derived inputs,
-- if it exists.
dvFuncDesc :: GenState Description
dvFuncDesc :: GenState String
dvFuncDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let dvDesc :: Bool -> String
dvDesc Bool
False = String
""
      dvDesc Bool
_ = String
"Calculates values that can be immediately derived from the" forall a. [a] -> [a] -> [a]
++
        String
" inputs"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
dvDesc forall a b. (a -> b) -> a -> b
$ String
"derived_values" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Description of the generated Calculations module.
calcModDesc :: Description
calcModDesc :: String
calcModDesc = String
"Provides functions for calculating the outputs"

-- | Returns description for generated output-printing function, if it exists.
woFuncDesc :: GenState Description
woFuncDesc :: GenState String
woFuncDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let woDesc :: Bool -> String
woDesc Bool
False = String
""
      woDesc Bool
_ = String
"Writes the output values to output.txt"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> String
woDesc forall a b. (a -> b) -> a -> b
$ String
"write_output" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g

-- | Returns the phrase "physical constraints" if there are any physical
-- constraints on the input and "software constraints" if there are any
-- software constraints on the input. If there are both,
-- "physical constraints and software constraints" is returned.
physAndSfwrCons :: GenState Description
physAndSfwrCons :: GenState String
physAndSfwrCons = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cns :: [ConstraintCE]
cns = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` (CodeSpec -> ConstraintCEMap
cMap forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid))
        (CodeSpec -> [Input]
inputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> String
stringList [
    if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall e. Constraint e -> Bool
isPhysC [ConstraintCE]
cns) then String
"" else String
"physical constraints",
    if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall e. Constraint e -> Bool
isSfwrC [ConstraintCE]
cns) then String
"" else String
"software constraints"]