-- | 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.Code.Imperative.DrasilState (GenState, DrasilState(..), 
  inMod)
import Language.Drasil.Chunk.Code (CodeIdea(codeName), quantvar)
import Language.Drasil.Choices (ImplementationType(..), InputModule(..), 
  Structure(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Mod (Description)

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 [Description] -> GenState Description
modDesc = ([Description] -> Description)
-> GenState [Description] -> GenState Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Description -> Description -> Description
forall a. [a] -> [a] -> [a]
(++) "Provides " (Description -> Description)
-> ([Description] -> Description) -> [Description] -> Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Description] -> Description
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 Description
unmodularDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let n :: Description
n = CodeSpec -> Description
pName (CodeSpec -> Description) -> CodeSpec -> Description
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      getDesc :: ImplementationType -> Description
getDesc Library = "library"
      getDesc Program = "program"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ "Contains the entire " Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ Description
n Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ " " Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ ImplementationType -> Description
getDesc (DrasilState -> ImplementationType
implType DrasilState
g)

-- | 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 [Description]
inputParametersDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Description
ifDesc <- GenState Description
inputFormatDesc
  Description
dvDesc <- GenState Description
derivedValuesDesc
  Description
icDesc <- GenState Description
inputConstraintsDesc
  let im :: InputModule
im = DrasilState -> InputModule
inMod DrasilState
g
      st :: Structure
st = DrasilState -> Structure
inStruct DrasilState
g
      ipDesc :: InputModule -> [Description]
ipDesc Separated = Structure -> [Description]
inDesc Structure
st
      ipDesc Combined = Structure -> [Description]
inDesc Structure
st [Description] -> [Description] -> [Description]
forall a. [a] -> [a] -> [a]
++ [Description
ifDesc, Description
dvDesc, Description
icDesc]
      inDesc :: Structure -> [Description]
inDesc Bundled = ["the structure for holding input values"]
      inDesc Unbundled = [""]
  [Description] -> GenState [Description]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Description] -> GenState [Description])
-> [Description] -> GenState [Description]
forall a b. (a -> b) -> a -> b
$ InputModule -> [Description]
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 Description
inputConstructorDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Description
pAndS <- GenState Description
physAndSfwrCons
  let ifDesc :: Bool -> Description
ifDesc False = ""
      ifDesc True = "reading inputs"
      idDesc :: Bool -> Description
idDesc False = ""
      idDesc True = "calculating derived values"
      icDesc :: Bool -> Description
icDesc False = ""
      icDesc True = "checking " Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ Description
pAndS Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ " on the input"
      dl :: [Description]
dl = DrasilState -> [Description]
defList DrasilState
g
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ "Initializes input object by " Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ [Description] -> Description
stringList [ 
    Bool -> Description
ifDesc ("get_input" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Description]
dl),
    Bool -> Description
idDesc ("derived_values" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Description]
dl),
    Bool -> Description
icDesc ("input_constraints" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Description]
dl)]

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

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

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

-- | Returns a description of what is contained in the Constants module,
-- if it exists.
constModDesc :: GenState Description
constModDesc :: GenState Description
constModDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: Description
cname = "Constants"
      cDesc :: [a] -> Description
cDesc [] = ""
      cDesc _ = "the structure for holding constant values"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ [Const] -> Description
forall a. [a] -> Description
cDesc ([Const] -> Description) -> [Const] -> Description
forall a b. (a -> b) -> a -> b
$ (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Description -> Map Description Description -> Bool)
-> Map Description Description -> Description -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Description -> Map Description Description -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((Description -> Bool)
-> Map Description Description -> Map Description Description
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Description
cname Description -> Description -> Bool
forall a. Eq a => a -> a -> Bool
==) 
    (DrasilState -> Map Description Description
clsMap DrasilState
g)) (Description -> Bool) -> (Const -> Description) -> Const -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Description
forall c. CodeIdea c => c -> Description
codeName) (CodeSpec -> [Const]
constants (CodeSpec -> [Const]) -> CodeSpec -> [Const]
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 Description
outputFormatDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let ofDesc :: Bool -> Description
ofDesc False = ""
      ofDesc _ = "the function for writing outputs"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ Bool -> Description
ofDesc (Bool -> Description) -> Bool -> Description
forall a b. (a -> b) -> a -> b
$ "write_output" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Description]
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 Description
inputClassDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: Description
cname = "InputParameters"
      ipMap :: Map Description Description
ipMap = (Description -> Bool)
-> Map Description Description -> Map Description Description
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Description
cname Description -> Description -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map Description Description
clsMap DrasilState
g)
      inIPMap :: [Input] -> [Input]
