{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}

module Literate.Document.Type where

import Data.List qualified as List
import Data.Sequence qualified as Seq
import Data.Time.Format.ISO8601 qualified as Time
import Data.Time.LocalTime qualified as Time
import Literate.Prelude
import Text.Blaze.Html5 qualified as HTML
import Prelude qualified

data Document = Document
  { documentTitle :: Inline
  , documentAttachments :: Map Text [Text]
  , documentPages :: [Page]
  }
  deriving (Eq, Show)

data Page = Page
  { pageContent :: Block
  , pageSize :: PageSize
  , pageOrientation :: PageOrientation
  , pageNumber :: Maybe Natural
  , pageNumberTotal :: Maybe Natural
  , pageSide :: Maybe PageSide
  , pageSection :: Maybe Inline
  }
  deriving (Eq, Show)
page =
  Page
    { pageContent = []
    , pageSize = PageSizeA4
    , pageOrientation = PageOrientationPortrait
    , pageNumber = Nothing
    , pageNumberTotal = Nothing
    , pageSide = Nothing
    , pageSection = Nothing
    }

data PageSide
  = PageSideLeft
  | PageSideRight
  deriving (Eq, Show)

data PageSize
  = PageSizeA5
  | PageSizeA4
  | PageSizeA4Plus
  | PageSizeA3
  deriving (Eq, Show)

data PageOrientation
  = PageOrientationPortrait
  | PageOrientationLandscape
  deriving (Eq, Show)

newtype Ident = Ident {unIdent :: Text}
  deriving (Eq, Ord, Show, HTML.ToValue, IsString)
newtype Class = Class {unClass :: Text}
  deriving (Eq, Ord, Show, HTML.ToValue, IsString)
newtype Semantic = Semantic {unSemantic :: Text}
  deriving (Eq, Ord, Show, HTML.ToValue, IsString)

data Layout = Layout
  { layoutTop :: Block
  , layoutBottom :: Block
  , layoutCenter :: Block
  , layoutLeft :: Block
  , layoutRight :: Block
  }
  deriving (Eq, Show)

data Block
  = BlockDict Dict
  | BlockDiv (Container Block)
  | BlockFlex Flex
  | BlockList List
  | BlockPara Inline
  | BlockTable Table
  | Blocks (Seq.Seq Block)
  deriving (Eq, Show)
emptyBlock = Blocks []
instance Semigroup Block where
  Blocks x <> Blocks y = Blocks (x <> y)
  Blocks x <> y = Blocks (x Seq.|> y)
  x <> Blocks y = Blocks (x Seq.<| y)
  x <> y = Blocks [x, y]
instance Monoid Block where
  mempty = Blocks []
instance IsString Block where
  fromString = BlockPara . toInline
instance IsList Block where
  type Item Block = Block
  fromList = Blocks . fromList
  toList (Blocks xs) = xs & toList
  toList x = [x]

data Container a = Container
  { containerAnchor :: Maybe Ident
  , containerClasses :: [Class]
  , containerSemantic :: Maybe Semantic
  , containerContent :: a
  }
  deriving (Eq, Show)
container a =
  Container
    { containerAnchor = Nothing
    , containerClasses = []
    , containerSemantic = Nothing
    , containerContent = a
    }
section x = (container x){containerSemantic = Just "section"}

class Classes a where
  classes :: [Class] -> a -> a
instance Classes Block where
  classes cs x =
    BlockDiv $
      (container x)
        { containerClasses = cs
        }
instance Classes Inline where
  classes cs x =
    InlineSpan $
      (container x)
        { containerClasses = cs
        }

data Target = Target {unTarget :: Text}
  deriving (Eq, Show)
instance IsString Target where
  fromString = Target . fromString

data Inline
  = InlineCode Text
  | InlineLink {inlineLinkText :: Inline, inlineLinkTarget :: Target}
  | InlineStrong Inline
  | InlineText Text
  | InlineSpan (Container Inline)
  | Inlines (Seq.Seq Inline)
  {-
  \| InlineEmph [Inline]              -- ^ Emphasized text (list of inlines)
  \| InlineUnderline [Inline]         -- ^ Underlined text (list of inlines)
  \| InlineStrikeout [Inline]         -- ^ Strikeout text (list of inlines)
  \| InlineSuperscript [Inline]       -- ^ Superscripted text (list of inlines)
  \| InlineSubscript [Inline]         -- ^ Subscripted text (list of inlines)
  \| InlineSmallCaps [Inline]         -- ^ Small caps text (list of inlines)
  \| InlineQuoted QuoteType [Inline]  -- ^ Quoted text (list of inlines)
  \| InlineCite [Citation]  [Inline]  -- ^ Citation (list of inlines)
  \| InlineSpace                      -- ^ Inter-word space
  \| InlineSoftBreak                  -- ^ Soft line break
  \| InlineLineBreak                  -- ^ Hard line break
  \| InlineMath MathType Text         -- ^ TeX math (literal)
  \| InlineRawInline Format Text      -- ^ Raw inline
  \| InlineImage Attr [Inline] Target -- ^ Image:  alt text (list of inlines), target
  \| InlineNote [Block]               -- ^ Footnote or endnote
  -}
  deriving (Eq, Show)
instance Semigroup Inline where
  Inlines x <> Inlines y = Inlines (x <> y)
  Inlines x <> y = Inlines (x Seq.|> y)
  x <> Inlines y = Inlines (x Seq.<| y)
  x <> y = Inlines [x, y]
instance Monoid Inline where
  mempty = Inlines []
instance IsString Inline where
  fromString = InlineText . fromString
instance IsList Inline where
  type Item Inline = Inline
  fromList = Inlines . fromList
  toList (Inlines xs) = xs & toList
  toList x = [x]
