{-# LANGUAGE GADTs, TemplateHaskell, RankNTypes #-}
-- | Define types and functions related to creating a system information database.
module SysInfo.Drasil.SystemInformation (
  -- * System Information
  -- ** Types
  SystemInformation(..), Block(..),
  -- ** Lenses
  instModels, datadefs, configFiles, inputs,
  defSequence, constraints, constants, sysinfodb, usedinfodb,
  -- ** Lookup Functions
  citeDB, citationsFromBibMap,
  -- * Reference Database
  -- ** Types
  ReferenceDB, RefMap,
  -- ** 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 (find, groupBy, sortBy)
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]
  , ()
_purpose     :: d
  , ()
_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

-- | 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 si :: 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 bm :: 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 :: c -> c -> Ordering
compareAuthYearTitle c1 :: c
c1 c2 :: 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
  | String
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
t2 = String
t1 String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` String
t2
  | Bool
otherwise = String -> Ordering
forall a. HasCallStack => String -> a
error "Couldn't sort authors"
  where
    cp :: Ordering
cp = [Person] -> [Person] -> Ordering
comparePeople (c -> [Person]
forall c. HasFields c => c -> [Person]
getAuthor c
c1) (c -> [Person]
forall c. HasFields c => c -> [Person]
getAuthor c
c2)
    y1 :: Int
y1 = c -> Int
forall c. HasFields c => c -> Int
getYear c
c1
    y2 :: Int
y2 = c -> Int
forall c. HasFields c => c -> Int
getYear c
c2
    t1 :: String
t1 = c -> String
forall c. HasFields c => c -> String
getTitle c
c1
    t2 :: String
t2 = c -> String
forall c. HasFields c => c -> String
getTitle c
c2

-- | Helper that gets the author name from something that has a field.
getAuthor :: (HasFields c) => c -> People
getAuthor :: c -> [Person]
getAuthor c :: c
c = [Person] -> (CiteField -> [Person]) -> Maybe CiteField -> [Person]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [Person]
forall a. HasCallStack => String -> a
error "No author found") (\(Author x :: [Person]
x) -> [Person]
x) ((CiteField -> Bool) -> [CiteField] -> Maybe CiteField
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CiteField -> Bool
isAuthor (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]
getFields))
  where isAuthor :: CiteField -> Bool
        isAuthor :: CiteField -> Bool
isAuthor (Author _) = Bool
True
        isAuthor _          = Bool
False

-- | Helper that gets the year published from something that has a field.
getYear :: (HasFields c) => c -> Int
getYear :: c -> Int
getYear c :: c
c = Int -> (CiteField -> Int) -> Maybe CiteField -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Int
forall a. HasCallStack => String -> a
error "No year found") (\(Year x :: Int
x) -> Int
x) ((CiteField -> Bool) -> [CiteField] -> Maybe CiteField
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CiteField -> Bool
isYear (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]
getFields))
  where isYear :: CiteField -> Bool
        isYear :: CiteField -> Bool
isYear (Year _) = Bool
True
        isYear _        = Bool
False

-- | Helper that gets the title of the article from something that has a field.
getTitle :: (HasFields c) => c -> String
getTitle :: c -> String
getTitle c :: c
c = String -> (CiteField -> String) -> Maybe CiteField -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String
forall a. HasCallStack => String -> a
error "No title found") (\(Title x :: String
x) -> String
x) ((CiteField -> Bool) -> [CiteField] -> Maybe CiteField
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CiteField -> Bool
isTitle (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]
getFields))
  where isTitle :: CiteField -> Bool
        isTitle :: CiteField -> Bool
isTitle (Title _) = Bool
True
        isTitle _         = Bool
False

-- | 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 citations :: BibRef
citations con :: [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 :: [a] -> RefMap a
simpleMap xs :: [a]
xs = [(UID, (a, Int))] -> RefMap a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, (a, Int))] -> RefMap a) -> [(UID, (a, Int))] -> RefMap a
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 => Lens' c UID
uid) [a]
xs) ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [1..])

-- | Constructs a citation database from citations (sorted).
bibMap :: [Citation] -> BibMap
bibMap :: BibRef -> BibMap
bibMap cs :: 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 => Lens' c UID
uid) BibRef
scs) (BibRef -> [Int] -> [(Citation, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip BibRef
scs [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 a :: ConceptInstance
a b :: 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 cs :: [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 => Lens' c 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
  (\x :: [ConceptInstance]
x -> [ConceptInstance] -> [Int] -> [(ConceptInstance, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConceptInstance]
x [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 :: 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 => Lens' c UID
uid)

makeLenses ''SystemInformation