{-# 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
  HasSystemInformation(..),
  -- ** Lookup Functions
  citeDB, citationsFromBibMap,
  -- * Reference Database
  -- ** Types
  ReferenceDB, RefMap, Purpose, Background, Scope, Motivation,
  -- ** Constructors
  rdb, simpleMap,
  -- ** Lenses
  citationDB, conceptDB,
  ) where

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

import Control.Lens ((^.), makeLenses, makeClassy)
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,
  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
  , SystemInformation -> People
_authors     :: People
  , SystemInformation -> Purpose
_purpose     :: Purpose
  , SystemInformation -> Purpose
_background  :: Background
  , SystemInformation -> Purpose
_scope       :: Scope
  , SystemInformation -> Purpose
_motivation  :: Motivation
  , ()
_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]
-- | Project Example scope.
type Scope = [Sentence]
-- | Project Example motivation.
type Motivation = [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 = (Citation -> Citation -> Ordering) -> BibRef -> BibRef
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Citation -> Citation -> Ordering
forall c. HasFields c => c -> c -> Ordering
compareAuthYearTitle BibRef
citations
  where citations :: [Citation]
        citations :: BibRef
citations = ((Citation, Int) -> Citation) -> [(Citation, Int)] -> BibRef
forall a b. (a -> b) -> [a] -> [b]
map (Citation, Int) -> Citation
forall a b. (a, b) -> a
fst (BibMap -> [(Citation, Int)]
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 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ  = Ordering
cp
  | Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y2  = Int
y1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
y2
  | Bool
otherwise = String
t1 String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
t2
  where
    (People
a1, Int
y1, String
t1) = c -> (People, Int, String)
forall c. HasFields c => c -> (People, Int, String)
getAuthorYearTitle c
c1
    (People
a2, Int
y2, String
t2) = c -> (People, Int, String)
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 c -> Getting [CiteField] c [CiteField] -> [CiteField]
forall s a. s -> Getting a s a -> a
^. Getting [CiteField] c [CiteField]
forall c. HasFields c => Lens' c [CiteField]
Lens' c [CiteField]
getFields

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

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

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

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

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

    ts :: [String]
ts = (CiteField -> Maybe String) -> [CiteField] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CiteField -> Maybe String
justTitle [CiteField]
fs
    t :: String
t = if Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ts) then [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
ts else String -> String
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
makeClassy ''SystemInformation

-- | 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 = [(UID, (a, Int))] -> Map UID (a, Int)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, (a, Int))] -> Map UID (a, Int))
-> [(UID, (a, Int))] -> Map UID (a, Int)
forall a b. (a -> b) -> a -> b
$ [UID] -> [(a, Int)] -> [(UID, (a, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> UID) -> [a] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) [a]
xs) ([a] -> [Int] -> [(a, Int)]
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 = [(UID, (Citation, Int))] -> BibMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, (Citation, Int))] -> BibMap)
-> [(UID, (Citation, Int))] -> BibMap
forall a b. (a -> b) -> a -> b
$ [UID] -> [(Citation, Int)] -> [(UID, (Citation, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Citation -> UID) -> BibRef -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (Citation -> Getting UID Citation UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Citation UID
forall c. HasUID c => Getter c UID
Getter Citation UID
uid) BibRef
scs) (BibRef -> [Int] -> [(Citation, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip BibRef
scs [Int
1..])
  where scs :: [Citation]
        scs :: BibRef
scs = (Citation -> Citation -> Ordering) -> BibRef -> BibRef
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Citation -> Citation -> Ordering
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 UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== ConceptInstance -> UID
cdl ConceptInstance
b where
  cdl :: ConceptInstance -> UID
  cdl :: ConceptInstance -> UID
cdl = [UID] -> UID
sDom ([UID] -> UID)
-> (ConceptInstance -> [UID]) -> ConceptInstance -> UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConceptInstance -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom

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