{-# Language TemplateHaskell #-}
-- | Contains types and functions common to aspects of generating documents.
module Language.Drasil.Document.Core where

import Language.Drasil.Chunk.Citation (BibRef)

import Language.Drasil.UID (HasUID(..))
import Language.Drasil.ShortName (HasShortName(shortname))
import Language.Drasil.ModelExpr.Lang (ModelExpr)
import Language.Drasil.CodeExpr.Lang (CodeExpr)
import Language.Drasil.Label.Type (getAdd, prepend, IRefProg,
  LblType(..), Referable(..), HasRefAddress(..))
import Language.Drasil.Reference (Reference)
import Language.Drasil.Sentence (Sentence)

import Control.Lens ((^.), makeLenses, Lens', set, view)

-- * Lists

-- | Denotes the different possible types that can be used as a list.
data ListType = Bullet      [(ItemType, Maybe String)] -- ^ Bulleted list.
              | Numeric     [(ItemType, Maybe String)] -- ^ Enumerated list.
              | Simple      [ListTuple] -- ^ Simple list with items denoted by @:@. Renders as "Title: Item"
              | Desc        [ListTuple] -- ^ Descriptive list, renders as "__Title__: Item" (see 'ListTuple').
              | Definitions [ListTuple] -- ^ Renders a list of "@'Title'@ is the @Item@".

-- | Denotes how something should behave in a list ('ListType').
data ItemType = Flat Sentence -- ^ Standard singular item.
              | Nested Header ListType -- ^ Nest a list ('ListType') as an item.

-- | MaxWidthPercent should be kept in the range 1-100.
-- Values outside this range may have unexpected results.
-- Used for specifying max figure width as
-- @pagewidth*MaxWidthPercent/100@.
type MaxWidthPercent = Float

type Title    = Sentence
type Author   = Sentence
type Header   = Sentence -- ^ Used when creating sublists.
type Depth    = Int
type Width    = Float
type Height   = Float
type ListTuple = (Title, ItemType, Maybe String) -- ^ Formats as Title: Item. For use in lists.
type Filepath = String
type Lbl      = Sentence  -- ^ Label.

-- * Contents

-- | Contents may be labelled or unlabelled.
data Contents = UlC UnlabelledContent
              | LlC LabelledContent

-- For 'Defini' below.  From DocumentLanguage.Definitions
--   tmodel, TM, mkTMField [ Para, EqnBlock, Enumeration]
--   ddefn, DD, mkDDField [Para, EqnBlock, Enumeration]
--   gdefn, General, mkGDField [Para, EqnBlock, Enumeration]
--   instanceModel, Instance, mkIMField [Para, EqnBlock, Enumeration]

-- | Types of definitions (general, instance, theory, or data).
data DType = General
           | Instance
           | Theory
           | Data

-- | Indicates whether a figure has a caption or not.
data HasCaption = NoCaption | WithCaption
  deriving (HasCaption -> HasCaption -> Bool
(HasCaption -> HasCaption -> Bool)
-> (HasCaption -> HasCaption -> Bool) -> Eq HasCaption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HasCaption -> HasCaption -> Bool
== :: HasCaption -> HasCaption -> Bool
$c/= :: HasCaption -> HasCaption -> Bool
/= :: HasCaption -> HasCaption -> Bool
Eq) 

-- | Types of layout objects we deal with explicitly.
data RawContent =
    Table [Sentence] [[Sentence]] Title Bool -- ^ table has: header-row, data(rows), label/caption, and a bool that determines whether or not to show label.
  | Paragraph Sentence                       -- ^ Paragraphs are just sentences.
  | EqnBlock ModelExpr                       -- ^ Block of Equations holds an expression.
  | DerivBlock Sentence [RawContent]         -- ^ Grants the ability to label a group of 'RawContent'.
  | Enumeration ListType                     -- ^ For enumerated lists.
  | Defini DType [(Identifier, [Contents])]  -- ^ Defines something with a type, identifier, and 'Contents'.
  | Figure Lbl Filepath MaxWidthPercent HasCaption
                                             -- ^ For creating figures in a document includes whether the figure has a caption.
  | Bib BibRef                               -- ^ Grants the ability to reference something.
  | Graph [(Sentence, Sentence)] (Maybe Width) (Maybe Height) Lbl -- ^ Contain a graph with coordinates ('Sentence's), maybe a width and height, and a label ('Sentence').
  | CodeBlock CodeExpr                       -- ^ Block for codes
               -- TODO: Fill this one in.

-- | An identifier is just a 'String'.
type Identifier = String

-- | Contains a 'Reference' and 'RawContent'.
data LabelledContent = LblC { LabelledContent -> Reference
_ref :: Reference
                            , LabelledContent -> RawContent
_ctype :: RawContent
                            }

-- | Only contains 'RawContent'.                         
newtype UnlabelledContent = UnlblC { UnlabelledContent -> RawContent
_cntnts :: RawContent }

makeLenses ''LabelledContent
makeLenses ''UnlabelledContent

-- FIXME: this is here temporarily due to import cycles
-- | Members of this class must have 'RawContent'.
class HasContents c where
  -- | Provides a 'Lens' to the 'RawContent'.
  accessContents :: Lens' c RawContent

-- | Finds 'UID' of the 'LabelledContent'.
instance HasUID        LabelledContent where uid :: Getter LabelledContent UID
uid = (Reference -> f Reference) -> LabelledContent -> f LabelledContent
Lens' LabelledContent Reference
ref ((Reference -> f Reference)
 -> LabelledContent -> f LabelledContent)
-> ((UID -> f UID) -> Reference -> f Reference)
-> (UID -> f UID)
-> LabelledContent
-> f LabelledContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> Reference -> f Reference
forall c. HasUID c => Getter c UID
Getter Reference UID
uid
-- | 'LabelledContent's are equal if their reference 'UID's are equal.
instance Eq            LabelledContent where LabelledContent
a == :: LabelledContent -> LabelledContent -> Bool
== LabelledContent
b = (LabelledContent
a LabelledContent -> Getting UID LabelledContent UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID LabelledContent UID
forall c. HasUID c => Getter c UID
Getter LabelledContent UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (LabelledContent
b LabelledContent -> Getting UID LabelledContent UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID LabelledContent UID
forall c. HasUID c => Getter c UID
Getter LabelledContent UID
uid) 
-- | Finds the reference address contained in the 'Reference' of 'LabelledContent'.
instance HasRefAddress LabelledContent where getRefAdd :: LabelledContent -> LblType
getRefAdd (LblC Reference
lb RawContent
c) = IRefProg -> String -> LblType
RP (RawContent -> IRefProg
prependLabel RawContent
c) (String -> LblType) -> String -> LblType
forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd (LblType -> String) -> LblType -> String
forall a b. (a -> b) -> a -> b
$ Reference -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd Reference
lb
-- | Access the 'RawContent' within the 'LabelledContent'.
instance HasContents   LabelledContent where accessContents :: Lens' LabelledContent RawContent
accessContents = (RawContent -> f RawContent)
-> LabelledContent -> f LabelledContent
Lens' LabelledContent RawContent
ctype
-- | Find the shortname of the reference address used for the 'LabelledContent'.
instance HasShortName  LabelledContent where shortname :: LabelledContent -> ShortName
shortname = Reference -> ShortName
forall s. HasShortName s => s -> ShortName
shortname (Reference -> ShortName)
-> (LabelledContent -> Reference) -> LabelledContent -> ShortName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Reference LabelledContent Reference
-> LabelledContent -> Reference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Reference LabelledContent Reference
Lens' LabelledContent Reference
ref

-- | Access the 'RawContent' within the 'UnlabelledContent'.
instance HasContents  UnlabelledContent where accessContents :: Lens' UnlabelledContent RawContent
accessContents = (RawContent -> f RawContent)
-> UnlabelledContent -> f UnlabelledContent
Iso' UnlabelledContent RawContent
cntnts

-- | Access the 'RawContent' within 'Contents'.
instance HasContents Contents where
  accessContents :: Lens' Contents RawContent
accessContents RawContent -> f RawContent
f (UlC UnlabelledContent
c) = (RawContent -> Contents) -> f RawContent -> f Contents
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents)
-> (RawContent -> UnlabelledContent) -> RawContent -> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\RawContent
x -> ASetter UnlabelledContent UnlabelledContent RawContent RawContent
-> RawContent -> UnlabelledContent -> UnlabelledContent
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UnlabelledContent UnlabelledContent RawContent RawContent
Iso' UnlabelledContent RawContent
cntnts RawContent
x UnlabelledContent
c)) (RawContent -> f RawContent
f (RawContent -> f RawContent) -> RawContent -> f RawContent
forall a b. (a -> b) -> a -> b
$ UnlabelledContent
c UnlabelledContent
-> Getting RawContent UnlabelledContent RawContent -> RawContent
forall s a. s -> Getting a s a -> a
^. Getting RawContent UnlabelledContent RawContent
Iso' UnlabelledContent RawContent
cntnts)
  accessContents RawContent -> f RawContent
