-- | Defines functions to transform Drasil-based documents into a printable version.
module Language.Drasil.Printing.Import.Document where

import Language.Drasil hiding (neg, sec, symbol, isIn, codeExpr)
import Language.Drasil.Development (showUID)

import qualified Language.Drasil.Printing.AST as P
import qualified Language.Drasil.Printing.Citation as P
import qualified Language.Drasil.Printing.LayoutObj as T
import Language.Drasil.Printing.PrintingInformation
  (PrintingInformation)

import Language.Drasil.Printing.Import.ModelExpr (modelExpr)
import Language.Drasil.Printing.Import.CodeExpr (codeExpr)
import Language.Drasil.Printing.Import.Sentence (spec)

import Control.Lens ((^.))
import Data.Bifunctor (bimap, second)

-- * Main Function

-- | Translates from 'Document' to a printable representation of 'T.Document'.
makeDocument :: PrintingInformation -> Document -> T.Document
makeDocument :: PrintingInformation -> Document -> Document
makeDocument PrintingInformation
sm (Document Title
titleLb Title
authorName ShowTableOfContents
_ [Section]
sections) =
  Title -> Title -> [LayoutObj] -> Document
T.Document (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
titleLb) (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
authorName) (PrintingInformation -> [Section] -> [LayoutObj]
createLayout PrintingInformation
sm [Section]
sections)
makeDocument PrintingInformation
sm (Notebook Title
titleLb Title
authorName [Section]
sections) =
  Title -> Title -> [LayoutObj] -> Document
T.Document (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
titleLb) (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
authorName) (PrintingInformation -> [Section] -> [LayoutObj]
createLayout' PrintingInformation
sm [Section]
sections)

-- * Helpers

-- | Helper function for creating sections as layout objects.
createLayout :: PrintingInformation -> [Section] -> [T.LayoutObj]
createLayout :: PrintingInformation -> [Section] -> [LayoutObj]
createLayout PrintingInformation
sm = forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Int -> Section -> LayoutObj
sec PrintingInformation
sm Int
0)

createLayout' :: PrintingInformation -> [Section] -> [T.LayoutObj]
createLayout' :: PrintingInformation -> [Section] -> [LayoutObj]
createLayout' PrintingInformation
sm = forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Int -> Section -> LayoutObj
cel PrintingInformation
sm Int
0)

-- | Helper function for creating sections at the appropriate depth.
sec :: PrintingInformation -> Int -> Section -> T.LayoutObj
sec :: PrintingInformation -> Int -> Section -> LayoutObj
sec PrintingInformation
sm Int
depth x :: Section
x@(Section Title
titleLb [SecCons]
contents Reference
_) = --FIXME: should ShortName be used somewhere?
  let refr :: Title
refr = String -> Title
P.S (forall s. Referable s => s -> String
refAdd Section
x) in
  Tags -> [LayoutObj] -> Title -> LayoutObj
T.HDiv [forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate Int
depth String
"sub") forall a. [a] -> [a] -> [a]
++ String
"section"]
  (Int -> Title -> Title -> LayoutObj
T.Header Int
depth (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
titleLb) Title
refr forall a. a -> [a] -> [a]
:
   forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Int -> SecCons -> LayoutObj
layout PrintingInformation
sm Int
depth) [SecCons]
contents) Title
refr

cel :: PrintingInformation -> Int -> Section -> T.LayoutObj
cel :: PrintingInformation -> Int -> Section -> LayoutObj
cel PrintingInformation
sm Int
depth x :: Section
x@(Section Title
titleLb [SecCons]
contents Reference
_) = 
  let refr :: Title
refr = String -> Title
P.S (forall s. Referable s => s -> String
refAdd Section
x) in
  [LayoutObj] -> LayoutObj
T.Cell (Int -> Title -> Title -> LayoutObj
T.Header Int
depth (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
titleLb) Title
refr forall a. a -> [a] -> [a]
:
   forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Int -> SecCons -> LayoutObj
layout PrintingInformation
sm Int
depth) [SecCons]
contents) 

