-- | Standard code to make a table of symbols.
module Drasil.Sections.TableOfSymbols (table, symbTableRef, tsymb, tsymb', tsymb'', tsIntro) where

import Language.Drasil hiding (Manual, Verb) -- Manual - Citation name conflict. FIXME: Move to different namespace
                                               -- Vector - Name conflict (defined in file)

import Data.List (nub, (\\))
import Control.Lens (view)
import Text.PrettyPrint.HughesPJ (text, render, vcat, (<+>))

import Drasil.Sections.ReferenceMaterial(emptySectSentPlu)

import Drasil.DocumentLanguage.Units (toSentence)
import Data.Drasil.Concepts.Documentation (symbol_, description, tOfSymb)
import Data.Drasil.Concepts.Math (unit_)
import Language.Drasil.Printers (symbolDoc)
import Drasil.DocumentLanguage.Core (Literature(..), TConvention(..), TSIntro(..), LFunc(..), RefTab(..))

--Removed SymbolForm Constraint
-- | Table of Symbols creation function. Takes in a 'Stage', 'Symbol's, and something that turns
-- the symbols into a 'Sentence'. Filters non-symbol chunks and checks for duplicate symbol error.
table :: (Quantity s, MayHaveUnit s) => Stage -> [s] -> (s -> Sentence) -> LabelledContent
table :: forall s.
(Quantity s, MayHaveUnit s) =>
Stage -> [s] -> (s -> Sentence) -> LabelledContent
table Stage
_ [] s -> Sentence
_ = Reference -> RawContent -> LabelledContent
llcc Reference
symbTableRef (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> RawContent
Paragraph Sentence
EmptyS
table Stage
st [s]
ls s -> Sentence
f
    |Bool
noDuplicate = Reference -> RawContent -> LabelledContent
llcc Reference
symbTableRef (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$
      [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
symbol_, IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
description, ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
unit_]
      ([s -> Sentence] -> [s] -> [[Sentence]]
forall a b. [a -> b] -> [a] -> [[b]]
mkTable [Symbol -> Sentence
P (Symbol -> Sentence) -> (s -> Symbol) -> s -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
`symbol` Stage
st), s -> Sentence
f, s -> Sentence
forall u. MayHaveUnit u => u -> Sentence
toSentence] [s]
filteredChunks)
      (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
tOfSymb) Bool
True
    | Bool
otherwise = [Char] -> LabelledContent
forall a. HasCallStack => [Char] -> a
error [Char]
errorMessage 
    where 
        filteredChunks :: [s]
filteredChunks = (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter (s -> Stage -> Bool
forall q. HasSymbol q => q -> Stage -> Bool
`hasStageSymbol`Stage
st) [s]
ls
        symbolsCol :: [Symbol]
symbolsCol     = (s -> Symbol) -> [s] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (s -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
`symbol` Stage
st) [s]
filteredChunks
        uidCol :: [UID]
uidCol         = (s -> UID) -> [s] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (Getting UID s UID -> s -> UID
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UID s UID
forall c. HasUID c => Getter c UID
Getter s UID
uid)    [s]
filteredChunks
        symUidPair :: [(Symbol, UID)]
symUidPair     = [Symbol] -> [UID] -> [(Symbol, UID)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Symbol]
symbolsCol [UID]
uidCol
        symDuplicates :: [Symbol]
symDuplicates  = [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a]
nub ([Symbol]
symbolsCol [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a]
nub [Symbol]
symbolsCol)
        noDuplicate :: Bool
noDuplicate    = [Symbol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Symbol]
symDuplicates
        -- If there are duplicates then the following will extract the UID's of duplicates symbols
        extractPairs :: Symbol -> [(Symbol, UID)]
extractPairs Symbol
symb = ((Symbol, UID) -> Bool) -> [(Symbol, UID)] -> [(Symbol, UID)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Symbol, UID)
x -> (Symbol, UID) -> Symbol
forall a b. (a, b) -> a
fst (Symbol, UID)
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
symb) [(Symbol, UID)]
symUidPair
        extractUid :: [(a, b)] -> [b]
extractUid  = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd
        extractUidFromPairs :: Symbol -> Doc
extractUidFromPairs = [Char] -> Doc
text ([Char] -> Doc) -> (Symbol -> [Char]) -> Symbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UID] -> [Char]
forall a. Show a => a -> [Char]
show ([UID] -> [Char]) -> (Symbol -> [UID]) -> Symbol -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, UID)] -> [UID]
forall {a} {b}. [(a, b)] -> [b]
extractUid ([(Symbol, UID)] -> [UID])
-> (Symbol -> [(Symbol, UID)]) -> Symbol -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> [(Symbol, UID)]
extractPairs
        errSymUidDuplicates :: Doc
errSymUidDuplicates = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Symbol -> Doc) -> [Symbol] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Symbol
symb -> 
          Symbol -> Doc
extractUidFromPairs Symbol
symbDoc -> Doc -> Doc
<+>[Char] -> Doc
text [Char]
"all have symbol"Doc -> Doc -> Doc
<+>Symbol -> Doc
symbolDoc Symbol
symb) [Symbol]
symDuplicates
        errorMessage :: [Char]
errorMessage = [Char]
"Same symbols for different quantities found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Doc -> [Char]
render Doc
errSymUidDuplicates

