src/Literate/Document/Type.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3
   4 module Literate.Document.Type where
   5
   6 import Data.List qualified as List
   7 import Data.Sequence qualified as Seq
   8 import Data.Time.Format.ISO8601 qualified as Time
   9 import Data.Time.LocalTime qualified as Time
  10 import Literate.Prelude
  11 import Text.Blaze.Html5 qualified as HTML
  12 import Prelude qualified
  13
  14 data Document = Document
  15   { documentTitle :: Inline
  16   , documentAttachments :: Map Text [Text]
  17   , documentPages :: [Page]
  18   }
  19   deriving (Eq, Show)
  20
  21 data Page = Page
  22   { pageContent :: Block
  23   , pageSize :: PageSize
  24   , pageOrientation :: PageOrientation
  25   , pageNumber :: Maybe Natural
  26   , pageNumberTotal :: Maybe Natural
  27   , pageSide :: Maybe PageSide
  28   , pageSection :: Maybe Inline
  29   }
  30   deriving (Eq, Show)
  31 page =
  32   Page
  33     { pageContent = []
  34     , pageSize = PageSizeA4
  35     , pageOrientation = PageOrientationPortrait
  36     , pageNumber = Nothing
  37     , pageNumberTotal = Nothing
  38     , pageSide = Nothing
  39     , pageSection = Nothing
  40     }
  41
  42 data PageSide
  43   = PageSideLeft
  44   | PageSideRight
  45   deriving (Eq, Show)
  46
  47 data PageSize
  48   = PageSizeA5
  49   | PageSizeA4
  50   | PageSizeA4Plus
  51   | PageSizeA3
  52   deriving (Eq, Show)
  53
  54 data PageOrientation
  55   = PageOrientationPortrait
  56   | PageOrientationLandscape
  57   deriving (Eq, Show)
  58
  59 newtype Ident = Ident {unIdent :: Text}
  60   deriving (Eq, Ord, Show, HTML.ToValue, IsString)
  61 newtype Class = Class {unClass :: Text}
  62   deriving (Eq, Ord, Show, HTML.ToValue, IsString)
  63 newtype Semantic = Semantic {unSemantic :: Text}
  64   deriving (Eq, Ord, Show, HTML.ToValue, IsString)
  65
  66 data Layout = Layout
  67   { layoutTop :: Block
  68   , layoutBottom :: Block
  69   , layoutCenter :: Block
  70   , layoutLeft :: Block
  71   , layoutRight :: Block
  72   }
  73   deriving (Eq, Show)
  74
  75 data Block
  76   = BlockDict Dict
  77   | BlockDiv (Container Block)
  78   | BlockFlex Flex
  79   | BlockList List
  80   | BlockPara Inline
  81   | BlockTable Table
  82   | Blocks (Seq.Seq Block)
  83   deriving (Eq, Show)
  84 emptyBlock = Blocks []
  85 instance Semigroup Block where
  86   Blocks x <> Blocks y = Blocks (x <> y)
  87   Blocks x <> y = Blocks (x Seq.|> y)
  88   x <> Blocks y = Blocks (x Seq.<| y)
  89   x <> y = Blocks [x, y]
  90 instance Monoid Block where
  91   mempty = Blocks []
  92 instance IsString Block where
  93   fromString = BlockPara . toInline
  94 instance IsList Block where
  95   type Item Block = Block
  96   fromList = Blocks . fromList
  97   toList (Blocks xs) = xs & toList
  98   toList x = [x]
  99
 100 data Container a = Container
 101   { containerAnchor :: Maybe Ident
 102   , containerClasses :: [Class]
 103   , containerSemantic :: Maybe Semantic
 104   , containerContent :: a
 105   }
 106   deriving (Eq, Show)
 107 container a =
 108   Container
 109     { containerAnchor = Nothing
 110     , containerClasses = []
 111     , containerSemantic = Nothing
 112     , containerContent = a
 113     }
 114 section x = (container x){containerSemantic = Just "section"}
 115
 116 class Classes a where
 117   classes :: [Class] -> a -> a
 118 instance Classes Block where
 119   classes cs x =
 120     BlockDiv $
 121       (container x)
 122         { containerClasses = cs
 123         }
 124 instance Classes Inline where
 125   classes cs x =
 126     InlineSpan $
 127       (container x)
 128         { containerClasses = cs
 129         }
 130
 131 data Target = Target {unTarget :: Text}
 132   deriving (Eq, Show)
 133 instance IsString Target where
 134   fromString = Target . fromString
 135
 136 data Inline
 137   = InlineCode Text
 138   | InlineLink {inlineLinkText :: Inline, inlineLinkTarget :: Target}
 139   | InlineStrong Inline
 140   | InlineText Text
 141   | InlineSpan (Container Inline)
 142   | Inlines (Seq.Seq Inline)
 143   {-
 144   \| InlineEmph [Inline]              -- ^ Emphasized text (list of inlines)
 145   \| InlineUnderline [Inline]         -- ^ Underlined text (list of inlines)
 146   \| InlineStrikeout [Inline]         -- ^ Strikeout text (list of inlines)
 147   \| InlineSuperscript [Inline]       -- ^ Superscripted text (list of inlines)
 148   \| InlineSubscript [Inline]         -- ^ Subscripted text (list of inlines)
 149   \| InlineSmallCaps [Inline]         -- ^ Small caps text (list of inlines)
 150   \| InlineQuoted QuoteType [Inline]  -- ^ Quoted text (list of inlines)
 151   \| InlineCite [Citation]  [Inline]  -- ^ Citation (list of inlines)
 152   \| InlineSpace                      -- ^ Inter-word space
 153   \| InlineSoftBreak                  -- ^ Soft line break
 154   \| InlineLineBreak                  -- ^ Hard line break
 155   \| InlineMath MathType Text         -- ^ TeX math (literal)
 156   \| InlineRawInline Format Text      -- ^ Raw inline
 157   \| InlineImage Attr [Inline] Target -- ^ Image:  alt text (list of inlines), target
 158   \| InlineNote [Block]               -- ^ Footnote or endnote
 159   -}
 160   deriving (Eq, Show)
 161 instance Semigroup Inline where
 162   Inlines x <> Inlines y = Inlines (x <> y)
 163   Inlines x <> y = Inlines (x Seq.|> y)
 164   x <> Inlines y = Inlines (x Seq.<| y)
 165   x <> y = Inlines [x, y]
 166 instance Monoid Inline where
 167   mempty = Inlines []
 168 instance IsString Inline where
 169   fromString = InlineText . fromString
 170 instance IsList Inline where
 171   type Item Inline = Inline
 172   fromList = Inlines . fromList
 173   toList (Inlines xs) = xs & toList
 174   toList x = [x]
 175 words :: [Inline] -> Inline
 176 words = List.intersperse (InlineText " ") >>> mconcat
 177 commas :: [Inline] -> Inline
 178 commas = List.intersperse (InlineText ",") >>> mconcat
 179 inlineSpace = InlineText " "
 180
 181 inlineLinkExplicit :: Target -> Inline
 182 inlineLinkExplicit to =
 183   InlineLink
 184     { inlineLinkText = to & unTarget & toInline
 185     , inlineLinkTarget = to
 186     }
 187
 188 data Flex = Flex
 189   { flexItems :: [FlexItem]
 190   , flexDirection :: FlexDirection
 191   , flexGap :: LengthAbsolute
 192   , flexJustifyContent :: Maybe Justify
 193   , flexJustifyItems :: Maybe Justify
 194   , flexAlignContent :: Maybe Align
 195   , flexAlignItems :: Maybe Align
 196   }
 197   deriving (Eq, Show)
 198
 199 flex =
 200   Flex
 201     { flexItems = []
 202     , flexDirection = FlexDirectionColumn
 203     , flexGap = 0 & mm
 204     , flexJustifyContent = Nothing
 205     , flexJustifyItems = Nothing
 206     , flexAlignContent = Nothing
 207     , flexAlignItems = Nothing
 208     }
 209
 210 data Align
 211   = AlignCenter
 212   | AlignBaseline
 213   | AlignBaselineFirst
 214   | AlignBaselineLast
 215   | AlignEnd
 216   | AlignSpaceAround
 217   | AlignSpaceBetween
 218   | AlignSpaceEvenly
 219   | AlignStart
 220   | AlignStretch
 221   deriving (Eq, Show)
 222
 223 data Justify
 224   = JustifyCenter
 225   | JustifyEnd
 226   | JustifySpaceAround
 227   | JustifySpaceBetween
 228   | JustifySpaceEvenly
 229   | JustifyStart
 230   deriving (Eq, Show)
 231
 232 data FlexDirection
 233   = FlexDirectionColumn
 234   | FlexDirectionRow
 235   deriving (Eq, Show)
 236
 237 data FlexItem = FlexItem
 238   { flexItemContent :: Block
 239   , flexItemAlignSelf :: Maybe Align
 240   , flexItemJustifySelf :: Maybe Justify
 241   }
 242   deriving (Eq, Show)
 243
 244 flexItem =
 245   FlexItem
 246     { flexItemContent = []
 247     , flexItemAlignSelf = Nothing
 248     , flexItemJustifySelf = Nothing
 249     }
 250
 251 data List = List {listItems :: [(Inline, Block)]}
 252   deriving (Eq, Show)
 253
 254 type TableTemplate = [Length]
 255 data Table = Table
 256   { tableHeads :: Maybe TableHead
 257   , tableTemplate :: TableTemplate
 258   , tableRowsEvenOdd :: Bool
 259   , tableRows :: [TableRow]
 260   }
 261   deriving (Eq, Show)
 262
 263 data TableHead = TableHead
 264   { tableHeadColumns :: [TableCell]
 265   }
 266   deriving (Eq, Show)
 267 instance IsList TableHead where
 268   type Item TableHead = TableCell
 269   fromList = TableHead . fromList
 270   toList = tableHeadColumns
 271
 272 data TableRow = TableRow
 273   { tableRowColumns :: [TableCell]
 274   }
 275   deriving (Eq, Show)
 276 instance IsList TableRow where
 277   type Item TableRow = TableCell
 278   fromList = TableRow . fromList
 279   toList = tableRowColumns
 280
 281 data TableCell = TableCell
 282   { tableCellContent :: Block
 283   , tableCellJustify :: Justify
 284   , tableCellAlign :: Align
 285   }
 286   deriving (Eq, Show)
 287 tableCell =
 288   TableCell
 289     { tableCellContent = mempty
 290     , tableCellJustify = JustifyCenter
 291     , tableCellAlign = AlignCenter
 292     }
 293 instance IsString TableCell where
 294   fromString s =
 295     tableCell
 296       { tableCellContent = s & fromString
 297       }
 298
 299 data Dict = Dict
 300   { dictEntries :: [DictEntry]
 301   }
 302   deriving (Eq, Show)
 303
 304 type DictEntry = (Inline, Block)
 305
 306 data LengthAbsolute
 307   = LengthAbsoluteMillimeters Double
 308   deriving (Eq, Show)
 309 data LengthRelative
 310   = LengthRelativeFractionalRatio Natural
 311   | LengthRelativeMaxContent
 312   | LengthRelativeMinContent
 313   deriving (Eq, Show)
 314
 315 data Length
 316   = LengthAbsolute LengthAbsolute
 317   | LengthRelative LengthRelative
 318   deriving (Eq, Show)
 319
 320 cm :: Double -> LengthAbsolute
 321 cm = LengthAbsoluteMillimeters . (Prelude.* 10)
 322 mm :: Double -> LengthAbsolute
 323 mm = LengthAbsoluteMillimeters
 324 fr :: Natural -> LengthRelative
 325 fr = LengthRelativeFractionalRatio
 326
 327 class ToInline a where
 328   toInline :: a -> Inline
 329 instance ToInline String where toInline x = InlineText (fromString x)
 330 instance ToInline Int where toInline x = InlineText (fromString (show x))
 331 instance ToInline Text where toInline x = InlineText x
 332 instance ToInline (Container Inline) where toInline = InlineSpan
 333 instance ToInline [Inline] where toInline = Inlines . fromList
 334 instance ToInline Time.LocalTime where
 335   toInline t = t & Time.localDay & Time.iso8601Show & fromString
 336
 337 class ToBlock a where
 338   toBlock :: a -> Block
 339 instance ToBlock Block where toBlock = id
 340 instance ToBlock Dict where toBlock = BlockDict
 341 instance ToBlock (Container Block) where toBlock = BlockDiv
 342 instance ToBlock Flex where toBlock = BlockFlex
 343 instance ToBlock Inline where toBlock = BlockPara
 344 instance ToBlock Int where toBlock i = i & show & toBlock
 345 instance ToBlock Integer where toBlock i = i & show & toBlock
 346 instance ToBlock List where toBlock = BlockList
 347 instance ToBlock String where toBlock = fromString
 348 instance ToBlock Table where toBlock = BlockTable
 349 instance ToBlock Text where toBlock = BlockPara . toInline
 350 instance ToBlock [Block] where toBlock = Blocks . fromList
 351 instance ToBlock Time.LocalTime where
 352   toBlock t = t & Time.localDay & Time.iso8601Show & fromString