{-# LANGUAGE GADTs, TemplateHaskell, RankNTypes #-}
-- | Define types and functions related to creating a system information database.

-- Changes to System should be reflected in the 'Creating Your Project 
-- in Drasil' tutorial found on the wiki:
-- https://github.com/JacquesCarette/Drasil/wiki/Creating-Your-Project-in-Drasil

module Drasil.System (
  -- * System
  -- ** Types
  System(..), SystemKind(..),
  -- ** Lenses
  HasSystem(..),
  -- ** Functions
  whatsTheBigIdea, mkSystem,
  -- * Reference Database
  -- ** Types
  Purpose, Background, Scope, Motivation
  ) where

import Language.Drasil hiding (kind, Notebook)
import Theory.Drasil
import Database.Drasil (ChunkDB)

import Drasil.Metadata (runnableSoftware, website)

import Control.Lens (makeClassy)
import qualified Data.Drasil.Concepts.Documentation as Doc

-- | Project Example purpose.
type Purpose = [Sentence]
-- | Project Example background information, used in the 'What' section of README.
type Background = [Sentence]
-- | Project Example scope.
type Scope = [Sentence]
-- | Project Example motivation.
type Motivation = [Sentence]

data SystemKind =
    Specification
  | RunnableSoftware
  | Notebook
  | Website

whatsTheBigIdea :: System -> IdeaDict
whatsTheBigIdea :: System -> IdeaDict
whatsTheBigIdea System
si = SystemKind -> IdeaDict
whatKind' (System -> SystemKind
_kind System
si)
  where
    whatKind' :: SystemKind -> IdeaDict
    whatKind' :: SystemKind -> IdeaDict
whatKind' SystemKind
Specification = CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
Doc.srs
    whatKind' SystemKind
RunnableSoftware = IdeaDict
runnableSoftware
    whatKind' SystemKind
Notebook = CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
Doc.notebook
    whatKind' SystemKind
Website = IdeaDict
website

-- | Data structure for holding all of the requisite information about a system
-- to be used in artifact generation.
data System where
--FIXME:
--There should be a way to remove redundant "Quantity" constraint.
-- I'm thinking for getting concepts that are also quantities, we could
-- use a lookup of some sort from their internal (Drasil) ids.
 SI :: (CommonIdea a, Idea a,
  Quantity e, Eq e, MayHaveUnit e, Concept e,
  Quantity h, MayHaveUnit h, Concept h,
  Quantity i, MayHaveUnit i, Concept i,
  HasUID j, Constrained j) => 
  { ()
_sys          :: a
  , System -> SystemKind
_kind         :: SystemKind
  , System -> People
_authors      :: People
  , System -> Purpose
_purpose      :: Purpose
  , System -> Purpose
_background   :: Background
  , System -> Purpose
_scope        :: Scope
  , System -> Purpose
_motivation   :: Motivation
  , ()
_quants       :: [e]
  , System -> [TheoryModel]
_theoryModels :: [TheoryModel]
  , System -> [GenDefn]
_genDefns     :: [GenDefn]
  , System -> [DataDefinition]
_dataDefns    :: [DataDefinition]
  , System -> [InstanceModel]
_instModels   :: [InstanceModel]
  , System -> [String]
_configFiles  :: [String]
  , ()
_inputs       :: [h]
  , ()
_outputs      :: [i]
  , ()
_constraints  :: [j] --TODO: Add SymbolMap OR enough info to gen SymbolMap
  , System -> [ConstQDef]
_constants    :: [ConstQDef]
  , System -> ChunkDB
_systemdb     :: ChunkDB
  } -> System

makeClassy ''System

mkSystem :: (CommonIdea a, Idea a,
  Quantity e, Eq e, MayHaveUnit e, Concept e,
  Quantity h, MayHaveUnit h, Concept h,
  Quantity i, MayHaveUnit i, Concept i,
  HasUID j, Constrained j) =>
  a -> SystemKind -> People -> Purpose -> Background -> Scope -> Motivation ->
    [e] -> [TheoryModel] -> [GenDefn] -> [DataDefinition] -> [InstanceModel] ->
    [String] -> [h] -> [i] -> [j] -> [ConstQDef] -> ChunkDB -> System
mkSystem :: forall a e h i j.
(CommonIdea a, Idea a, Quantity e, Eq e, MayHaveUnit e, Concept e,
 Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> System
mkSystem = a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> System
forall a e h i j.
(CommonIdea a, Idea a, Quantity e, Eq e, MayHaveUnit e, Concept e,
 Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> System
SI