f (LlC LabelledContent
c) = (RawContent -> Contents) -> f RawContent -> f Contents
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LabelledContent -> Contents
LlC (LabelledContent -> Contents)
-> (RawContent -> LabelledContent) -> RawContent -> Contents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\RawContent
x -> ASetter LabelledContent LabelledContent RawContent RawContent
-> RawContent -> LabelledContent -> LabelledContent
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter LabelledContent LabelledContent RawContent RawContent
Lens' LabelledContent RawContent
ctype RawContent
x LabelledContent
c)) (RawContent -> f RawContent
f (RawContent -> f RawContent) -> RawContent -> f RawContent
forall a b. (a -> b) -> a -> b
$ LabelledContent
c LabelledContent
-> Getting RawContent LabelledContent RawContent -> RawContent
forall s a. s -> Getting a s a -> a
^. Getting RawContent LabelledContent RawContent
Lens' LabelledContent RawContent
ctype)

-- | Finds the reference information of 'LabelledContent'.
instance Referable LabelledContent where
  refAdd :: LabelledContent -> String
refAdd       = LblType -> String
getAdd (LblType -> String)
-> (LabelledContent -> LblType) -> LabelledContent -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelledContent -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd
  renderRef :: LabelledContent -> LblType
renderRef   = LabelledContent -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd

-- * Helper

-- | Helper to prepend labels to 'LabelledContent' when referencing.
prependLabel :: RawContent -> IRefProg
prependLabel :: RawContent -> IRefProg
prependLabel Table{}        = String -> IRefProg
prepend String
"Tab"
prependLabel Figure{}       = String -> IRefProg
prepend String
"Fig"
prependLabel Graph{}        = String -> IRefProg
prepend String
"Fig"
prependLabel Defini{}       = String -> IRefProg
prepend String
"Def"
prependLabel EqnBlock{}     = String -> IRefProg
prepend String
"EqnB"
prependLabel CodeBlock{}    = String -> IRefProg
prepend String
"CodeB"
prependLabel DerivBlock{}   = String -> IRefProg
prepend String
"Deriv"
prependLabel Enumeration{}  = String -> IRefProg
prepend String
"Lst"
prependLabel Paragraph{}    = String -> IRefProg
forall a. HasCallStack => String -> a
error String
"Shouldn't reference paragraphs"
prependLabel Bib{}          = String -> IRefProg
forall a. HasCallStack => String -> a
error (String -> IRefProg) -> String -> IRefProg
forall a b. (a -> b) -> a -> b
$ 
    String
"Bibliography list of references cannot be referenced. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"You must reference the Section or an individual citation."