-- | Helper for translating sections into a printable representation of layout objects ('T.LayoutObj').
layout :: PrintingInformation -> Int -> SecCons -> T.LayoutObj
layout :: PrintingInformation -> Int -> SecCons -> LayoutObj
layout PrintingInformation
sm Int
currDepth (Sub Section
s) = PrintingInformation -> Int -> Section -> LayoutObj
sec PrintingInformation
sm (Int
currDepthforall a. Num a => a -> a -> a
+Int
1) Section
s
layout PrintingInformation
sm Int
_         (Con Contents
c) = PrintingInformation -> Contents -> LayoutObj
lay PrintingInformation
sm Contents
c

-- | Helper that translates 'Contents' to a printable representation of 'T.LayoutObj'.
-- Called internally by 'layout'.
lay :: PrintingInformation -> Contents -> T.LayoutObj
lay :: PrintingInformation -> Contents -> LayoutObj
lay PrintingInformation
sm (LlC LabelledContent
x) = PrintingInformation -> LabelledContent -> LayoutObj
layLabelled PrintingInformation
sm LabelledContent
x
lay PrintingInformation
sm (UlC UnlabelledContent
x) = PrintingInformation -> RawContent -> LayoutObj
layUnlabelled PrintingInformation
sm (UnlabelledContent
x forall s a. s -> Getting a s a -> a
^. forall c. HasContents c => Lens' c RawContent
accessContents)

-- | Helper that translates 'LabelledContent's to a printable representation of 'T.LayoutObj'.
-- Called internally by 'lay'.
layLabelled :: PrintingInformation -> LabelledContent -> T.LayoutObj
layLabelled :: PrintingInformation -> LabelledContent -> LayoutObj
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (Table [Title]
hdr [[Title]]
lls Title
t Bool
b)) = Tags -> [[Title]] -> Title -> Bool -> Title -> LayoutObj
T.Table [String
"table"]
  (forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Title -> Title
spec PrintingInformation
sm) [Title]
hdr forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Title -> Title
spec PrintingInformation
sm)) [[Title]]
lls)
  (String -> Title
P.S forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd forall a b. (a -> b) -> a -> b
$ forall b. HasRefAddress b => b -> LblType
getRefAdd LabelledContent
x)
  Bool
b (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
t)
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (EqnBlock ModelExpr
c))          = Tags -> [LayoutObj] -> Title -> LayoutObj
T.HDiv [String
"equation"]
  [Title -> LayoutObj
T.EqnBlock (Expr -> Title
P.E (ModelExpr -> PrintingInformation -> Expr
modelExpr ModelExpr
c PrintingInformation
sm))]
  (String -> Title
P.S forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd forall a b. (a -> b) -> a -> b
$ forall b. HasRefAddress b => b -> LblType
getRefAdd LabelledContent
x)
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (Figure Title
c String
f MaxWidthPercent
wp))     = Title -> Title -> String -> MaxWidthPercent -> LayoutObj
T.Figure
  (String -> Title
P.S forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd forall a b. (a -> b) -> a -> b
$ forall b. HasRefAddress b => b -> LblType
getRefAdd LabelledContent
x)
  (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
c) String
f MaxWidthPercent
wp
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (Graph [(Title, Title)]
ps Maybe MaxWidthPercent
w Maybe MaxWidthPercent
h Title
t))    = [(Title, Title)]
-> Maybe MaxWidthPercent
-> Maybe MaxWidthPercent
-> Title
-> Title
-> LayoutObj
T.Graph
  (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (PrintingInformation -> Title -> Title
spec PrintingInformation
sm) (PrintingInformation -> Title -> Title
spec PrintingInformation
sm)) [(Title, Title)]
ps) Maybe MaxWidthPercent
w Maybe MaxWidthPercent
h (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
t)
  (String -> Title
P.S forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd forall a b. (a -> b) -> a -> b
$ forall b. HasRefAddress b => b -> LblType
getRefAdd LabelledContent
x)
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (Defini DType
dtyp [(String, [Contents])]
pairs)) = DType -> [(String, [LayoutObj])] -> Title -> LayoutObj
T.Definition
  DType
