-- | Defines concepts used in the field of software.
module Data.Drasil.Concepts.Software where

import Language.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Computation (algorithm, dataStruct, inParam)
import Data.Drasil.Concepts.Documentation (input_, physical, physicalConstraint,
  srs, softwareConstraint, quantity)
import Data.Drasil.Concepts.Math (equation)

-- * Common Software Concepts

-- | Collects all software-related concepts.
softwarecon :: [ConceptChunk]
softwarecon :: [ConceptChunk]
softwarecon = [ConceptChunk
correctness, ConceptChunk
verifiability, ConceptChunk
physLib,
  ConceptChunk
understandability, ConceptChunk
reusability, ConceptChunk
maintainability, ConceptChunk
portability,
  ConceptChunk
performance, ConceptChunk
program, ConceptChunk
errMsg, ConceptChunk
accuracy, ConceptChunk
correctness, ConceptChunk
reliability]

c, errMsg, physLib, program :: ConceptChunk

c :: ConceptChunk
c       = String -> NP -> String -> ConceptChunk
dcc "c" (String -> NP
pn "C") 
  "the C programming language"
physLib :: ConceptChunk
physLib = String -> NP -> String -> ConceptChunk
dcc "physLib" (String -> NP
cnIES "physics library") 
  "a programming library which provides functions for modelling physical phenomenon"
