-- | 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 Control.Lens ((^.))
import Control.Monad.State (get)
import Data.Map (member)
import qualified Data.Map as Map (filter, lookup, null)
import Data.Maybe (mapMaybe)

import Drasil.Database (HasUID(..))
import Language.Drasil
import Drasil.System (purpose)
import Utils.Drasil (stringList)

import Drasil.Code.CodeVar (CodeIdea(..), quantvar)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  genICName, HasChoices(..))
import Language.Drasil.Choices (ImplementationType(..), Structure(..),
  InternalConcept(..))
import Language.Drasil.CodeSpec (HasCodeSpec(..))
import Language.Drasil.Mod (Description)
import Language.Drasil.Printers (oneLineSentenceDoc)

-- | Returns a module description based on a list of descriptions of what is
-- contained in the module.
modDesc :: GenState [Description] -> GenState Description
modDesc :: GenState [Name] -> GenState Name
modDesc = ([Name] -> Name) -> GenState [Name] -> GenState Name
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Name -> Name
forall a. [a] -> [a] -> [a]
(++) Name
"Provides " (Name -> Name) -> ([Name] -> Name) -> [Name] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Name
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 Name
unmodularDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let implTypeStr ImplementationType
Program = Name
"program"
      implTypeStr ImplementationType
Library = Name
"library"
  return $ show $ oneLineSentenceDoc (printfo g) $ capSent $ foldlSent
      ([S "a", S (implTypeStr (g ^. implType)), S "to"] ++ g ^. purpose)

-- | 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'.
-- This module includes the input-related functions.
inputParametersDesc :: GenState [Description]
inputParametersDesc :: GenState [Name]
inputParametersDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  ifDesc <- inputFormatDesc
  dvDesc <- derivedValuesDesc
  icDesc <- inputConstraintsDesc
  let st = DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct
      ipDesc = Structure -> [Name]
inDesc Structure
st [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name
ifDesc, Name
dvDesc, Name
icDesc]
      inDesc Structure
Bundled = [Name
"the structure for holding input values"]
      inDesc Structure
Unbundled = [Name
""]
  return ipDesc

-- | 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 Name
inputConstructorDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  pAndS <- physAndSfwrCons
  giName <- genICName GetInput
  dvName <- genICName DerivedValuesFn
  icName <- genICName InputConstraintsFn
  let ifDesc Bool
False = Name
""
      ifDesc Bool
True = Name
"reading inputs"
      idDesc Bool
False = Name
""
      idDesc Bool
True = Name
"calculating derived values"
      icDesc Bool
False = Name
""
      icDesc Bool
True = Name
"checking " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
pAndS Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" on the input"
      ds = DrasilState -> Set Name
defSet DrasilState
g
  return $ "Initializes input object by " ++ stringList [
    ifDesc (giName `elem` ds),
    idDesc (dvName `elem` ds),
    icDesc (icName `elem` ds)]

-- | Returns a description of what is contained in the Input Format module,
-- if it exists.
inputFormatDesc :: GenState Description
inputFormatDesc :: GenState Name
inputFormatDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  giName <- genICName GetInput
  let ifDesc Bool
False = Name
""
      ifDesc Bool
_ = Name
"the function for reading inputs"
  return $ ifDesc $ giName `elem` defSet g

-- | Returns a description of what is contained in the Derived Values module,
-- if it exists.
derivedValuesDesc :: GenState Description
derivedValuesDesc :: GenState Name
derivedValuesDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  dvName <- genICName DerivedValuesFn
  let dvDesc Bool
False = Name
""
      dvDesc Bool
_ = Name
"the function for calculating derived values"
  return $ dvDesc $ dvName `elem` defSet g

-- | Returns a description of what is contained in the Input Constraints
-- module, if it exists.
inputConstraintsDesc :: GenState Description
inputConstraintsDesc :: GenState Name
inputConstraintsDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  icName <- genICName InputConstraintsFn
  pAndS <- physAndSfwrCons
  let icDesc Bool
False = Name
""
      icDesc Bool
_ = Name
"the function for checking the " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
pAndS Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
        Name
" on the input"
  return $ icDesc $ icName `elem` defSet g

-- | Returns a description of what is contained in the Constants module,
-- if it exists.
constModDesc :: GenState Description
constModDesc :: GenState Name
constModDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cname <- genICName Constants
  let cDesc [] = Name
""
      cDesc [a]
_ = Name
"the structure for holding constant values"
  return $ cDesc $ filter (flip member (Map.filter (cname ==)
    (clsMap g)) . codeName) (g ^. constDefns)

-- | Returns a description of what is contained in the Output Format module,
-- if it exists.
outputFormatDesc :: GenState Description
outputFormatDesc :: GenState Name
outputFormatDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  woName <- genICName WriteOutput
  let ofDesc Bool