dtyp (forall {a}. [(a, [Contents])] -> [(a, [LayoutObj])]
layPairs [(String, [Contents])]
pairs)
  (String -> Title
P.S forall a b. (a -> b) -> a -> b
$ LblType -> String
getAdd forall a b. (a -> b) -> a -> b
$ forall b. HasRefAddress b => b -> LblType
getRefAdd LabelledContent
x)
  where layPairs :: [(a, [Contents])] -> [(a, [LayoutObj])]
layPairs = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Contents -> LayoutObj
lay PrintingInformation
sm)))
layLabelled PrintingInformation
sm (LblC Reference
_ (Paragraph Title
c))    = Title -> LayoutObj
T.Paragraph (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
c)
layLabelled PrintingInformation
sm x :: LabelledContent
x@(LblC Reference
_ (DerivBlock Title
h [RawContent]
d)) = Tags -> [LayoutObj] -> Title -> LayoutObj
T.HDiv [String
"subsubsubsection"]
  (Int -> Title -> Title -> LayoutObj
T.Header Int
3 (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
h) Title
refr forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> RawContent -> LayoutObj
layUnlabelled PrintingInformation
sm) [RawContent]
d) Title
refr
  where refr :: Title
refr = String -> Title
P.S forall a b. (a -> b) -> a -> b
$ forall s. Referable s => s -> String
refAdd LabelledContent
x forall a. [a] -> [a] -> [a]
++ String
"Deriv"
layLabelled PrintingInformation
sm (LblC Reference
_ (Enumeration ListType
cs)) = ListType -> LayoutObj
T.List forall a b. (a -> b) -> a -> b
$ PrintingInformation -> ListType -> ListType
makeL PrintingInformation
sm ListType
cs
layLabelled  PrintingInformation
_ (LblC Reference
_ (Bib BibRef
bib))        = BibRef -> LayoutObj
T.Bib forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Citation -> Citation
layCite BibRef
bib
layLabelled PrintingInformation
sm (LblC Reference
_ (CodeBlock CodeExpr
c))  = Title -> LayoutObj
T.CodeBlock (Expr -> Title
P.E (CodeExpr -> PrintingInformation -> Expr
codeExpr CodeExpr
c PrintingInformation
sm))

-- | Helper that translates 'RawContent's to a printable representation of 'T.LayoutObj'.
-- Called internally by 'lay'.
layUnlabelled :: PrintingInformation -> RawContent -> T.LayoutObj
layUnlabelled :: PrintingInformation -> RawContent -> LayoutObj
layUnlabelled PrintingInformation
sm (Table [Title]
hdr [[Title]]
lls Title
t Bool
b) = Tags -> [[Title]] -> Title -> Bool -> Title -> LayoutObj
T.Table [String
"table"]
  (forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Title -> Title
spec PrintingInformation
sm) [Title]
hdr forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Title -> Title
spec PrintingInformation
sm)) [[Title]]
lls) (String -> Title
P.S String
"nolabel0") Bool
b (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
t)
layUnlabelled PrintingInformation
sm (Paragraph Title
c)    = Title -> LayoutObj
T.Paragraph (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
c)
layUnlabelled PrintingInformation
sm (EqnBlock ModelExpr
c)     = Tags -> [LayoutObj] -> Title -> LayoutObj
T.HDiv [String
"equation"] [Title -> LayoutObj
T.EqnBlock (Expr -> Title
P.E (ModelExpr -> PrintingInformation -> Expr
modelExpr ModelExpr
c PrintingInformation
sm))] Title
P.EmptyS
layUnlabelled PrintingInformation
sm (DerivBlock Title
h [RawContent]
d) = Tags -> [LayoutObj] -> Title -> LayoutObj
T.HDiv [String
"subsubsubsection"]
  (Int -> Title -> Title -> LayoutObj
T.Header Int
3 (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
h) Title
refr forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> RawContent -> LayoutObj
layUnlabelled PrintingInformation
sm) [RawContent]
d) Title
refr
  where refr :: Title