program :: ConceptChunk
program = String -> NP -> String -> ConceptChunk
dcc "program" (String -> NP
cn' "program")
  "a series of coded software instructions to control the operation of a computer or other machine"
errMsg :: ConceptChunk
errMsg  = String -> NP -> String -> ConceptChunk
dcc "errMsg" (String -> NP
cn' "error message") 
  "a message that indicates an incorrect instruction has been given, or that there is an error resulting from faulty software"

-- * Non-functional Requirements 

accuracy, correctness, maintainability, performance, performanceSpd, portability,
  reliability, reusability, understandability, verifiability :: ConceptChunk

qualOfBeing :: String -> String
qualOfBeing :: String -> String
qualOfBeing s :: String
s = "the quality or state of being" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  
accuracy :: ConceptChunk
accuracy          = String -> NP -> String -> ConceptChunk
dcc "accuracy"          (String -> NP
nounPhraseSP "accuracy")
  (String -> ConceptChunk) -> String -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ String -> String
qualOfBeing "correct or precise"

correctness :: ConceptChunk
correctness       = String -> NP -> String -> ConceptChunk
dcc "correctness"       (String -> NP
nounPhraseSP "correctness")
  (String -> ConceptChunk) -> String -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ String -> String
qualOfBeing "free from error"
  
maintainability :: ConceptChunk
maintainability   = String -> NP -> String -> ConceptChunk
dcc "maintainability"   (String -> NP
nounPhraseSP "maintainability")
  "the probability of performing a successful repair action within a given time"

performance :: ConceptChunk
performance       = String -> NP -> String -> ConceptChunk
dcc "performance"       (String -> NP
nounPhraseSP "performance")
  "the action or process of carrying out or accomplishing an action, task, or function"

performanceSpd :: ConceptChunk
performanceSpd    = String -> NP -> String -> ConceptChunk
dcc "performanceSpd"    (String -> NP
cn' "performance speed")
  "the action or process of carrying out or accomplishing an action, task, or function quickly"
 
portability :: ConceptChunk
portability       = String -> NP -> String -> ConceptChunk
dcc "portability"       (String -> NP
nounPhraseSP "portability")
  "the ability of software to be transferred from one machine or system to another"

reliability :: ConceptChunk
reliability       = String -> NP -> String -> ConceptChunk
dcc "reliability"       (String -> NP
nounPhraseSP "reliability")
  ("the degree to which the result of a measurement, calculation," String -> String -> String
forall a. [a] -> [a] -> [a]
++
  "or specification can be depended on to be accurate")

reusability :: ConceptChunk
reusability       = String -> NP -> String -> ConceptChunk
dcc "reusability"       (String -> NP
nounPhraseSP "reusability")
  "the use of existing assets in some form within the software product development process"

understandability :: ConceptChunk
understandability = String -> NP -> String -> ConceptChunk
dcc "understandability" (String -> NP
nounPhraseSP "understandability")
  (String -> ConceptChunk) -> String -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ String -> String
qualOfBeing "understandable"

verifiability :: ConceptChunk
verifiability     = String -> NP -> String -> ConceptChunk
dcc "verifiability"     (String -> NP
nounPhraseSP "verifiability")
  (String -> ConceptChunk) -> String -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ String -> String
qualOfBeing "capable of being verified, confirmed, or substantiated"

-- * Module Concepts

-- MODULES Concepts (Maybe move to D.D.C.Software.Modules ?)

--FIXME: "hiding" is not a noun.
hwHiding :: ConceptChunk
hwHiding :: ConceptChunk
hwHiding = String -> NP -> String -> ConceptChunk
dcc "hwHiding" (String -> NP
cn "hardware hiding")
  ("hides the exact details of the hardware, and provides a uniform interface" String -> String -> String
forall a. [a] -> [a] -> [a]
++
   " for the rest of the system to use")

modBehavHiding :: ConceptChunk
modBehavHiding :: ConceptChunk
modBehavHiding = String -> NP -> Sentence -> ConceptChunk
dccWDS "modBehavHiding" (String -> NP
cn "behaviour hiding") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "includes programs that provide externally visible behaviour of the", 
   String -> Sentence
S "system as specified in the", CI -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase CI
srs, Sentence -> Sentence
sParen (Sentence -> Sentence) -> Sentence -> Sentence
forall a b. (a -> b) -> a -> b
$ CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
srs Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S "documents",
   String -> Sentence
S "This module serves as a communication layer between the hardware-hiding module",
   String -> Sentence
S "and the software decision module. The programs in this module will need",
   String -> Sentence
S "to change if there are changes in the", CI -> Sentence
forall c. (Idea c, HasUID c) => c -> Sentence
short CI
srs])

modControl :: ConceptChunk
modControl :: ConceptChunk
modControl = String -> NP -> String -> ConceptChunk
dcc "modControl" (String -> NP
cn' "control module") "provides the main program"

modSfwrDecision :: ConceptChunk
modSfwrDecision :: ConceptChunk
modSfwrDecision = String -> NP -> Sentence -> ConceptChunk
dccWDS "modSfwrDecision" (String -> NP
cn' "software decision module") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "includes", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
dataStruct Sentence -> Sentence -> Sentence
`S.and_` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
algorithm,
   String -> Sentence
S "used in the system that do not provide direct interaction with the user"])

modInputFormat :: ConceptChunk
modInputFormat :: ConceptChunk
modInputFormat = String -> NP -> String -> ConceptChunk
dcc "modInputFormat" (String -> NP
cn' "input format module")
  "converts the input data into the data structure used by the input parameters module"
  
modInputParam :: ConceptChunk
modInputParam :: ConceptChunk
modInputParam = String -> NP -> Sentence -> ConceptChunk
dccWDS "modInputParam" (String -> NP
cn' "input parameter module") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "stores the parameters needed for the program, including" Sentence -> Sentence -> Sentence
+:+. SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
   [String -> Sentence
S "material properties", String -> Sentence
S "processing conditions", String -> Sentence
S "numerical parameters"],
   String -> Sentence
S "The values can be read as needed. This module knows how many parameters it stores"])

modInputConstraint :: ConceptChunk
modInputConstraint :: ConceptChunk
modInputConstraint = String -> NP -> String -> ConceptChunk
dcc "modInputConstraint" (String -> NP
cn' "input constraint module") 
  ("defines the constraints on the input data and gives an error if " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   "a constraint is violated")

modInputVerif :: ConceptChunk
modInputVerif :: ConceptChunk
modInputVerif = String -> NP -> Sentence -> ConceptChunk
dccWDS "modInputVerif" (String -> NP
cn' "input verification module") ([Sentence] -> Sentence
foldlSent
  [String -> Sentence
S "verifies that the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
inParam, String -> Sentence
S "comply with", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physical Sentence -> Sentence -> Sentence
`S.and_`
   NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
softwareConstraint, String -> Sentence
S "Throws an error if a parameter violates a" Sentence -> Sentence -> Sentence
+:+.
   NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
physicalConstraint, String -> Sentence
S "Throws a warning if a parameter violates a",
   NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
softwareConstraint])

modDerivedVal :: ConceptChunk
modDerivedVal :: ConceptChunk
modDerivedVal = String -> NP -> Sentence -> ConceptChunk
dccWDS "modDerivedVal" (String -> NP
cn' "derived value module") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "defines the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S "transforming the initial", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
input_,
   String -> Sentence
S "into derived", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
quantity])

modInterpolation :: ConceptChunk
modInterpolation :: ConceptChunk
modInterpolation = String -> NP -> Sentence -> ConceptChunk
dccWDS "modInterpolation" (String -> NP
cn "interpolation module") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "provides the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S "that take the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
plural NamedChunk
inParam Sentence -> Sentence -> Sentence
`S.and_`
   String -> Sentence
S "interpolation data" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S "return an interpolated value"])

