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

-- Changes to SystemInformation 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 SysInfo.Drasil.SystemInformation (
  -- * System Information
  -- ** Types
  SystemInformation(..), Block(..),
  -- ** Lenses
  instModels, datadefs, configFiles, inputs, purpose, background,
  defSequence, constraints, constants, sysinfodb, usedinfodb,
  -- ** Lookup Functions
  citeDB, citationsFromBibMap,
  -- * Reference Database
  -- ** Types
  ReferenceDB, RefMap, Purpose, Background,
  -- ** Constructors
  rdb, simpleMap,
  -- ** Lenses
  citationDB, conceptDB,
  ) where

import Language.Drasil
import Theory.Drasil
import Database.Drasil (ChunkDB)

import Control.Lens ((^.), makeLenses)
import Data.Function (on)
import Data.List (groupBy, sortBy)
import Data.Maybe (mapMaybe)
import qualified Data.Map as Map


-- | Data structure for holding all of the requisite information about a system
-- to be used in artifact generation.
data SystemInformation 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, Idea b, HasName c,
  Quantity e, Eq e, MayHaveUnit e, Quantity f, MayHaveUnit f, Concept f, Eq f,
  Quantity h, MayHaveUnit h, Quantity i, MayHaveUnit i,
  HasUID j, Constrained j) => 
  { ()
_sys         :: a
  , ()
_kind        :: b
  , ()
_authors     :: [c]
  , SystemInformation -> Purpose
_purpose     :: Purpose
  , SystemInformation -> Purpose
_background  :: Background
  , ()
_quants      :: [e]
  , ()
_concepts    :: [f]
  , SystemInformation -> [InstanceModel]
_instModels  :: [InstanceModel]
  , SystemInformation -> [DataDefinition]
_datadefs    :: [DataDefinition]
  , SystemInformation -> [String]
_configFiles :: [String]
  , ()
_inputs      :: [h]
  , ()
_outputs     :: [i]
  , SystemInformation -> [Block SimpleQDef]
_defSequence :: [Block SimpleQDef]
  , ()
_constraints :: [j] --TODO: Add SymbolMap OR enough info to gen SymbolMap
  , SystemInformation -> [ConstQDef]
_constants   :: [ConstQDef]
  , SystemInformation -> ChunkDB
_sysinfodb   :: ChunkDB
  , SystemInformation -> ChunkDB
_usedinfodb  :: ChunkDB
  , SystemInformation -> ReferenceDB
refdb        :: ReferenceDB
  } -> SystemInformation


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

-- | for listing 'QDefinition's in 'SystemInformation'.
data Block a = Coupled a a [a] | Parallel a [a]

-- | Helper for extracting a bibliography from the system information.
citeDB :: SystemInformation -> BibRef
citeDB :: SystemInformation -> BibRef
citeDB SystemInformation
si = BibMap -> BibRef
citationsFromBibMap (ReferenceDB -> BibMap
_citationDB (SystemInformation -> ReferenceDB
refdb SystemInformation
si))

-- | Create sorted citations from a bibliography.
citationsFromBibMap :: BibMap -> [Citation]
citationsFromBibMap :: BibMap -> BibRef
citationsFromBibMap BibMap
bm = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall c. HasFields c => c -> c -> Ordering
compareAuthYearTitle BibRef
citations
  where citations :: [Citation]
        citations :: BibRef
citations = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [a]
Map.elems BibMap
bm)

-- | Orders two authors. If given two of the exact same authors, year, and title, returns an error.
compareAuthYearTitle :: (HasFields c) => c -> c -> Ordering
compareAuthYearTitle :: forall c. HasFields c => c -> c -> Ordering
compareAuthYearTitle c
c1 c
c2
  | Ordering
cp forall a. Eq a => a -> a -> Bool
/= Ordering
EQ  = Ordering
cp
  | Int
y1 forall a. Eq a => a -> a -> Bool
/= Int
y2  = Int
y1 forall a. Ord a => a -> a -> Ordering
`compare` Int
y2
  | Bool
otherwise = String
t1 forall a. Ord a => a -> a -> Ordering
`compare` String
t2
  where
    (People
a1, Int
y1, String
t1) = forall c. HasFields c => c -> (People, Int, String)
getAuthorYearTitle c
c1
    (People
a2, Int
y2, String
t2) = forall c. HasFields c => c -> (People, Int, String)
getAuthorYearTitle c
c2

    cp :: Ordering
cp = People -> People -> Ordering
comparePeople People
a1 People
a2

-- | Search for the Author, Year, and Title of a Citation-like data type, and
-- error out if it doesn't have them.
getAuthorYearTitle :: HasFields c => c -> (People, Int, String)
getAuthorYearTitle :: forall c. HasFields c => c -> (People, Int, String)
getAuthorYearTitle c
c = (People
a, Int
y, String
t)
  where
    fs :: [CiteField]
fs = c
c forall s a. s -> Getting a s a -> a
^. forall c. HasFields c => Lens' c [CiteField]
getFields

    justAuthor :: CiteField -> Maybe People
