-- | Defines concepts used in computing.
module Data.Drasil.Concepts.Computation where

import Language.Drasil (dcc, nc, cn', commonIdeaWithDict, Sentence,
  ConceptChunk, CI, NamedChunk, dccWDS)
import Language.Drasil.Chunk.Concept.NamedCombinators

import Data.Drasil.Concepts.Documentation (datum, input_, literacy, output_, 
  quantity, type_, value, variable)
import Data.Drasil.Concepts.Math (parameter)
import Data.Drasil.Domains (compScience)

algorithm, absTolerance, relTolerance:: ConceptChunk
algorithm :: ConceptChunk
algorithm = String -> NP -> String -> ConceptChunk
dcc "algorithm" (String -> NP
cn' "algorithm")
  "a series of steps to be followed in calculations and problem-solving operations"
absTolerance :: ConceptChunk
absTolerance = String -> NP -> String -> ConceptChunk
dcc "absTolerance"   (String -> NP
cn' "Absolute tolerance") "a fixed number that is used to make direct comparisons"
relTolerance :: ConceptChunk
relTolerance = String -> NP -> String -> ConceptChunk
dcc "relTolerance"   (String -> NP
cn' "Relative tolerance") " maximum amount of error that the user is willing to allow in the solution"

modCalcDesc :: Sentence -> ConceptChunk
modCalcDesc :: Sentence -> ConceptChunk
modCalcDesc = String -> NP -> Sentence -> ConceptChunk
dccWDS "modCalcDesc" (String -> NP
cn' "calculation")

-- | Collects all computing-related named chunks (not concept-level yet).
compcon :: [NamedChunk]
compcon :: [NamedChunk]
compcon = [NamedChunk
application, NamedChunk
computer, NamedChunk
structure, NamedChunk
dataStruct, NamedChunk
dataStruct', NamedChunk
dataType, NamedChunk
dataType', 
  NamedChunk
inDatum, NamedChunk
outDatum, NamedChunk
inParam, NamedChunk
inVar, NamedChunk
inValue, NamedChunk
inQty, NamedChunk
computerLiteracy, NamedChunk
computerApp]

application, computer, structure :: NamedChunk
os :: CI
------------------------------------------------------------------------------------
--  NC      |     |      id       |       term             |  abbreviation | domain
-------------------------------------------------------------------------------------s
application :: NamedChunk
application = String -> NP -> NamedChunk
nc   "application"      (String -> NP
cn' "application") 
computer :: NamedChunk
computer    = String -> NP -> NamedChunk
nc   "computer"         (String -> NP
cn' "computer") 
structure :: NamedChunk
structure   = String -> NP -> NamedChunk
nc   "structure"        (String -> NP
cn' "structure")         
os :: CI
os          = String -> NP -> String -> [IdeaDict] -> CI
commonIdeaWithDict "os" (String -> NP
cn' "operating system")    "OS"   [IdeaDict
compScience]


dataStruct, dataStruct', dataType, dataType', 
  inDatum, outDatum, inParam, inVar, inValue, inQty,
  computerLiteracy, computerApp :: NamedChunk

dataStruct :: NamedChunk
dataStruct       = NamedChunk -> NamedChunk -> NamedChunk
compoundNCPSPP NamedChunk
datum NamedChunk
structure
dataStruct' :: NamedChunk
dataStruct'      = NamedChunk -> NamedChunk -> NamedChunk
compoundNCPS NamedChunk
datum NamedChunk
structure
dataType :: NamedChunk
dataType         = NamedChunk -> NamedChunk -> NamedChunk
compoundNCPSPP NamedChunk
datum NamedChunk
type_
dataType' :: NamedChunk
dataType'        = NamedChunk -> NamedChunk -> NamedChunk
compoundNCPS NamedChunk
datum NamedChunk
type_
inDatum :: NamedChunk
inDatum          = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
input_ NamedChunk
datum
outDatum :: NamedChunk
outDatum         = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
output_ NamedChunk
datum
inParam :: NamedChunk
inParam          = NamedChunk -> ConceptChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
input_ ConceptChunk
parameter
inVar :: NamedChunk
inVar            = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
input_ NamedChunk
variable
inValue :: NamedChunk
inValue          = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
input_ NamedChunk
value
inQty :: NamedChunk
inQty            = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
input_ NamedChunk
quantity
computerLiteracy :: NamedChunk
computerLiteracy = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
computer NamedChunk
literacy
computerApp :: NamedChunk
computerApp      = NamedChunk -> NamedChunk -> NamedChunk
forall a b. (NamedIdea a, NamedIdea b) => a -> b -> NamedChunk
compoundNC NamedChunk
computer NamedChunk
application