{-# 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, sysName,
  -- * Reference Database
  -- ** Types
  Purpose, Background, Scope, Motivation,
  -- * Hacks
  refbyLookup, traceLookup
) where

import Control.Lens (makeClassy, (^.))
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)

import qualified Data.Drasil.Concepts.Documentation as Doc
import Drasil.Database (ChunkDB)
import Language.Drasil hiding (kind, Notebook)
import Theory.Drasil
import Drasil.Metadata (runnableSoftware, website)

-- | 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
    -- FIXME: Hacks to be removed once 'Reference's are rebuilt.
  , System -> Map UID Reference
_refTable     :: M.Map UID Reference
  , System -> Map UID [UID]
_refbyTable   :: M.Map UID [UID]
  , System -> Map UID [UID]
_traceTable   :: M.Map UID [UID]
  } -> 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 -> [Reference] ->
    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
-> [Reference]
-> System
mkSystem a
nm SystemKind
sk People
ppl Purpose
prps Purpose
bkgrd Purpose
scp Purpose
motive [e]
es [TheoryModel]
tms [GenDefn]
gds [DataDefinition]
dds [InstanceModel]
ims [String]
ss [h]
hs [i]
is [j]
js [ConstQDef]
cqds ChunkDB
db [Reference]
refs
    = a
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [e]
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> Map UID Reference
-> Map UID [UID]
-> Map UID [UID]
-> 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
-> Map UID Reference
-> Map UID [UID]
-> Map UID [UID]
-> System
SI a
nm SystemKind
sk People
ppl Purpose
prps Purpose
bkgrd Purpose
scp Purpose
motive [e]
es [TheoryModel]
tms [GenDefn]
gds [DataDefinition]
dds [InstanceModel]
ims [String]
ss [h]
hs [i]
is [j]
js [ConstQDef]
cqds ChunkDB
db
        Map UID Reference
refsMap Map UID [UID]
forall a. Monoid a => a
mempty Map UID [UID]
forall a. Monoid a => a
mempty
  where refsMap :: Map UID Reference
refsMap = [(UID, Reference)] -> Map UID Reference
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(UID, Reference)] -> Map UID Reference)
-> [(UID, Reference)] -> Map UID Reference
forall a b. (a -> b) -> a -> b
$ (Reference -> (UID, Reference))
-> [Reference] -> [(UID, Reference)]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
x -> (Reference
x Reference -> Getting UID Reference UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Reference UID
forall c. HasUID c => Getter c UID
Getter Reference UID
uid, Reference
x)) [Reference]
refs

refbyLookup :: UID -> System -> [UID]
refbyLookup :: UID -> System -> [UID]
refbyLookup UID
u = [UID] -> Maybe [UID] -> [UID]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [UID] -> [UID])
-> (System -> Maybe [UID]) -> System -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> Map UID [UID] -> Maybe [UID]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u (Map UID [UID] -> Maybe [UID])
-> (System -> Map UID [UID]) -> System -> Maybe [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (System
-> Getting (Map UID [UID]) System (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) System (Map UID [UID])
forall c. HasSystem c => Lens' c (Map UID [UID])
Lens' System (Map UID [UID])
refbyTable)

traceLookup :: UID -> System -> [UID]
traceLookup :: UID -> System -> [UID]
traceLookup UID
u = [UID] -> Maybe [UID] -> [UID]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [UID] -> [UID])
-> (System -> Maybe [UID]) -> System -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> Map UID [UID] -> Maybe [UID]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UID
u (Map UID [UID] -> Maybe [UID])
-> (System -> Map UID [UID]) -> System -> Maybe [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (System
-> Getting (Map UID [UID]) System (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) System (Map UID [UID])
forall c. HasSystem c => Lens' c (Map UID [UID])
Lens' System (Map UID [UID])
traceTable)

-- FIXME: sysName is a hack.
sysName :: System -> IdeaDict
sysName :: System -> IdeaDict
sysName SI{_sys :: ()
_sys = a
sys} = a -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw a
sys