justAuthor (Author People
x) = forall a. a -> Maybe a
Just People
x
    justAuthor CiteField
_          = forall a. Maybe a
Nothing

    as :: [People]
as = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CiteField -> Maybe People
justAuthor [CiteField]
fs
    a :: People
a = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [People]
as) then forall a. [a] -> a
head [People]
as else forall a. HasCallStack => String -> a
error String
"No author found"

    justYear :: CiteField -> Maybe Int
justYear (Year Int
x) = forall a. a -> Maybe a
Just Int
x
    justYear CiteField
_        = forall a. Maybe a
Nothing

    ys :: [Int]
ys = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CiteField -> Maybe Int
justYear [CiteField]
fs
    y :: Int
y = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ys) then forall a. [a] -> a
head [Int]
ys else forall a. HasCallStack => String -> a
error String
"No year found"

    justTitle :: CiteField -> Maybe String
justTitle (Title String
x) = forall a. a -> Maybe a
Just String
x
    justTitle CiteField
_         = forall a. Maybe a
Nothing

    ts :: [String]
ts = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CiteField -> Maybe String
justTitle [CiteField]
fs
    t :: String
t = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ts) then forall a. [a] -> a
head [String]
ts else forall a. HasCallStack => String -> a
error String
"No title found"

-- | Database for maintaining references.
-- The Int is that reference's number.
-- Maintains access to both num and chunk for easy reference swapping
-- between number and shortname/refname when necessary (or use of number
-- if no shortname exists).
type RefMap a = Map.Map UID (a, Int)

-- | Citation Database (bibliography information).
type BibMap = RefMap Citation
-- | ConceptInstance Database.
type ConceptMap = RefMap ConceptInstance


-- | Database for internal references. Contains citations and referrable concepts.
data ReferenceDB = RDB -- organized in order of appearance in SmithEtAl template
  { ReferenceDB -> BibMap
_citationDB :: BibMap
  , ReferenceDB -> ConceptMap
_conceptDB :: ConceptMap
  }

makeLenses ''ReferenceDB

-- | Smart constructor for creating a reference database from a bibliography and concept instances.
rdb :: BibRef -> [ConceptInstance] -> ReferenceDB
rdb :: BibRef -> [ConceptInstance] -> ReferenceDB
rdb BibRef
citations [ConceptInstance]
con = BibMap -> ConceptMap -> ReferenceDB
RDB (BibRef -> BibMap
bibMap BibRef
citations) ([ConceptInstance] -> ConceptMap
conceptMap [ConceptInstance]
con)

-- | Constructor that makes a 'RefMap' from things that have a 'UID'.
simpleMap :: HasUID a => [a] -> RefMap a
simpleMap :: forall a. HasUID a => [a] -> RefMap a
simpleMap [a]
xs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) [a]
xs) (forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Int
1..])

-- | Constructs a citation database from citations (sorted).
bibMap :: [Citation] -> BibMap
bibMap :: BibRef -> BibMap
bibMap BibRef
cs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) BibRef
scs) (forall a b. [a] -> [b] -> [(a, b)]
zip BibRef
scs [Int
1..])
  where scs :: [Citation]
        scs :: BibRef
scs = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall c. HasFields c => c -> c -> Ordering
compareAuthYearTitle BibRef
cs
        -- Sorting is necessary if using elems to pull all the citations
        -- (as it sorts them and would change the order).
        -- We can always change the sorting to whatever makes most sense

-- | Check if the 'UID's of two 'ConceptInstance's are the same.
conGrp :: ConceptInstance -> ConceptInstance -> Bool
conGrp :: ConceptInstance -> ConceptInstance -> Bool
conGrp ConceptInstance
a ConceptInstance
b = ConceptInstance -> UID
cdl ConceptInstance
a forall a. Eq a => a -> a -> Bool
== ConceptInstance -> UID
cdl ConceptInstance
b where
  cdl :: ConceptInstance -> UID
  cdl :: ConceptInstance -> UID
cdl = [UID] -> UID
sDom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ConceptDomain c => c -> [UID]
cdom

-- | Constructs a 'ConceptInstance' database from 'ConceptInstance's.
conceptMap :: [ConceptInstance] -> ConceptMap
conceptMap :: [ConceptInstance] -> ConceptMap
conceptMap [ConceptInstance]
cs = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ConceptInstance]]
grp)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
  (\[ConceptInstance]
x -> forall a b. [a] -> [b] -> [(a, b)]
zip [ConceptInstance]
x [Int
1..]) [[ConceptInstance]]
grp
  where grp :: [[ConceptInstance]]
        grp :: [[ConceptInstance]]
grp = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ConceptInstance -> ConceptInstance -> Bool
conGrp forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall c. HasUID c => c -> c -> Ordering
uidSort [ConceptInstance]
cs

-- | Compare two things by their 'UID's.
uidSort :: HasUID c => c -> c -> Ordering
uidSort :: forall c. HasUID c => c -> c -> Ordering
uidSort = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)

makeLenses ''SystemInformation