inIPMap = (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Description -> Map Description Description -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`member` Map Description Description
ipMap) (Description -> Bool) -> (Input -> Description) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Description
forall c. CodeIdea c => c -> Description
codeName)
      inClassD :: Bool -> Description
inClassD True = ""
      inClassD _ = "Structure for holding the " Description -> Description -> Description
forall a. [a] -> [a] -> [a]
++ [Description] -> Description
stringList [
        [Input] -> Description
forall a. [a] -> Description
inPs ([Input] -> Description) -> [Input] -> Description
forall a b. (a -> b) -> a -> b
$ [Input] -> [Input]
inIPMap ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Input]
extInputs (CodeSpec -> [Input]) -> CodeSpec -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g,
        [Input] -> Description
forall a. [a] -> Description
dVs ([Input] -> Description) -> [Input] -> Description
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) => c -> Input
quantvar ([Const] -> [Input]) -> [Const] -> [Input]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Const]
derivedInputs (CodeSpec -> [Const]) -> CodeSpec -> [Const]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g,
        [Input] -> Description
forall a. [a] -> Description
cVs ([Input] -> Description) -> [Input] -> Description
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) => c -> Input
quantvar ([Const] -> [Input]) -> [Const] -> [Input]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Const]
constants (CodeSpec -> [Const]) -> CodeSpec -> [Const]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g]
      inPs :: [a] -> Description
inPs [] = ""
      inPs _ = "input values"
      dVs :: [a] -> Description
dVs [] = ""
      dVs _ = "derived values"
      cVs :: [a] -> Description
cVs [] = ""
      cVs _ = "constant values"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ Bool -> Description
inClassD (Bool -> Description) -> Bool -> Description
forall a b. (a -> b) -> a -> b
$ Map Description Description -> Bool
forall k a. Map k a -> Bool
Map.null Map Description Description
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 Description
constClassDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: Description
cname = "Constants"
      ccDesc :: [a] -> Description
ccDesc [] = ""
      ccDesc _ = "Structure for holding the constant values"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ [Const] -> Description
forall a. [a] -> Description
ccDesc ([Const] -> Description) -> [Const] -> Description
forall a b. (a -> b) -> a -> b
$ (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Description -> Map Description Description -> Bool)
-> Map Description Description -> Description -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Description -> Map Description Description -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((Description -> Bool)
-> Map Description Description -> Map Description Description
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Description
cname Description -> Description -> Bool
forall a. Eq a => a -> a -> Bool
==) 
    (DrasilState -> Map Description Description
clsMap DrasilState
g)) (Description -> Bool) -> (Const -> Description) -> Const -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Description
forall c. CodeIdea c => c -> Description
codeName) (CodeSpec -> [Const]
constants (CodeSpec -> [Const]) -> CodeSpec -> [Const]
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 Description
inFmtFuncDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let ifDesc :: Bool -> Description
ifDesc False = ""
      ifDesc _ = "Reads input from a file with the given file name"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ Bool -> Description
ifDesc (Bool -> Description) -> Bool -> Description
forall a b. (a -> b) -> a -> b
$ "get_input" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Description]
defList DrasilState
g

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

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

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

-- | Returns description for generated output-printing function, if it exists.
woFuncDesc :: GenState Description
woFuncDesc :: GenState Description
woFuncDesc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let woDesc :: Bool -> Description
woDesc False = ""
      woDesc _ = "Writes the output values to output.txt"
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ Bool -> Description
woDesc (Bool -> Description) -> Bool -> Description
forall a b. (a -> b) -> a -> b
$ "write_output" Description -> [Description] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Description]
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 Description
physAndSfwrCons = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cns :: [ConstraintCE]
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` (CodeSpec -> Map UID [ConstraintCE]
cMap (CodeSpec -> Map UID [ConstraintCE])
-> CodeSpec -> Map UID [ConstraintCE]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) (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 => Lens' c UID
uid)) 
        (CodeSpec -> [Input]
inputs (CodeSpec -> [Input]) -> CodeSpec -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
  Description -> GenState Description
forall (m :: * -> *) a. Monad m => a -> m a
return (Description -> GenState Description)
-> Description -> GenState Description
forall a b. (a -> b) -> a -> b
$ [Description] -> Description
stringList [
    if Bool -> Bool
not ((ConstraintCE -> Bool) -> [ConstraintCE] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ConstraintCE -> Bool
forall e. Constraint e -> Bool
isPhysC [ConstraintCE]
cns) then "" else "physical constraints",
    if Bool -> Bool
not ((ConstraintCE -> Bool) -> [ConstraintCE] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ConstraintCE -> Bool
forall e. Constraint e -> Bool
isSfwrC [ConstraintCE]
cns) then "" else "software constraints"]