{-# LANGUAGE GADTs, PostfixOperators #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- | Contains Sentences and helpers functions.
module Language.Drasil.Sentence (
  -- * Types
  -- ** Sentence
  Sentence(..),
  -- ** Context Types
  SentenceStyle(..), RefInfo(..), TermCapitalization(..),
  -- * Functions
  (+:+), (+:+.), (+:), (!.), capSent, headSent, ch, eS, eS', sC, sDash, sParen,
  sentencePlural, sentenceShort,
  sentenceSymb, sentenceTerm,
  sdep, shortdep, lnames, lnames', sentenceRefs
) where

import Control.Lens ((^.))
import Data.Char (toUpper)

import Drasil.Database (HasChunkRefs(..), HasUID(..), UID)

import Language.Drasil.ExprClasses (Express(express))
import Language.Drasil.ModelExpr.Lang (ModelExpr)
import Language.Drasil.ModelExpr.Extract (meNames)
import Language.Drasil.NounPhrase.Types (NP)
import Language.Drasil.UnitLang (USymb)
import Language.Drasil.Symbol (HasSymbol, Symbol)

import qualified Data.Set as Set

-- | Used in 'Ch' constructor to determine the state of a term
-- (can record whether something is in plural form, a singular term, or in short form).
data SentenceStyle = PluralTerm
                   | TermStyle
                   | ShortStyle

-- | Used in 'Ch' constructor to determine the capitalization of a term.
-- CapF is for capitalizing the first word from the 'UID' of the given term.
-- CapW is for capitalizing all words from the 'UID' of the given term.
-- Mirrors 'CapFirst' and 'CapWords' from 'CapitalizationRule'.
data TermCapitalization = CapF | CapW | NoCap

-- | Holds any extra information needed for a 'Reference', be it an equation, pages, a note, or nothing.
data RefInfo = None
             | Equation [Int]
             | Page [Int]
             | RefNote String

-- | For writing 'Sentence's via combining smaller elements.
-- 'Sentence's are made up of some known vocabulary of things:
--
--     * units (their visual representation)
--     * words (via 'String's)
--     * special characters
--     * accented letters
--     * references to specific layout objects
infixr 5 :+:
data Sentence where
  -- | Ch looks up the term for a given 'UID' and displays the term with a given 'SentenceStyle' and 'CapitalizationRule'.
  -- This allows Sentences to hold plural forms of 'NamedIdea's.
  Ch    :: SentenceStyle -> TermCapitalization -> UID -> Sentence
  -- | A branch of Ch dedicated to SymbolStyle only.
  SyCh  :: UID -> Sentence
  -- | Converts a unit symbol into a usable Sentence form.
  Sy    :: USymb -> Sentence
  -- | Directly embeds a 'NP'
  NP    :: NP -> Sentence
  -- | Constructor for 'String's, used often for descriptions in Chunks.
  S     :: String -> Sentence
  -- | Converts the graphical representation of a symbol into a usable Sentence form.
  P     :: Symbol -> Sentence       -- should not be used in examples?
  -- | Lifts an expression into a Sentence.
  E     :: ModelExpr -> Sentence
  -- | Takes a 'UID' to a reference, a display name ('Sentence'), and any additional reference display information ('RefInfo'). Resolves the reference later (similar to Ch).
  Ref   :: UID -> Sentence -> RefInfo -> Sentence
  -- | Adds quotation marks around a Sentence.
  Quote :: Sentence -> Sentence
  -- | Used for a % symbol.
  Percent :: Sentence
  -- | Direct concatenation of two Sentences (no implicit spaces!).
  (:+:) :: Sentence -> Sentence -> Sentence
  -- | Empty Sentence.
  EmptyS :: Sentence

eS :: ModelExpr -> Sentence
eS :: ModelExpr -> Sentence
eS = ModelExpr -> Sentence
E

eS' :: Express t => t -> Sentence
eS' :: forall t. Express t => t -> Sentence
eS' = ModelExpr -> Sentence
E (ModelExpr -> Sentence) -> (t -> ModelExpr) -> t -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ModelExpr
forall c. Express c => c -> ModelExpr
express

-- The HasSymbol is redundant, but on purpose
-- | Gets a symbol and places it in a 'Sentence'.
ch :: (HasUID c, HasSymbol c) => c -> Sentence
ch :: forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch c
x = UID -> Sentence
SyCh (c
x 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)

-- | Sentences can be concatenated.
instance Semigroup Sentence where
  <> :: Sentence -> Sentence -> Sentence
(<>) = Sentence -> Sentence -> Sentence
(:+:)

-- | Sentences can be empty or directly concatenated.
instance Monoid Sentence where
  mempty :: Sentence
mempty = Sentence
EmptyS

-- | Smart constructors for turning a 'UID' into a 'Sentence'.
sentencePlural, sentenceShort, sentenceSymb, sentenceTerm :: UID -> Sentence
-- | Gets plural term of 'UID'.
sentencePlural :: UID -> Sentence
sentencePlural = SentenceStyle -> TermCapitalization -> UID -> Sentence
Ch SentenceStyle
PluralTerm TermCapitalization
NoCap
-- | Gets short form of 'UID'.
sentenceShort :: UID -> Sentence
sentenceShort  = SentenceStyle -> TermCapitalization -> UID -> Sentence
Ch SentenceStyle
ShortStyle TermCapitalization
NoCap
-- | Gets symbol form of 'UID'.
sentenceSymb :: UID -> Sentence
sentenceSymb   = UID -> Sentence
SyCh
-- | Gets singular form of 'UID'.
sentenceTerm :: UID -> Sentence
sentenceTerm   = SentenceStyle -> TermCapitalization -> UID -> Sentence
Ch SentenceStyle
TermStyle TermCapitalization
NoCap

-- | Helper for wrapping 'Sentence's in parentheses.
sParen :: Sentence -> Sentence
sParen :: Sentence -> Sentence
sParen Sentence
x = String -> Sentence
S String
"(" Sentence -> Sentence -> Sentence
:+: Sentence
x Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
")"

-- | Helper for concatenating two 'Sentence's with a space-surrounded dash between them.
sDash :: Sentence -> Sentence -> Sentence
sDash :: Sentence -> Sentence -> Sentence
sDash Sentence
a Sentence
b = Sentence
a Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"-" Sentence -> Sentence -> Sentence
+:+ Sentence
b

-- | Helper for concatenating two 'Sentence's with a space between them.
(+:+) :: Sentence -> Sentence -> Sentence
Sentence
EmptyS +:+ :: Sentence -> Sentence -> Sentence
+:+ Sentence
b = Sentence
b
Sentence
a +:+ Sentence
EmptyS = Sentence
a
Sentence
a +:+ Sentence
b = Sentence
a Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
" " Sentence -> Sentence -> Sentence
:+: Sentence
b

-- | Helper for concatenating two 'Sentence's with a comma and space between them.
sC :: Sentence -> Sentence -> Sentence
Sentence
a sC :: Sentence -> Sentence -> Sentence
`sC` Sentence
b = Sentence
a Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"," Sentence -> Sentence -> Sentence
+:+ Sentence
b

-- | Helper which concatenates two 'Sentence's using '+:+' and appends a period.
(+:+.) :: Sentence -> Sentence -> Sentence
Sentence
a +:+. :: Sentence -> Sentence -> Sentence
+:+. Sentence
b = Sentence
a Sentence -> Sentence -> Sentence
+:+ Sentence
b Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"."

-- | Helper which appends a period to the end of a 'Sentence' (used often as a post-fix operator).
(!.) :: Sentence -> Sentence
!. :: Sentence -> Sentence
(!.) Sentence
a = Sentence
a Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
"."

-- | Helper which concatenates two sentences using '+:+' and appends a colon.
(+:) :: Sentence -> Sentence -> Sentence
Sentence
a +: :: Sentence -> Sentence -> Sentence
+: Sentence
b = Sentence
a Sentence -> Sentence -> Sentence
+:+ Sentence
b Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
":"

-- | Capitalizes a Sentence.
capSent :: Sentence -> Sentence
capSent :: Sentence -> Sentence
capSent (S (Char
s:String
ss)) = String -> Sentence
S (Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
ss)
--capSent (phrase x) = atStart x
--capSent (plural x) = atStart' x
capSent (Sentence
a :+: Sentence
b)  = Sentence -> Sentence
capSent Sentence
a Sentence -> Sentence -> Sentence
:+: Sentence
b
capSent Sentence
x          = Sentence
x

-- | Helper which creates a Header with size s of the 'Sentence'.
headSent :: Int -> Sentence -> Sentence
headSent :: Int -> Sentence -> Sentence
headSent Int
s Sentence
x = String -> Sentence
S ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
s String
"#")) Sentence -> Sentence -> Sentence
:+: String -> Sentence
S String
" " Sentence -> Sentence -> Sentence
:+: Sentence
x