refr = String -> Title
P.S String
"nolabel1"
layUnlabelled PrintingInformation
sm (Enumeration ListType
cs) = ListType -> LayoutObj
T.List forall a b. (a -> b) -> a -> b
$ PrintingInformation -> ListType -> ListType
makeL PrintingInformation
sm ListType
cs
layUnlabelled PrintingInformation
sm (Figure Title
c String
f MaxWidthPercent
wp)  = Title -> Title -> String -> MaxWidthPercent -> LayoutObj
T.Figure (String -> Title
P.S String
"nolabel2") (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
c) String
f MaxWidthPercent
wp
layUnlabelled PrintingInformation
sm (Graph [(Title, Title)]
ps Maybe MaxWidthPercent
w Maybe MaxWidthPercent
h Title
t) = [(Title, Title)]
-> Maybe MaxWidthPercent
-> Maybe MaxWidthPercent
-> Title
-> Title
-> LayoutObj
T.Graph (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (PrintingInformation -> Title -> Title
spec PrintingInformation
sm) (PrintingInformation -> Title -> Title
spec PrintingInformation
sm)) [(Title, Title)]
ps)
                               Maybe MaxWidthPercent
w Maybe MaxWidthPercent
h (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
t) (String -> Title
P.S String
"nolabel6")
layUnlabelled PrintingInformation
sm (Defini DType
dtyp [(String, [Contents])]
pairs)  = DType -> [(String, [LayoutObj])] -> Title -> LayoutObj
T.Definition DType
dtyp (forall {a}. [(a, [Contents])] -> [(a, [LayoutObj])]
layPairs [(String, [Contents])]
pairs) (String -> Title
P.S String
"nolabel7")
  where layPairs :: [(a, [Contents])] -> [(a, [LayoutObj])]
layPairs = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (a -> b) -> [a] -> [b]
map forall {s}. HasContents s => s -> LayoutObj
temp))
        temp :: s -> LayoutObj
temp  s
y   = PrintingInformation -> RawContent -> LayoutObj
layUnlabelled PrintingInformation
sm (s
y forall s a. s -> Getting a s a -> a
^. forall c. HasContents c => Lens' c RawContent
accessContents)
layUnlabelled  PrintingInformation
_ (Bib BibRef
bib)              = BibRef -> LayoutObj
T.Bib forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Citation -> Citation
layCite BibRef
bib
layUnlabelled PrintingInformation
sm (CodeBlock CodeExpr
c)     = Title -> LayoutObj
T.CodeBlock (Expr -> Title
P.E (CodeExpr -> PrintingInformation -> Expr
codeExpr CodeExpr
c PrintingInformation
sm))

-- | For importing a bibliography.
layCite :: Citation -> P.Citation
layCite :: Citation -> Citation
layCite Citation
c = String -> CitationKind -> [CiteField] -> Citation
P.Cite (forall a. HasUID a => a -> String
showUID Citation
c) (Citation
c forall s a. s -> Getting a s a -> a
^. Lens' Citation CitationKind
citeKind) (forall a b. (a -> b) -> [a] -> [b]
map CiteField -> CiteField
layField (Citation
c forall s a. s -> Getting a s a -> a
^. forall c. HasFields c => Lens' c [CiteField]
getFields))

