Formatting.hs

module Data.Gibberish.Formatting
  ( FormatOpts (..),
    MaxLen (..),
    MaxHeight (..),
    Separator (..),
    ExactNumberWords (..),
    formatWords,
    formatLine,
  ) where

import Data.Gibberish.Types

import Data.List (intersperse)
import Data.Text (Text ())
import Data.Text qualified as Text
import Prelude hiding (Word ())

data FormatOpts = FormatOpts
  { optMaxLen :: MaxLen,
    optMaxHeight :: MaxHeight,
    optSeparator :: Separator,
    optExactWords :: Maybe ExactNumberWords
  }
  deriving stock (Eq, Show)

newtype MaxLen = MaxLen {unMaxLen :: Int}
  deriving stock (Eq, Show)
  deriving newtype (Enum, Integral, Num, Ord, Real)

newtype MaxHeight = MaxHeight {unMaxHeight :: Int}
  deriving stock (Eq, Show)
  deriving newtype (Enum, Integral, Num, Ord, Real)

newtype Separator = Separator {unSeparator :: Text}
  deriving stock (Eq, Show)

newtype ExactNumberWords = ExactNumberWords {unExactWords :: Int}
  deriving stock (Eq, Show)
  deriving newtype (Enum, Integral, Num, Ord, Real)

newtype FormatText = FormatText {fmtLines :: [FormatLine]}
  deriving stock (Eq, Show)

data FormatLine = FormatLine
  { fmtSeparator :: Separator,
    fmtWords :: [Word]
  }
  deriving stock (Eq, Show)

-- | Format a list of words to a text blob
formatWords :: FormatOpts -> [Word] -> Text
formatWords opts@FormatOpts {..} =
  renderFormatText . take' . formatWords' opts
  where
    take' :: FormatText -> FormatText
    take' =
      case optExactWords of
        Just (ExactNumberWords exact) -> takeWords exact
        Nothing -> takeLines (unMaxHeight optMaxHeight)

-- | Turn a list of words into a Format description. Note that we completely
-- ignore maxHeight and exactWords, resulting in a potentially infinite list
formatWords' :: FormatOpts -> [Word] -> FormatText
formatWords' opts words' =
  FormatText $
    line : fmtLines (formatWords' opts restWords)
  where
    line = formatLine opts words'
    -- TODO[sgillespie]: Benchmark this vs splitting
    restWords = drop (length $ fmtWords line) words'

-- | Format a single line of words, up to maxLen characters
formatLine :: FormatOpts -> [Word] -> FormatLine
formatLine FormatOpts {..} =
  FormatLine optSeparator
    . map Word
    . filter (/= unSeparator optSeparator)
    . concatLine (unMaxLen optMaxLen)
    . intersperse (unSeparator optSeparator)
    . map unWord
  where
    concatLine :: Int -> [Text] -> [Text]
    concatLine len (t : ts)
      | len - Text.length t > 0 = t : concatLine (len - Text.length t) ts
      | otherwise = []
    concatLine _ [] = error "Ran out of words"

-- | Render a Format description into a Text blob
renderFormatText :: FormatText -> Text
renderFormatText (FormatText fmt) =
  case fmt of
    [] -> ""
    l : ls -> renderFormatLine l <> "\n" <> renderFormatText' ls
  where
    renderFormatLine (FormatLine (Separator sep) ws) =
      Text.concat . intersperse sep . map unWord $ ws
    renderFormatText' ls = renderFormatText (FormatText ls)

takeLines :: Int -> FormatText -> FormatText
takeLines n (FormatText ls) = FormatText $ take n ls

takeWords :: Int -> FormatText -> FormatText
takeWords _ (FormatText []) = error "Ran out of words"
takeWords n (FormatText (l@(FormatLine sep ws) : ls))
  | n >= length ws = FormatText $ l : ls'
  | otherwise = FormatText [FormatLine sep (take n ws)]
  where
    (FormatText ls') = takeWords (n - length ws) (FormatText ls)