{-# LANGUAGE PostfixOperators #-}
module Drasil.GamePhysics.Requirements (funcReqs, nonfuncReqs) where

import Language.Drasil hiding (organization)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import qualified Drasil.DocLang.SRS as SRS (solCharSpec)
import Drasil.DocLang (mkMaintainableNFR)
import Data.Drasil.Concepts.Documentation as Doc (body, funcReqDom, input_, 
  nonFuncReqDom, output_, physicalConstraint, physicalSim, property, solutionCharSpec)

import qualified Data.Drasil.Concepts.Physics as CP (collision, elasticity, 
  friction, rigidBody, space)
import qualified Data.Drasil.Concepts.Math as CM (surface)
import qualified Data.Drasil.Quantities.Math as QM (orientation)
import qualified Data.Drasil.Quantities.PhysicalProperties as QPP (mass)
import qualified Data.Drasil.Quantities.Physics as QP (angularVelocity, force, 
  position, time, velocity)

import Drasil.GamePhysics.Concepts (twoD)

------------------------------
-- SECTION 5 : REQUIREMENTS --
------------------------------

-----------------------------------
-- 5.1 : Functional Requirements --
-----------------------------------

-- Currently need separate chunks for plurals like rigid bodies,
-- velocities, etc.
funcReqs :: [ConceptInstance]
funcReqs :: [ConceptInstance]
funcReqs = [ConceptInstance
simSpace, ConceptInstance
inputInitialConds, ConceptInstance
inputSurfaceProps,
  ConceptInstance
verifyPhysCons, ConceptInstance
calcTransOverTime, ConceptInstance
calcRotOverTime, ConceptInstance
deterColls, ConceptInstance
deterCollRespOverTime]

simSpaceDesc, inputInitialCondsDesc, 
  inputSurfacePropsDesc, verifyPhysConsDesc,
  calcTransOverTimeDesc, calcRotOverTimeDesc,
  deterCollsDesc, deterCollRespOverTimeDesc :: Sentence

-- | template for requirements
requirementTemplate :: Sentence -> Sentence -> Sentence -> Sentence -> Sentence
requirementTemplate :: Sentence -> Sentence -> Sentence -> Sentence -> Sentence
requirementTemplate Sentence
a Sentence
b Sentence
x Sentence
z = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Determine the", Sentence
a Sentence -> Sentence -> Sentence
`S.and_` Sentence
b, 
  String -> Sentence
S String
"over a period of", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.time, String -> Sentence
S String
"of the", Sentence
x, Sentence
z]

-- | with added constraint
requirementS :: (NamedIdea a, NamedIdea b) => a -> b -> Sentence -> Sentence
requirementS :: forall a b.
(NamedIdea a, NamedIdea b) =>
a -> b -> Sentence -> Sentence
requirementS a
a b
b = Sentence -> Sentence -> Sentence -> Sentence -> Sentence
requirementTemplate (forall n. NamedIdea n => n -> Sentence
plural a
a) (forall n. NamedIdea n => n -> Sentence
plural b
b) (CI -> Sentence
getAcc CI
twoD
  Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
CP.rigidBody)

-- | without added constraint
requirementS' :: (NamedIdea a, NamedIdea b) => a -> b -> Sentence
requirementS' :: forall a b. (NamedIdea a, NamedIdea b) => a -> b -> Sentence
requirementS' a
a b
b = forall a b.
(NamedIdea a, NamedIdea b) =>
a -> b -> Sentence -> Sentence
requirementS a
a b
b Sentence
EmptyS 

-- some requirements look like they could be parametrized
simSpaceDesc :: Sentence
simSpaceDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Create a", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CP.space, String -> Sentence
S String
"for all of the",
  forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