-- | Makes a reference to the Table of Symbols.
symbTableRef :: Reference
symbTableRef :: Reference
symbTableRef = [Char] -> Reference
makeTabRef [Char]
"ToS"

----- Table of symbols section helper functions -----

-- | Table of symbols constructor.
tsymb, tsymb' :: [TSIntro] -> RefTab
-- | Default is term and given introduction.
tsymb :: [TSIntro] -> RefTab
tsymb = [TSIntro] -> RefTab
TSymb
-- | Similar to 'tsymb', but has a default Defn for the LFunc type. Still has a given introduction.
tsymb' :: [TSIntro] -> RefTab
tsymb' = LFunc -> [TSIntro] -> RefTab
TSymb' LFunc
Defn

-- | Table of symbols constructor. Takes a custom function and introduction.
tsymb'' :: [TSIntro] -> LFunc -> RefTab
tsymb'' :: [TSIntro] -> LFunc -> RefTab
tsymb'' [TSIntro]
intro LFunc
lfunc = LFunc -> [TSIntro] -> RefTab
TSymb' LFunc
lfunc [TSIntro]
intro

-- | Table of symbols introduction builder. Used by 'mkRefSec'.
tsIntro :: [TSIntro] -> Contents
tsIntro :: [TSIntro] -> Contents
tsIntro [] = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
symbol_]
tsIntro [TSIntro]
x = Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ (TSIntro -> Sentence -> Sentence)
-> Sentence -> [TSIntro] -> Sentence
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sentence -> Sentence -> Sentence
(+:+) (Sentence -> Sentence -> Sentence)
-> (TSIntro -> Sentence) -> TSIntro -> Sentence -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSIntro -> Sentence
tsI) Sentence
EmptyS [TSIntro]
x

-- | Table of symbols intro writer. Translates a 'TSIntro' to a list in a 'Sentence'.
tsI :: TSIntro -> Sentence
tsI :: TSIntro -> Sentence
tsI (TypogConvention [TConvention]
ts) = [TConvention] -> Sentence
typogConvention [TConvention]
ts
tsI TSIntro
SymbOrder = [Char] -> Sentence
S [Char]
"The symbols are listed in alphabetical order."
tsI (SymbConvention [Literature]
ls) = [Literature] -> Sentence
symbConvention [Literature]
ls
tsI TSIntro
TSPurpose = [Char] -> Sentence
S [Char]
"The symbols used in this document are summarized in the" Sentence -> Sentence -> Sentence
+:+
  Reference -> Sentence -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Reference
symbTableRef (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
tOfSymb) Sentence -> Sentence -> Sentence
+:+. [Char] -> Sentence
S [Char]
"along with their units"
tsI TSIntro
VectorUnits = [Char] -> Sentence
S [Char]
"For vector quantities, the units shown are for each component of the vector."

-- | Typographic convention writer. Translates a list of typographic conventions ('TConvention's)
-- to a 'Sentence'.
typogConvention :: [TConvention] -> Sentence
typogConvention :: [TConvention] -> Sentence
typogConvention [] = [Char] -> Sentence
forall a. HasCallStack => [Char] -> a
error [Char]
"No arguments given for typographic conventions"
typogConvention [TConvention]
ts = [Char] -> Sentence
S [Char]
"Throughout the document," Sentence -> Sentence -> Sentence
+:+. SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ((TConvention -> Sentence) -> [TConvention] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map TConvention -> Sentence
tcon [TConvention]
ts)
  where tcon :: TConvention -> Sentence
tcon (Vector Emphasis
emph) = [Char] -> Sentence
S ([Char]
"symbols in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Emphasis -> [Char]
forall a. Show a => a -> [Char]
show Emphasis
emph [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                [Char]
" will represent vectors, and scalars otherwise")
        tcon (Verb Sentence
s) = Sentence
s

-- | Symbolic convention writer.
symbConvention :: [Literature] -> Sentence
symbConvention :: [Literature] -> Sentence
symbConvention [] = [Char] -> Sentence
forall a. HasCallStack => [Char] -> a
error [Char]
"Attempting to reference no literature for SymbConvention"
symbConvention [Literature]
scs = [Char] -> Sentence
S [Char]
"The choice of symbols was made to be consistent with the" Sentence -> Sentence -> Sentence
+:+.
                      [Sentence] -> Sentence
makeSentence ((Literature -> Sentence) -> [Literature] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map Literature -> Sentence
scon [Literature]
scs)
  where makeSentence :: [Sentence] -> Sentence
makeSentence [Sentence
x,Sentence
y] = Sentence
x Sentence -> Sentence -> Sentence
+:+ [Char] -> Sentence
S [Char]
"and with" Sentence -> Sentence -> Sentence
+:+ Sentence
y
        makeSentence [Sentence]
xs    = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
xs
        scon :: Literature -> Sentence
scon (Lit IdeaDict
x)       = IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
x Sentence -> Sentence -> Sentence
+:+ [Char] -> Sentence
S [Char]
"literature"
        scon (Doc IdeaDict
x)       = [Char] -> Sentence
S [Char]
"existing documentation for" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
x
        scon (Doc' IdeaDict
x)      = [Char] -> Sentence
S [Char]
"existing documentation for" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
x
        scon (Manual IdeaDict
x)    = [Char] -> Sentence
S [Char]
"that used in the" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
x Sentence -> Sentence -> Sentence
+:+ [Char] -> Sentence
S [Char]
"manual"