modInterpDatum :: ConceptChunk
modInterpDatum :: ConceptChunk
modInterpDatum = String -> NP -> Sentence -> ConceptChunk
dccWDS "modInterpDatum" (String -> NP
cn "interpolation datum module") ([Sentence] -> Sentence
foldlSent_
  [String -> Sentence
S "converts the input interpolation data into the", NamedChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase NamedChunk
dataStruct,
   String -> Sentence
S "used by the", ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
modInterpolation])

{-- Concept Chunks for Modules  --}

modSeqServ :: ConceptChunk
modSeqServ :: ConceptChunk
modSeqServ = String -> NP -> Sentence -> ConceptChunk
dccWDS "modSeqServ" (String -> NP
cn' "sequence data structure")
  (String -> Sentence
S "Provides array manipulation operations, such as" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
   [String -> Sentence
S "building an array", String -> Sentence
S "accessing a specific entry", String -> Sentence
S "slicing an array"])

modLinkedServ :: ConceptChunk
modLinkedServ :: ConceptChunk
modLinkedServ = String -> NP -> Sentence -> ConceptChunk
dccWDS "modLinkedServ" (String -> NP
cn' "linked data structure")
  (String -> Sentence
S "Provides tree manipulation operations, such as" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
   [String -> Sentence
S "building a tree", String -> Sentence
S "accessing a specific entry"])

modAssocServ :: ConceptChunk
modAssocServ :: ConceptChunk
modAssocServ = String -> NP -> Sentence -> ConceptChunk
dccWDS "modAssocServ" (String -> NP
cn' "associative data structure")
  (String -> Sentence
S "Provides operations on hash tables, such as" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
   [String -> Sentence
S "building a hash table", String -> Sentence
S "accessing a specific entry"])

modVectorServ :: ConceptChunk
modVectorServ :: ConceptChunk
modVectorServ = String -> NP -> Sentence -> ConceptChunk
dccWDS "modVectorServ" (String -> NP
cn' "vector")
  (String -> Sentence
S "Provides vector operations such as" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [String -> Sentence
S "addition",
   String -> Sentence
S "scalar and vector multiplication", String -> Sentence
S "dot and cross products", String -> Sentence
S "rotations"])
  
modPlotDesc :: ConceptChunk
modPlotDesc :: ConceptChunk
modPlotDesc = String -> NP -> String -> ConceptChunk
dcc "modPlotDesc" (String -> NP
cn' "plotting") "provides a plot function"

modOutputfDescFun :: Sentence -> ConceptChunk
modOutputfDescFun :: Sentence -> ConceptChunk
modOutputfDescFun desc :: Sentence
desc = String -> NP -> Sentence -> ConceptChunk
dccWDS "modOutputfDescFun" (String -> NP
cn' "output format")
  (String -> Sentence
S "outputs the results of the calculations, including the" Sentence -> Sentence -> Sentence
+:+ Sentence
desc)

-- ODE Solver Module
modOdeDesc :: ConceptChunk
modOdeDesc :: ConceptChunk
modOdeDesc = String -> NP -> Sentence -> ConceptChunk
dccWDS "modOdeDesc" (String -> NP
nounPhraseSP "ODE solver")
  (String -> Sentence
S "provides solvers that take the" Sentence -> Sentence -> Sentence
+:+ SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
   [String -> Sentence
S "governing equation", String -> Sentence
S "initial conditions", String -> Sentence
S "numerical parameters"] Sentence -> Sentence -> Sentence
`S.and_`
   String -> Sentence
S "solve them")