-- | Helpers for extracting references -----------------------------------------

-- | Generic traverse of all positions that could lead to /symbolic/ 'UID's from 'Sentence's.
getUIDs :: Sentence -> [UID]
getUIDs :: Sentence -> [UID]
getUIDs (Ch SentenceStyle
ShortStyle TermCapitalization
_ UID
_) = []
getUIDs (Ch SentenceStyle
TermStyle TermCapitalization
_ UID
_)  = []
getUIDs (Ch SentenceStyle
PluralTerm TermCapitalization
_ UID
_) = []
getUIDs (SyCh UID
a)            = [UID
a]
getUIDs Sy {}               = []
getUIDs NP {}               = []
getUIDs S {}                = []
getUIDs P {}                = []
getUIDs Ref {}              = []
getUIDs Sentence
Percent             = []
getUIDs ((:+:) Sentence
a Sentence
b)         = Sentence -> [UID]
getUIDs Sentence
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Sentence -> [UID]
getUIDs Sentence
b
getUIDs (Quote Sentence
a)           = Sentence -> [UID]
getUIDs Sentence
a
getUIDs (E ModelExpr
a)               = ModelExpr -> [UID]
meNames ModelExpr
a
getUIDs Sentence
EmptyS              = []

-- | Generic traverse of all positions that could lead to /symbolic/ and /abbreviated/ 'UID's from 'Sentence's
-- but doesn't go into expressions.
getUIDshort :: Sentence -> [UID]
getUIDshort :: Sentence -> [UID]
getUIDshort (Ch SentenceStyle
ShortStyle TermCapitalization
_ UID
a) = [UID
a]
getUIDshort (Ch SentenceStyle
TermStyle TermCapitalization
_ UID
_)  = []
getUIDshort (Ch SentenceStyle
PluralTerm TermCapitalization
_ UID
_) = []
getUIDshort SyCh {}             = []
getUIDshort Sy {}               = []
getUIDshort NP {}               = []
getUIDshort S {}                = []
getUIDshort Sentence
Percent             = []
getUIDshort P {}                = []
getUIDshort Ref {}              = []
getUIDshort ((:+:) Sentence
a Sentence
b)         = Sentence -> [UID]
getUIDshort Sentence
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Sentence -> [UID]
getUIDshort Sentence
b
getUIDshort (Quote Sentence
a)           = Sentence -> [UID]
getUIDshort Sentence
a
getUIDshort E {}                = []
getUIDshort Sentence
EmptyS              = []

