{-# Language TemplateHaskell #-}
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.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)
data ListType = Bullet [(ItemType, Maybe String)]
| Numeric [(ItemType, Maybe String)]
| Simple [ListTuple]
| Desc [ListTuple]
| Definitions [ListTuple]
data ItemType = Flat Sentence
| Nested Header ListType
type MaxWidthPercent = Float
type Title = Sentence
type Author = Sentence
type = Sentence
type Depth = Int
type Width = Float
type Height = Float
type ListTuple = (Title, ItemType, Maybe String)
type Filepath = String
type Lbl = Sentence
data Contents = UlC UnlabelledContent
| LlC LabelledContent
data DType = General
| Instance
| Theory
| Data
data RawContent =
Table [Sentence] [[Sentence]] Title Bool
| Paragraph Sentence
| EqnBlock ModelExpr
| DerivBlock Sentence [RawContent]
| Enumeration ListType
| Defini DType [(Identifier, [Contents])]
| Figure Lbl Filepath MaxWidthPercent
| Bib BibRef
| Graph [(Sentence, Sentence)] (Maybe Width) (Maybe Height) Lbl
type Identifier = String
data LabelledContent = LblC { LabelledContent -> Reference
_ref :: Reference
, LabelledContent -> RawContent
_ctype :: RawContent
}
newtype UnlabelledContent = UnlblC { UnlabelledContent -> RawContent
_cntnts :: RawContent }
makeLenses ''LabelledContent
makeLenses ''UnlabelledContent
class HasContents c where
accessContents :: Lens' c RawContent
instance HasUID LabelledContent where uid :: (UID -> f UID) -> LabelledContent -> f LabelledContent
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 => Lens' c UID
uid
instance Eq LabelledContent where a :: LabelledContent
a == :: LabelledContent -> LabelledContent -> Bool
== b :: 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 => Lens' c 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 => Lens' c UID
uid)
instance HasRefAddress LabelledContent where getRefAdd :: LabelledContent -> LblType
getRefAdd (LblC lb :: Reference
lb c :: 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
instance HasContents LabelledContent where accessContents :: (RawContent -> f RawContent)
-> LabelledContent -> f LabelledContent
accessContents = (RawContent -> f RawContent)
-> LabelledContent -> f LabelledContent
Lens' LabelledContent RawContent
ctype
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
instance HasContents UnlabelledContent where accessContents :: (RawContent -> f RawContent)
-> UnlabelledContent -> f UnlabelledContent
accessContents = (RawContent -> f RawContent)
-> UnlabelledContent -> f UnlabelledContent
Iso' UnlabelledContent RawContent
cntnts
instance HasContents Contents where
accessContents :: (RawContent -> f RawContent) -> Contents -> f Contents
accessContents f :: RawContent -> f RawContent
f (UlC c :: UnlabelledContent
c) = (RawContent -> Contents) -> f RawContent -> f Contents
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
. (\x :: 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 f :: RawContent -> f RawContent
f (LlC c :: LabelledContent
c) = (RawContent -> Contents) -> f RawContent -> f Contents
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
. (\x :: 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)
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
prependLabel :: RawContent -> IRefProg
prependLabel :: RawContent -> IRefProg
prependLabel Table{} = String -> IRefProg
prepend "Tab"
prependLabel Figure{} = String -> IRefProg
prepend "Fig"
prependLabel Graph{} = String -> IRefProg
prepend "Fig"
prependLabel Defini{} = String -> IRefProg
prepend "Def"
prependLabel EqnBlock{} = String -> IRefProg
prepend "EqnB"
prependLabel DerivBlock{} = String -> IRefProg
prepend "Deriv"
prependLabel Enumeration{} = String -> IRefProg
prepend "Lst"
prependLabel Paragraph{} = String -> IRefProg
forall a. HasCallStack => String -> a
error "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
$
"Bibliography list of references cannot be referenced. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"You must reference the Section or an individual citation."