False = Name
""
      ofDesc Bool
_ = Name
"the function for writing outputs"
  return $ ofDesc $ woName `elem` defSet 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 Name
inputClassDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cname <- genICName InputParameters
  let ipMap = (Name -> Bool) -> Map Name Name -> Map Name Name
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Name
cname Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map Name Name
clsMap DrasilState
g)
      inIPMap = (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> Map Name Name -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`member` Map Name Name
ipMap) (Name -> Bool) -> (Input -> Name) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Name
forall c. CodeIdea c => c -> Name
codeName)
      inClassD Bool
True = Name
""
      inClassD Bool
_ = Name
"Structure for holding the " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ [Name] -> Name
stringList [
        [Input] -> Name
forall {a}. [a] -> Name
inPs ([Input] -> Name) -> [Input] -> Name
forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
extInputs,
        [Input] -> Name
forall {a}. [a] -> Name
dVs ([Input] -> Name) -> [Input] -> Name
forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (Const -> Input) -> [Const] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar ([Const] -> [Input]) -> [Const] -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
derivedInputs,
        [Input] -> Name
forall {a}. [a] -> Name
cVs ([Input] -> Name) -> [Input] -> Name
forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (Const -> Input) -> [Const] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar ([Const] -> [Input]) -> [Const] -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns]
      inPs [] = Name
""
      inPs [a]
_ = Name
"input values"
      dVs [] = Name
""
      dVs [a]
_ = Name
"derived values"
      cVs [] = Name
""
      cVs [a]
_ = Name
"constant values"
  return $ inClassD $ Map.null 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 Name
constClassDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cname <- genICName Constants
  let ccDesc [] = Name
""
      ccDesc [a]
_ = Name
"Structure for holding the constant values"
  return $ ccDesc $ filter (flip member (Map.filter (cname ==)
    (clsMap g)) . codeName) (g ^. constDefns)

-- | Returns a description for the generated function that reads input from a
-- file, if it exists.
inFmtFuncDesc :: GenState Description
inFmtFuncDesc :: GenState Name
inFmtFuncDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  giName <- genICName GetInput
  let ifDesc Bool
False = Name
""
      ifDesc Bool
_ = Name
"Reads input from a file with the given file name"
  return $ ifDesc $ giName `elem` defSet g

-- | Returns a description for the generated function that checks input
-- constraints, if it exists.
inConsFuncDesc :: GenState Description
inConsFuncDesc :: GenState Name
inConsFuncDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  icName <- genICName InputConstraintsFn
  pAndS <- physAndSfwrCons
  let icDesc Bool
False = Name
""
      icDesc Bool
_ = Name
"Verifies that input values satisfy the " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
pAndS
  return $ icDesc $ icName `elem` defSet g

-- | Returns a description for the generated function that calculates derived
-- inputs, if it exists.
dvFuncDesc :: GenState Description
dvFuncDesc :: GenState Name
dvFuncDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  dvName <- genICName DerivedValuesFn
  let dvDesc Bool
False = Name
""
      dvDesc Bool
_ = Name
"Calculates values that can be immediately derived from the"
        Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" inputs"
  return $ dvDesc $ dvName `elem` defSet g

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

-- | Returns description for generated output-printing function, if it exists.
woFuncDesc :: GenState Description
woFuncDesc :: GenState Name
woFuncDesc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  woName <- genICName WriteOutput
  let woDesc Bool
False = Name
""
      woDesc Bool
_ = Name
"Writes the output values to output.txt"
  return $ woDesc $ woName `elem` defSet 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 Name
physAndSfwrCons = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cns = [[ConstraintCE]] -> [ConstraintCE]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ConstraintCE]] -> [ConstraintCE])
-> [[ConstraintCE]] -> [ConstraintCE]
forall a b. (a -> b) -> a -> b
$ (Input -> Maybe [ConstraintCE]) -> [Input] -> [[ConstraintCE]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((UID -> Map UID [ConstraintCE] -> Maybe [ConstraintCE]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` (DrasilState
g DrasilState
-> Getting
     (Map UID [ConstraintCE]) DrasilState (Map UID [ConstraintCE])
-> Map UID [ConstraintCE]
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID [ConstraintCE]) DrasilState (Map UID [ConstraintCE])
forall c. HasCodeSpec c => Lens' c (Map UID [ConstraintCE])
Lens' DrasilState (Map UID [ConstraintCE])
cMap)) (UID -> Maybe [ConstraintCE])
-> (Input -> UID) -> Input -> Maybe [ConstraintCE]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> Getting UID Input UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Input UID
forall c. HasUID c => Getter c UID
Getter Input UID
uid))
        (DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
inputs)
  return $ stringList [
    if not (any isPhysC cns) then "" else "physical constraints",
    if not (any isSfwrC cns) then "" else "software constraints"]