{-# 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,
  -- * Hacks
  refbyLookup, traceLookup
) where

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

import Drasil.Database (UID, HasUID(..), ChunkDB)
import Language.Drasil (Quantity, MayHaveUnit, Sentence, Concept,
  Reference, People, IdeaDict, CI, Constrained, ConstQDef, nw, abrv)
import Theory.Drasil (TheoryModel, GenDefn, DataDefinition, InstanceModel)
import Drasil.Metadata (runnableSoftware, website, srs, notebook)
import Utils.Drasil (toPlainName)

-- | 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
srs
    whatKind' SystemKind
RunnableSoftware = IdeaDict
runnableSoftware
    whatKind' SystemKind
Notebook = CI -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw CI
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 :: (Quantity h, MayHaveUnit h, Concept h,
  Quantity i, MayHaveUnit i, Concept i,
  HasUID j, Constrained j) =>
  { System -> CI
_sysName      :: CI
  , System -> String
_programName  :: String
  , System -> SystemKind
_kind         :: SystemKind
  , System -> People
_authors      :: People
  , System -> Purpose
_purpose      :: Purpose
  , System -> Purpose
_background   :: Background
  , System -> Purpose
_scope        :: Scope
  , System -> Purpose
_motivation   :: Motivation
  , 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 :: (Quantity h, MayHaveUnit h, Concept h,
  Quantity i, MayHaveUnit i, Concept i,
  HasUID j, Constrained j) =>
  CI -> SystemKind -> People -> Purpose -> Background -> Scope -> Motivation ->
    [TheoryModel] -> [GenDefn] -> [DataDefinition] -> [InstanceModel] ->
    [String] -> [h] -> [i] -> [j] -> [ConstQDef] -> ChunkDB -> [Reference] ->
    System
mkSystem :: forall h i j.
(Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
CI
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> [Reference]
-> System
mkSystem CI
nm SystemKind
sk People
ppl Purpose
prps Purpose
bkgrd Purpose
scp Purpose
motive [TheoryModel]
tms [GenDefn]
gds [DataDefinition]
dds [InstanceModel]
ims [String]
ss [h]
hs [i]
is [j]
js [ConstQDef]
cqds ChunkDB
db [Reference]
refs
  = CI
-> String
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> Map UID Reference
-> Map UID [UID]
-> Map UID [UID]
-> System
forall h i j.
(Quantity h, MayHaveUnit h, Concept h, Quantity i, MayHaveUnit i,
 Concept i, HasUID j, Constrained j) =>
CI
-> String
-> SystemKind
-> People
-> Purpose
-> Purpose
-> Purpose
-> Purpose
-> [TheoryModel]
-> [GenDefn]
-> [DataDefinition]
-> [InstanceModel]
-> [String]
-> [h]
-> [i]
-> [j]
-> [ConstQDef]
-> ChunkDB
-> Map UID Reference
-> Map UID [UID]
-> Map UID [UID]
-> System
SI CI
nm String
progName SystemKind
sk People
ppl Purpose
prps Purpose
bkgrd Purpose
scp Purpose
motive [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
    progName :: String
progName = String -> String
toPlainName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CI -> String
forall c. CommonIdea c => c -> String
abrv CI
nm

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)