-- | Helper for translating 'Citefield's into a printable representation of 'P.CiteField's
layField :: CiteField -> P.CiteField
layField :: CiteField -> CiteField
layField (Address      String
s) = Title -> CiteField
P.Address      forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
s
layField (Author       People
p) = People -> CiteField
P.Author       People
p
layField (BookTitle    String
b) = Title -> CiteField
P.BookTitle    forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
b
layField (Chapter      Int
c) = Int -> CiteField
P.Chapter      Int
c
layField (Edition      Int
e) = Int -> CiteField
P.Edition      Int
e
layField (Editor       People
e) = People -> CiteField
P.Editor       People
e
layField (Institution  String
i) = Title -> CiteField
P.Institution  forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
i
layField (Journal      String
j) = Title -> CiteField
P.Journal      forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
j
layField (Month        Month
m) = Month -> CiteField
P.Month        Month
m
layField (Note         String
n) = Title -> CiteField
P.Note         forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
n
layField (Number       Int
n) = Int -> CiteField
P.Number       Int
n
layField (Organization String
o) = Title -> CiteField
P.Organization forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
o
layField (Pages        [Int]
p) = [Int] -> CiteField
P.Pages        [Int]
p
layField (Publisher    String
p) = Title -> CiteField
P.Publisher    forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
p
layField (School       String
s) = Title -> CiteField
P.School       forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
s
layField (Series       String
s) = Title -> CiteField
P.Series       forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
s
layField (Title        String
t) = Title -> CiteField
P.Title        forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
t
layField (Type         String
t) = Title -> CiteField
P.Type         forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
t
layField (Volume       Int
v) = Int -> CiteField
P.Volume       Int
v
layField (Year         Int
y) = Int -> CiteField
P.Year         Int
y
layField (HowPublished (URL  String
u)) = HP -> CiteField
P.HowPublished (Title -> HP
P.URL  forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
u)
layField (HowPublished (Verb String
v)) = HP -> CiteField
P.HowPublished (Title -> HP
P.Verb forall a b. (a -> b) -> a -> b
$ String -> Title
P.S String
v)

-- | Translates lists to be printable.
makeL :: PrintingInformation -> ListType -> P.ListType
makeL :: PrintingInformation -> ListType -> ListType
makeL PrintingInformation
sm (Bullet [(ItemType, Maybe String)]
bs)      = [(ItemType, Maybe Title)] -> ListType
P.Unordered   forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Title
P.S)) [(ItemType, Maybe String)]
bs
makeL PrintingInformation
sm (Numeric [(ItemType, Maybe String)]
ns)     = [(ItemType, Maybe Title)] -> ListType
P.Ordered     forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Title
P.S)) [(ItemType, Maybe String)]
ns
makeL PrintingInformation
sm (Simple [ListTuple]
ps)      = [(Title, ItemType, Maybe Title)] -> ListType
P.Simple      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe String
z) -> (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
x, PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm ItemType
y, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Title
P.S Maybe String
z)) [ListTuple]
ps
makeL PrintingInformation
sm (Desc [ListTuple]
ps)        = [(Title, ItemType, Maybe Title)] -> ListType
P.Desc        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe String
z) -> (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
x, PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm ItemType
y, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Title
P.S Maybe String
z)) [ListTuple]
ps
makeL PrintingInformation
sm (Definitions [ListTuple]
ps) = [(Title, ItemType, Maybe Title)] -> ListType
P.Definitions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Title
x,ItemType
y,Maybe String
z) -> (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
x, PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm ItemType
y, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Title
P.S Maybe String
z)) [ListTuple]
ps

-- | Helper for translating list items to be printable.
item :: PrintingInformation -> ItemType -> P.ItemType
item :: PrintingInformation -> ItemType -> ItemType
item PrintingInformation
sm (Flat Title
i)     = Title -> ItemType
P.Flat forall a b. (a -> b) -> a -> b
$ PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
i
item PrintingInformation
sm (Nested Title
t ListType
s) = Title -> ListType -> ItemType
P.Nested (PrintingInformation -> Title -> Title
spec PrintingInformation
sm Title
t) (PrintingInformation -> ListType -> ListType
makeL PrintingInformation
sm ListType
s)