-----------------------------------------------------------------------------
-- And now implement the exported traversals all in terms of the above
-- | This is to collect /symbolic/ 'UID's that are printed out as a 'Symbol'.
sdep :: Sentence -> Set.Set UID
sdep :: Sentence -> Set UID
sdep = [UID] -> Set UID
forall a. Ord a => [a] -> Set a
Set.fromList ([UID] -> Set UID) -> (Sentence -> [UID]) -> Sentence -> Set UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sentence -> [UID]
getUIDs
{-# INLINE sdep #-}

-- This is to collect symbolic 'UID's that are printed out as an /abbreviation/.
shortdep :: Sentence -> Set.Set UID
shortdep :: Sentence -> Set UID
shortdep = [UID] -> Set UID
forall a. Ord a => [a] -> Set a
Set.fromList ([UID] -> Set UID) -> (Sentence -> [UID]) -> Sentence -> Set UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sentence -> [UID]
getUIDshort
{-# INLINE shortdep #-}

-- | Generic traverse of all positions that could lead to /reference/ 'UID's from 'Sentence's.
lnames :: Sentence -> Set.Set UID
lnames :: Sentence -> Set UID
lnames Ch {}       = Set UID
forall a. Set a
Set.empty
lnames SyCh {}     = Set UID
forall a. Set a
Set.empty
lnames Sy {}       = Set UID
forall a. Set a
Set.empty
lnames NP {}       = Set UID
forall a. Set a
Set.empty
lnames S {}        = Set UID
forall a. Set a
Set.empty
lnames Sentence
Percent     = Set UID
forall a. Set a
Set.empty
lnames P {}        = Set UID
forall a. Set a
Set.empty
lnames (Ref UID
a Sentence
_ RefInfo
_) = UID -> Set UID
forall a. a -> Set a
Set.singleton UID
a
lnames ((:+:) Sentence
a Sentence
b) = Sentence -> Set UID
lnames Sentence
a Set UID -> Set UID -> Set UID
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Sentence -> Set UID
lnames Sentence
b
lnames Quote {}    = Set UID
forall a. Set a
Set.empty
lnames E {}        = Set UID
forall a. Set a
Set.empty
lnames Sentence
EmptyS      = Set UID
forall a. Set a
Set.empty
{-# INLINE lnames #-}

-- | Get /reference/ 'UID's from 'Sentence's.
lnames' :: [Sentence] -> [UID]
lnames' :: [Sentence] -> [UID]
lnames' = (Sentence -> [UID]) -> [Sentence] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set UID -> [UID]
forall a. Set a -> [a]
Set.toList (Set UID -> [UID]) -> (Sentence -> Set UID) -> Sentence -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sentence -> Set UID
lnames)
{-# INLINE lnames' #-}

sentenceRefs :: Sentence -> Set.Set UID
sentenceRefs :: Sentence -> Set UID
sentenceRefs Sentence
sent = [Set UID] -> Set UID
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Sentence -> Set UID
lnames Sentence
sent, Sentence -> Set UID
sdep Sentence
sent, Sentence -> Set UID
shortdep Sentence
sent]
{-# INLINE sentenceRefs #-}

instance HasChunkRefs Sentence where
  chunkRefs :: Sentence -> Set UID
chunkRefs = Sentence -> Set UID
sentenceRefs
  {-# INLINABLE chunkRefs #-}