CP.rigidBody forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThePS` IdeaDict
physicalSim), 
  String -> Sentence
S String
"to interact in"]

inputInitialCondsDesc :: Sentence
inputInitialCondsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Input the initial", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List
  [forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
QPP.mass, forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
QP.velocity, forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
QM.orientation,
  forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
QP.angularVelocity Sentence -> Sentence -> Sentence
`S.of_` Sentence
EmptyS, forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
QP.force Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"applied on"],
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
CP.rigidBody]

inputSurfacePropsDesc :: Sentence
inputSurfacePropsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Input", forall n. NounPhrase n => n -> Sentence
pluralNP (forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
combineNINI ConceptChunk
CM.surface
  IdeaDict
property) Sentence -> Sentence -> Sentence
`S.the_ofThe` forall n. NamedIdea n => n -> Sentence
plural IdeaDict
body, String -> Sentence
S String
"such as", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CP.friction Sentence -> Sentence -> Sentence
`S.or_`
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CP.elasticity]

verifyPhysConsDesc :: Sentence
verifyPhysConsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Verify that the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
input_,
  String -> Sentence
S String
"satisfy the required", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
physicalConstraint, String -> Sentence
S String
"from the", 
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.solCharSpec [] []) (forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
solutionCharSpec)]

calcTransOverTimeDesc :: Sentence
calcTransOverTimeDesc = forall a b.
(NamedIdea a, NamedIdea b) =>
a -> b -> Sentence -> Sentence
requirementS UnitalChunk
QP.position UnitalChunk
QP.velocity 
  (String -> Sentence
S String
"acted upon by a" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.force)

calcRotOverTimeDesc :: Sentence
calcRotOverTimeDesc = forall a b. (NamedIdea a, NamedIdea b) => a -> b -> Sentence
requirementS' UnitalChunk
QM.orientation UnitalChunk
QP.angularVelocity

deterCollsDesc :: Sentence
deterCollsDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"Determine if any of the", 
  forall n. NounPhrase n => n -> Sentence
pluralNP (ConceptChunk
CP.rigidBody forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`inThePS` ConceptChunk
CP.space), 
  String -> Sentence
S String
"have collided"]

deterCollRespOverTimeDesc :: Sentence
deterCollRespOverTimeDesc = forall a b.
(NamedIdea a, NamedIdea b) =>
a -> b -> Sentence -> Sentence
requirementS UnitalChunk
QP.position UnitalChunk
QP.velocity 
  (String -> Sentence
S String
"that have undergone a" Sentence -> Sentence -> Sentence
+:+ forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CP.collision)

simSpace, inputInitialConds, inputSurfaceProps, verifyPhysCons, calcTransOverTime,
  calcRotOverTime, deterColls, deterCollRespOverTime :: ConceptInstance

simSpace :: ConceptInstance
simSpace              = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"simSpace"              Sentence
simSpaceDesc              String
"Simulation-Space"                       ConceptChunk
funcReqDom
inputInitialConds :: ConceptInstance
inputInitialConds     = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"inputInitialConds"     Sentence
inputInitialCondsDesc     String
"Input-Initial-Conditions"               ConceptChunk
funcReqDom
inputSurfaceProps :: ConceptInstance
inputSurfaceProps     = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"inputSurfaceProps"     Sentence
inputSurfacePropsDesc     String
"Input-Surface-Properties"               ConceptChunk
funcReqDom
verifyPhysCons :: ConceptInstance
verifyPhysCons        = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"verifyPhysCons"        Sentence
verifyPhysConsDesc        String
"Verify-Physical_Constraints"            ConceptChunk
funcReqDom
calcTransOverTime :: ConceptInstance
calcTransOverTime     = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"calcTransOverTime"     Sentence
calcTransOverTimeDesc     String
"Calculate-Translation-Over-Time"        ConceptChunk
funcReqDom
calcRotOverTime :: ConceptInstance
calcRotOverTime       = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"calcRotOverTime"       Sentence
calcRotOverTimeDesc       String
"Calculate-Rotation-Over-Time"           ConceptChunk
funcReqDom
deterColls :: ConceptInstance
deterColls            = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"deterColls"            Sentence
deterCollsDesc            String
"Determine-Collisions"                   ConceptChunk
funcReqDom
deterCollRespOverTime :: ConceptInstance
deterCollRespOverTime = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"deterCollRespOverTime" Sentence
deterCollRespOverTimeDesc String
"Determine-Collision-Response-Over-Time" ConceptChunk
funcReqDom

--------------------------------------
-- 5.2 : Nonfunctional Requirements --
--------------------------------------

nonfuncReqs :: [ConceptInstance] 
nonfuncReqs :: [ConceptInstance]
nonfuncReqs = [ConceptInstance
performance, ConceptInstance
correctness, ConceptInstance
usability, ConceptInstance
understandability, ConceptInstance
maintainability]

performance :: ConceptInstance
performance :: ConceptInstance
performance = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"performance" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"The execution time for collision detection and collision resolution shall be", 
  String -> Sentence
S String
"comparable to an existing 2D physics library on the market (e.g. Pymunk)"
  ]) String
"Performance" ConceptChunk
nonFuncReqDom

correctness :: ConceptInstance
correctness :: ConceptInstance
correctness = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"correctness" ([Sentence] -> Sentence
foldlSent [
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
output_) Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"simulation results shall be compared to", 
  String -> Sentence
S String
"an existing implementation like Pymunk (please refer to:", 
  String -> Sentence
S String
"http://www.pymunk.org/en/latest/)"
  ]) String
"Correctness" ConceptChunk
nonFuncReqDom
 
usability :: ConceptInstance
usability :: ConceptInstance
usability = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"usability" ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"Software shall be easy to learn" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"use. Usability shall be measured by", 
  String -> Sentence
S String
"how long it takes a user to learn how to use the library to create a small program", 
  String -> Sentence
S String
"to simulate the movement" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"2 bodies over time in space. Creating a program", 
  String -> Sentence
S String
"should take no less than 30 to 60 minutes for an intermediate to experienced programmer"
  ]) String
"Usability" ConceptChunk
nonFuncReqDom

understandability :: ConceptInstance
understandability :: ConceptInstance
understandability = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"understandability" ([Sentence] -> Sentence
foldlSent [
  (String -> Sentence
S String
"Users" Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"Tamias2D shall be able to learn the software with ease" !.), 
  (String -> Sentence
S String
"Users shall be able to easily create a small program using the library" !.), 
  String -> Sentence
S String
"Creating a small program to simulate the movement of 2 bodies" Sentence -> Sentence -> Sentence
`S.in_` 
  String -> Sentence
S String
"space should take no less that 60 minutes"
  ]) String
"Understandability" ConceptChunk
nonFuncReqDom

maintainability :: ConceptInstance
maintainability :: ConceptInstance
maintainability = String -> Integer -> String -> ConceptInstance
mkMaintainableNFR String
"maintainability" Integer
10 String
"Maintainability"