haddock2/src/Types.hs

module Types (
  DocMarkup (..),
  Document (..),
  Meta (..),
  ModuleLink (..),
  Package,
  Since (..),
  Version,
)
where

newtype Document = Document
  { meta :: Meta
  }
  deriving (Eq, Show)

newtype Meta = Meta
  { since :: Maybe Since
  }
  deriving (Eq, Show)

data Since = Since
  { package :: Maybe Package
  -- ^ optional package qualification
  , version :: Version
  }
  deriving (Eq, Show)

-- Could have a better type?
type Version = [Int]
type Package = String

data DocMarkup mod id
  = DocEmpty
  | -- | This is not represented in the markup language, this is for internal use
    DocAppend (DocMarkup mod id) (DocMarkup mod id)
  | -- | Any text that doesn't match any rules is a bare string
    DocString String
  | -- | Paragraphs are demarcated by blank lines
    DocParagraph (DocMarkup mod id)
  | -- | A haskell identifier
    DocIdentifier id
  | -- | A qualified identifier that couldn't be resolved.
    DocIdentifierUnchecked
  | -- | A link to a module, might include a label
    DocModule (ModuleLink (DocMarkup mod id))
  | -- | Emphasis /italics/
    DocEmphasis (DocMarkup mod id)
  | -- | Monospaced @source code@
    DocMonospace (DocMarkup mod id)
  | -- | Bold __bold text__
    DocBold (DocMarkup mod id)
  | {- | Unordered lists
      * this
      or
      - this
    -}
    DocUnorderedList [DocMarkup mod id]
  | {- | Ordered lists
      1. this
      or
      (1) this
    -}
    DocOrderedList [(Int, DocMarkup mod id)]
  | {- | Definition lists
      [term] a term
      [another term] another definition
    -}
    DocDefinitionList [(DocMarkup mod id, DocMarkup mod id)]
  | {- | Code blocks
      @
      a code block in here
      with multiple lines
      @

      Or with bird tracks:
      > some code
      > goes here
    -}
    DocCodeBlock (DocMarkup mod id)
  | {- | Hyperlinks
      __marked__:
      <http://example.com>
      <http://example.com label text>
      __Auto-detected URLs__:
      http://example.com
      https://example.com
      ftp://example.com
      __Markdown style__
      [link text](http://example.com)
      [link text]("Module.Name")
    -}
    DocHyperlink (Hyperlink (DocMarkup mod id))
  | {- | Pictures
        <<image.png>>
        <<image.png title text>>

        __Markdown Images__

        ![alt text](image.png)
    -}
    DocPicture Picture
  | {- | Inline math expressions
      \(mathematical expression\)
    -}
    DocMathInline String
  | {- | Math multiline display
    \[
      mathematical expression
      in multiple lines
    \]
    -}
    DocMathDisplay String
  | {- | Anchors, no spaces allowed
      #anchor-name#
    -}
    DocAnchor String
  | {- | Property descriptions
      prop> property description
    -}
    DocProperty String
  | {- | Examples
      >>> expression
      result line 1
      result line 2
    -}
    DocExamples [Example]
  | -- | Header
    DocHeader (Header (DocMarkup mod id))
  | -- Table
    DocTable (Table (DocMarkup mod id))
  deriving (Eq, Show)

instance Semigroup (DocMarkup mod id) where
  (<>) = DocAppend

instance Monoid (DocMarkup mod id) where
  mempty = DocEmpty
  mconcat = foldr (<>) mempty

data ModuleLink id = ModuleLink
  { name :: String
  , label :: Maybe id
  }
  deriving (Eq, Show)

data Picture = Picture
  { uri :: String
  , title :: Maybe String
  }
  deriving (Eq, Show)

data Hyperlink id = Hyperlink
  { url :: String
  , label :: Maybe id
  }
  deriving (Eq, Show, Functor, Foldable, Traversable)

data TableCell id = TableCell
  { col :: Int
  , row :: Int
  , content :: id
  }
  deriving (Eq, Show, Functor, Foldable, Traversable)

newtype TableRow id = TableRow
  { rows :: [TableCell id]
  }
  deriving (Eq, Show, Functor, Foldable, Traversable)

data Table id = Table
  { headerRows :: [TableRow id]
  , bodyRows :: [TableRow id]
  }
  deriving (Eq, Show, Functor, Foldable, Traversable)

data Example = Example
  { exampleExpression :: String
  , exampleResult :: [String]
  }
  deriving (Eq, Show)

data Header id = Header
  { level :: HeaderLevel
  , title :: id
  }
  deriving (Eq, Show)

data HeaderLevel
  = H1
  | H2
  | H3
  | H4
  | H5
  | H6
  deriving (Eq, Show, Bounded, Enum)