Render.hs

{-# LANGUAGE OverloadedStrings #-}

module Erd.Render
  (htmlAttr,
   htmlFont,
   recordAttr,
   withLabelFmt
  ) where

import qualified Erd.ER                            as ER

import qualified Data.GraphViz.Attributes.Complete as A
import qualified Data.GraphViz.Attributes.HTML     as H
import qualified Data.Text.Lazy                    as L
import           Text.Printf                       (printf)

-- | Converts a single attribute to an HTML table row.
htmlAttr :: ER.Attribute -> H.Row
htmlAttr a = H.Cells [cell]
  where cell    = H.LabelCell cellAttrs (H.Text $ withLabelFmt " [%s]" opts name)
        name    = fkfmt $ pkfmt $ htmlFont opts (ER.field a)
        pkfmt s = if ER.pk a then [H.Format H.Underline s] else s
        fkfmt s = if ER.fk a then [H.Format H.Italics s] else s
        opts    = ER.aoptions a
        cellAttrs = ER.optionsTo ER.optToHtml opts
-- | Converts a single attribute to a RecordField ( an element of a dot table )
recordAttr :: ER.Attribute -> A.RecordField
recordAttr a = A.FieldLabel $ ER.field a -- should change to add port support!
-- | Formats an arbitrary string with the options given (using only font
-- attributes).
htmlFont :: ER.Options -> L.Text -> H.Text
htmlFont opts s = [H.Font (ER.optionsTo ER.optToFont opts) [H.Str s]]

-- | Formats HTML text with a label. The format string given should be
-- in `Data.Text.printf` style. (Only font options are used from the options
-- given.)
withLabelFmt :: String -> ER.Options -> H.Text -> H.Text
withLabelFmt fmt opts s =
  case ER.optionsTo ER.optToLabel opts of
    (x:_) -> s ++ htmlFont opts (L.pack $ printf fmt $ L.unpack x)
    _     -> s