words :: [Inline] -> Inline
words = List.intersperse (InlineText " ") >>> mconcat
commas :: [Inline] -> Inline
commas = List.intersperse (InlineText ",") >>> mconcat
inlineSpace = InlineText " "

inlineLinkExplicit :: Target -> Inline
inlineLinkExplicit to =
  InlineLink
    { inlineLinkText = to & unTarget & toInline
    , inlineLinkTarget = to
    }

data Flex = Flex
  { flexItems :: [FlexItem]
  , flexDirection :: FlexDirection
  , flexGap :: LengthAbsolute
  , flexJustifyContent :: Maybe Justify
  , flexJustifyItems :: Maybe Justify
  , flexAlignContent :: Maybe Align
  , flexAlignItems :: Maybe Align
  }
  deriving (Eq, Show)

flex =
  Flex
    { flexItems = []
    , flexDirection = FlexDirectionColumn
    , flexGap = 0 & mm
    , flexJustifyContent = Nothing
    , flexJustifyItems = Nothing
    , flexAlignContent = Nothing
    , flexAlignItems = Nothing
    }

data Align
  = AlignCenter
  | AlignBaseline
  | AlignBaselineFirst
  | AlignBaselineLast
  | AlignEnd
  | AlignSpaceAround
  | AlignSpaceBetween
  | AlignSpaceEvenly
  | AlignStart
  | AlignStretch
  deriving (Eq, Show)

data Justify
  = JustifyCenter
  | JustifyEnd
  | JustifySpaceAround
  | JustifySpaceBetween
  | JustifySpaceEvenly
  | JustifyStart
  deriving (Eq, Show)

data FlexDirection
  = FlexDirectionColumn
  | FlexDirectionRow
  deriving (Eq, Show)

data FlexItem = FlexItem
  { flexItemContent :: Block
  , flexItemAlignSelf :: Maybe Align
  , flexItemJustifySelf :: Maybe Justify
  }
  deriving (Eq, Show)

flexItem =
  FlexItem
    { flexItemContent = []
    , flexItemAlignSelf = Nothing
    , flexItemJustifySelf = Nothing
    }

data List = List {listItems :: [(Inline, Block)]}
  deriving (Eq, Show)

type TableTemplate = [Length]
data Table = Table
  { tableHeads :: Maybe TableHead
  , tableTemplate :: TableTemplate
  , tableRowsEvenOdd :: Bool
  , tableRows :: [TableRow]
  }
  deriving (Eq, Show)

data TableHead = TableHead
  { tableHeadColumns :: [TableCell]
  }
  deriving (Eq, Show)
instance IsList TableHead where
  type Item TableHead = TableCell
  fromList = TableHead . fromList
  toList = tableHeadColumns

data TableRow = TableRow
  { tableRowColumns :: [TableCell]
  }
  deriving (Eq, Show)
instance IsList TableRow where
  type Item TableRow = TableCell
  fromList = TableRow . fromList
  toList = tableRowColumns

data TableCell = TableCell
  { tableCellContent :: Block
  , tableCellJustify :: Justify
  , tableCellAlign :: Align
  }
  deriving (Eq, Show)
tableCell =
  TableCell
    { tableCellContent = mempty
    , tableCellJustify = JustifyCenter
    , tableCellAlign = AlignCenter
    }
instance IsString TableCell where
  fromString s =
    tableCell
      { tableCellContent = s & fromString
      }

data Dict = Dict
  { dictEntries :: [DictEntry]
  }
  deriving (Eq, Show)

type DictEntry = (Inline, Block)

data LengthAbsolute
  = LengthAbsoluteMillimeters Double
  deriving (Eq, Show)
data LengthRelative
  = LengthRelativeFractionalRatio Natural
  | LengthRelativeMaxContent
  | LengthRelativeMinContent
  deriving (Eq, Show)

data Length
  = LengthAbsolute LengthAbsolute
  | LengthRelative LengthRelative
  deriving (Eq, Show)

cm :: Double -> LengthAbsolute
cm = LengthAbsoluteMillimeters . (Prelude.* 10)
mm :: Double -> LengthAbsolute
mm = LengthAbsoluteMillimeters
fr :: Natural -> LengthRelative
fr = LengthRelativeFractionalRatio

class ToInline a where
  toInline :: a -> Inline
instance ToInline String where toInline x = InlineText (fromString x)
instance ToInline Int where toInline x = InlineText (fromString (show x))
instance ToInline Text where toInline x = InlineText x
instance ToInline (Container Inline) where toInline = InlineSpan
instance ToInline [Inline] where toInline = Inlines . fromList
instance ToInline Time.LocalTime where
  toInline t = t & Time.localDay & Time.iso8601Show & fromString

class ToBlock a where
  toBlock :: a -> Block
instance ToBlock Block where toBlock = id
instance ToBlock Dict where toBlock = BlockDict
instance ToBlock (Container Block) where toBlock = BlockDiv
instance ToBlock Flex where toBlock = BlockFlex
instance ToBlock Inline where toBlock = BlockPara
instance ToBlock [Inline] where toBlock = BlockPara . toInline
instance ToBlock Int where toBlock i = i & show & toBlock
instance ToBlock Integer where toBlock i = i & show & toBlock
instance ToBlock List where toBlock = BlockList
instance ToBlock String where toBlock = fromString
instance ToBlock Table where toBlock = BlockTable
instance ToBlock Text where toBlock = BlockPara . toInline
instance ToBlock [Block] where toBlock = Blocks . fromList
instance ToBlock Time.LocalTime where
  toBlock t = t & Time.localDay & Time.iso8601Show & fromString