{-# 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,
  sentenceTerm,
  sdep, lnames, lnames'
) where

import Data.Char (toUpper)

import Drasil.Database (HasChunkRefs(..), UID, IsChunk, UIDRef, hide, raw)

import Language.Drasil.Chunk.NamedIdea (Idea)
import Language.Drasil.ExprClasses (Express(express))
import Language.Drasil.ModelExpr.Lang (ModelExpr)
import Language.Drasil.ModelExpr.Extract (meDep)
import Language.Drasil.NaturalLanguage.English.NounPhrase.Core (NP)
import Language.Drasil.UnitLang (USymb)
import Language.Drasil.Space (HasSpace)
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  :: (IsChunk t, Idea t, HasSpace t, HasSymbol t) => UIDRef t -> 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

-- | Gets a symbol and places it in a 'Sentence'.
ch :: (IsChunk t, Idea t, HasSpace t, HasSymbol t) => t -> Sentence
ch :: forall t.
(IsChunk t, Idea t, HasSpace t, HasSymbol t) =>
t -> Sentence
ch t
s = UIDRef t -> Sentence
forall t.
(IsChunk t, Idea t, HasSpace t, HasSymbol t) =>
UIDRef t -> Sentence
SyCh (UIDRef t -> Sentence) -> UIDRef t -> Sentence
forall a b. (a -> b) -> a -> b
$ t -> UIDRef t
forall t. IsChunk t => t -> UIDRef t
hide t
s

-- | 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, 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 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 UIDRef t
a)            = [UIDRef t -> UID
forall t. UIDRef t -> UID
raw UIDRef t
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]
meDep ModelExpr
a
getUIDs 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 #-}

-- | 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' #-}

instance HasChunkRefs Sentence where
  chunkRefs :: Sentence -> Set UID
chunkRefs Sentence
s = [Set UID] -> Set UID
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Sentence -> Set UID
lnames Sentence
s, Sentence -> Set UID
sdep Sentence
s]
  {-# INLINABLE chunkRefs #-}