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
  { FormatOpts -> MaxLen
optMaxLen :: MaxLen,
    FormatOpts -> MaxHeight
optMaxHeight :: MaxHeight,
    FormatOpts -> Separator
optSeparator :: Separator,
    FormatOpts -> Maybe ExactNumberWords
optExactWords :: Maybe ExactNumberWords
  }
  deriving stock (FormatOpts -> FormatOpts -> Bool
(FormatOpts -> FormatOpts -> Bool)
-> (FormatOpts -> FormatOpts -> Bool) -> Eq FormatOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatOpts -> FormatOpts -> Bool
== :: FormatOpts -> FormatOpts -> Bool
$c/= :: FormatOpts -> FormatOpts -> Bool
/= :: FormatOpts -> FormatOpts -> Bool
Eq, Int -> FormatOpts -> ShowS
[FormatOpts] -> ShowS
FormatOpts -> String
(Int -> FormatOpts -> ShowS)
-> (FormatOpts -> String)
-> ([FormatOpts] -> ShowS)
-> Show FormatOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatOpts -> ShowS
showsPrec :: Int -> FormatOpts -> ShowS
$cshow :: FormatOpts -> String
show :: FormatOpts -> String
$cshowList :: [FormatOpts] -> ShowS
showList :: [FormatOpts] -> ShowS
Show)

newtype MaxLen = MaxLen {MaxLen -> Int
unMaxLen :: Int}
  deriving stock (MaxLen -> MaxLen -> Bool
(MaxLen -> MaxLen -> Bool)
-> (MaxLen -> MaxLen -> Bool) -> Eq MaxLen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxLen -> MaxLen -> Bool
== :: MaxLen -> MaxLen -> Bool
$c/= :: MaxLen -> MaxLen -> Bool
/= :: MaxLen -> MaxLen -> Bool
Eq, Int -> MaxLen -> ShowS
[MaxLen] -> ShowS
MaxLen -> String
(Int -> MaxLen -> ShowS)
-> (MaxLen -> String) -> ([MaxLen] -> ShowS) -> Show MaxLen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxLen -> ShowS
showsPrec :: Int -> MaxLen -> ShowS
$cshow :: MaxLen -> String
show :: MaxLen -> String
$cshowList :: [MaxLen] -> ShowS
showList :: [MaxLen] -> ShowS
Show)
  deriving newtype (Int -> MaxLen
MaxLen -> Int
MaxLen -> [MaxLen]
MaxLen -> MaxLen
MaxLen -> MaxLen -> [MaxLen]
MaxLen -> MaxLen -> MaxLen -> [MaxLen]
(MaxLen -> MaxLen)
-> (MaxLen -> MaxLen)
-> (Int -> MaxLen)
-> (MaxLen -> Int)
-> (MaxLen -> [MaxLen])
-> (MaxLen -> MaxLen -> [MaxLen])
-> (MaxLen -> MaxLen -> [MaxLen])
-> (MaxLen -> MaxLen -> MaxLen -> [MaxLen])
-> Enum MaxLen
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MaxLen -> MaxLen
succ :: MaxLen -> MaxLen
$cpred :: MaxLen -> MaxLen
pred :: MaxLen -> MaxLen
$ctoEnum :: Int -> MaxLen
toEnum :: Int -> MaxLen
$cfromEnum :: MaxLen -> Int
fromEnum :: MaxLen -> Int
$cenumFrom :: MaxLen -> [MaxLen]
enumFrom :: MaxLen -> [MaxLen]
$cenumFromThen :: MaxLen -> MaxLen -> [MaxLen]
enumFromThen :: MaxLen -> MaxLen -> [MaxLen]
$cenumFromTo :: MaxLen -> MaxLen -> [MaxLen]
enumFromTo :: MaxLen -> MaxLen -> [MaxLen]
$cenumFromThenTo :: MaxLen -> MaxLen -> MaxLen -> [MaxLen]
enumFromThenTo :: MaxLen -> MaxLen -> MaxLen -> [MaxLen]
Enum, Enum MaxLen
Real MaxLen
(Real MaxLen, Enum MaxLen) =>
(MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> (MaxLen, MaxLen))
-> (MaxLen -> MaxLen -> (MaxLen, MaxLen))
-> (MaxLen -> Integer)
-> Integral MaxLen
MaxLen -> Integer
MaxLen -> MaxLen -> (MaxLen, MaxLen)
MaxLen -> MaxLen -> MaxLen
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MaxLen -> MaxLen -> MaxLen
quot :: MaxLen -> MaxLen -> MaxLen
$crem :: MaxLen -> MaxLen -> MaxLen
rem :: MaxLen -> MaxLen -> MaxLen
$cdiv :: MaxLen -> MaxLen -> MaxLen
div :: MaxLen -> MaxLen -> MaxLen
$cmod :: MaxLen -> MaxLen -> MaxLen
mod :: MaxLen -> MaxLen -> MaxLen
$cquotRem :: MaxLen -> MaxLen -> (MaxLen, MaxLen)
quotRem :: MaxLen -> MaxLen -> (MaxLen, MaxLen)
$cdivMod :: MaxLen -> MaxLen -> (MaxLen, MaxLen)
divMod :: MaxLen -> MaxLen -> (MaxLen, MaxLen)
$ctoInteger :: MaxLen -> Integer
toInteger :: MaxLen -> Integer
Integral, Integer -> MaxLen
MaxLen -> MaxLen
MaxLen -> MaxLen -> MaxLen
(MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen)
-> (MaxLen -> MaxLen)
-> (MaxLen -> MaxLen)
-> (Integer -> MaxLen)
-> Num MaxLen
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MaxLen -> MaxLen -> MaxLen
+ :: MaxLen -> MaxLen -> MaxLen
$c- :: MaxLen -> MaxLen -> MaxLen
- :: MaxLen -> MaxLen -> MaxLen
$c* :: MaxLen -> MaxLen -> MaxLen
* :: MaxLen -> MaxLen -> MaxLen
$cnegate :: MaxLen -> MaxLen
negate :: MaxLen -> MaxLen
$cabs :: MaxLen -> MaxLen
abs :: MaxLen -> MaxLen
$csignum :: MaxLen -> MaxLen
signum :: MaxLen -> MaxLen
$cfromInteger :: Integer -> MaxLen
fromInteger :: Integer -> MaxLen
Num, Eq MaxLen
Eq MaxLen =>
(MaxLen -> MaxLen -> Ordering)
-> (MaxLen -> MaxLen -> Bool)
-> (MaxLen -> MaxLen -> Bool)
-> (MaxLen -> MaxLen -> Bool)
-> (MaxLen -> MaxLen -> Bool)
-> (MaxLen -> MaxLen -> MaxLen)
-> (MaxLen -> MaxLen -> MaxLen)
-> Ord MaxLen
MaxLen -> MaxLen -> Bool
MaxLen -> MaxLen -> Ordering
MaxLen -> MaxLen -> MaxLen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MaxLen -> MaxLen -> Ordering
compare :: MaxLen -> MaxLen -> Ordering
$c< :: MaxLen -> MaxLen -> Bool
< :: MaxLen -> MaxLen -> Bool
$c<= :: MaxLen -> MaxLen -> Bool
<= :: MaxLen -> MaxLen -> Bool
$c> :: MaxLen -> MaxLen -> Bool
> :: MaxLen -> MaxLen -> Bool
$c>= :: MaxLen -> MaxLen -> Bool
>= :: MaxLen -> MaxLen -> Bool
$cmax :: MaxLen -> MaxLen -> MaxLen
max :: MaxLen -> MaxLen -> MaxLen
$cmin :: MaxLen -> MaxLen -> MaxLen
min :: MaxLen -> MaxLen -> MaxLen
Ord, Num MaxLen
Ord MaxLen
(Num MaxLen, Ord MaxLen) => (MaxLen -> Rational) -> Real MaxLen
MaxLen -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MaxLen -> Rational
toRational :: MaxLen -> Rational
Real)

newtype MaxHeight = MaxHeight {MaxHeight -> Int
unMaxHeight :: Int}
  deriving stock (MaxHeight -> MaxHeight -> Bool
(MaxHeight -> MaxHeight -> Bool)
-> (MaxHeight -> MaxHeight -> Bool) -> Eq MaxHeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxHeight -> MaxHeight -> Bool
== :: MaxHeight -> MaxHeight -> Bool
$c/= :: MaxHeight -> MaxHeight -> Bool
/= :: MaxHeight -> MaxHeight -> Bool
Eq, Int -> MaxHeight -> ShowS
[MaxHeight] -> ShowS
MaxHeight -> String
(Int -> MaxHeight -> ShowS)
-> (MaxHeight -> String)
-> ([MaxHeight] -> ShowS)
-> Show MaxHeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxHeight -> ShowS
showsPrec :: Int -> MaxHeight -> ShowS
$cshow :: MaxHeight -> String
show :: MaxHeight -> String
$cshowList :: [MaxHeight] -> ShowS
showList :: [MaxHeight] -> ShowS
Show)
  deriving newtype (Int -> MaxHeight
MaxHeight -> Int
MaxHeight -> [MaxHeight]
MaxHeight -> MaxHeight
MaxHeight -> MaxHeight -> [MaxHeight]
MaxHeight -> MaxHeight -> MaxHeight -> [MaxHeight]
(MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight)
-> (Int -> MaxHeight)
-> (MaxHeight -> Int)
-> (MaxHeight -> [MaxHeight])
-> (MaxHeight -> MaxHeight -> [MaxHeight])
-> (MaxHeight -> MaxHeight -> [MaxHeight])
-> (MaxHeight -> MaxHeight -> MaxHeight -> [MaxHeight])
-> Enum MaxHeight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MaxHeight -> MaxHeight
succ :: MaxHeight -> MaxHeight
$cpred :: MaxHeight -> MaxHeight
pred :: MaxHeight -> MaxHeight
$ctoEnum :: Int -> MaxHeight
toEnum :: Int -> MaxHeight
$cfromEnum :: MaxHeight -> Int
fromEnum :: MaxHeight -> Int
$cenumFrom :: MaxHeight -> [MaxHeight]
enumFrom :: MaxHeight -> [MaxHeight]
$cenumFromThen :: MaxHeight -> MaxHeight -> [MaxHeight]
enumFromThen :: MaxHeight -> MaxHeight -> [MaxHeight]
$cenumFromTo :: MaxHeight -> MaxHeight -> [MaxHeight]
enumFromTo :: MaxHeight -> MaxHeight -> [MaxHeight]
$cenumFromThenTo :: MaxHeight -> MaxHeight -> MaxHeight -> [MaxHeight]
enumFromThenTo :: MaxHeight -> MaxHeight -> MaxHeight -> [MaxHeight]
Enum, Enum MaxHeight
Real MaxHeight
(Real MaxHeight, Enum MaxHeight) =>
(MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight))
-> (MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight))
-> (MaxHeight -> Integer)
-> Integral MaxHeight
MaxHeight -> Integer
MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight)
MaxHeight -> MaxHeight -> MaxHeight
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MaxHeight -> MaxHeight -> MaxHeight
quot :: MaxHeight -> MaxHeight -> MaxHeight
$crem :: MaxHeight -> MaxHeight -> MaxHeight
rem :: MaxHeight -> MaxHeight -> MaxHeight
$cdiv :: MaxHeight -> MaxHeight -> MaxHeight
div :: MaxHeight -> MaxHeight -> MaxHeight
$cmod :: MaxHeight -> MaxHeight -> MaxHeight
mod :: MaxHeight -> MaxHeight -> MaxHeight
$cquotRem :: MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight)
quotRem :: MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight)
$cdivMod :: MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight)
divMod :: MaxHeight -> MaxHeight -> (MaxHeight, MaxHeight)
$ctoInteger :: MaxHeight -> Integer
toInteger :: MaxHeight -> Integer
Integral, Integer -> MaxHeight
MaxHeight -> MaxHeight
MaxHeight -> MaxHeight -> MaxHeight
(MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight)
-> (Integer -> MaxHeight)
-> Num MaxHeight
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MaxHeight -> MaxHeight -> MaxHeight
+ :: MaxHeight -> MaxHeight -> MaxHeight
$c- :: MaxHeight -> MaxHeight -> MaxHeight
- :: MaxHeight -> MaxHeight -> MaxHeight
$c* :: MaxHeight -> MaxHeight -> MaxHeight
* :: MaxHeight -> MaxHeight -> MaxHeight
$cnegate :: MaxHeight -> MaxHeight
negate :: MaxHeight -> MaxHeight
$cabs :: MaxHeight -> MaxHeight
abs :: MaxHeight -> MaxHeight
$csignum :: MaxHeight -> MaxHeight
signum :: MaxHeight -> MaxHeight
$cfromInteger :: Integer -> MaxHeight
fromInteger :: Integer -> MaxHeight
Num, Eq MaxHeight
Eq MaxHeight =>
(MaxHeight -> MaxHeight -> Ordering)
-> (MaxHeight -> MaxHeight -> Bool)
-> (MaxHeight -> MaxHeight -> Bool)
-> (MaxHeight -> MaxHeight -> Bool)
-> (MaxHeight -> MaxHeight -> Bool)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> (MaxHeight -> MaxHeight -> MaxHeight)
-> Ord MaxHeight
MaxHeight -> MaxHeight -> Bool
MaxHeight -> MaxHeight -> Ordering
MaxHeight -> MaxHeight -> MaxHeight
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MaxHeight -> MaxHeight -> Ordering
compare :: MaxHeight -> MaxHeight -> Ordering
$c< :: MaxHeight -> MaxHeight -> Bool
< :: MaxHeight -> MaxHeight -> Bool
$c<= :: MaxHeight -> MaxHeight -> Bool
<= :: MaxHeight -> MaxHeight -> Bool
$c> :: MaxHeight -> MaxHeight -> Bool
> :: MaxHeight -> MaxHeight -> Bool
$c>= :: MaxHeight -> MaxHeight -> Bool
>= :: MaxHeight -> MaxHeight -> Bool
$cmax :: MaxHeight -> MaxHeight -> MaxHeight
max :: MaxHeight -> MaxHeight -> MaxHeight
$cmin :: MaxHeight -> MaxHeight -> MaxHeight
min :: MaxHeight -> MaxHeight -> MaxHeight
Ord, Num MaxHeight
Ord MaxHeight
(Num MaxHeight, Ord MaxHeight) =>
(MaxHeight -> Rational) -> Real MaxHeight
MaxHeight -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MaxHeight -> Rational
toRational :: MaxHeight -> Rational
Real)

newtype Separator = Separator {Separator -> Text
unSeparator :: Text}
  deriving stock (Separator -> Separator -> Bool
(Separator -> Separator -> Bool)
-> (Separator -> Separator -> Bool) -> Eq Separator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Separator -> Separator -> Bool
== :: Separator -> Separator -> Bool
$c/= :: Separator -> Separator -> Bool
/= :: Separator -> Separator -> Bool
Eq, Int -> Separator -> ShowS
[Separator] -> ShowS
Separator -> String
(Int -> Separator -> ShowS)
-> (Separator -> String)
-> ([Separator] -> ShowS)
-> Show Separator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Separator -> ShowS
showsPrec :: Int -> Separator -> ShowS
$cshow :: Separator -> String
show :: Separator -> String
$cshowList :: [Separator] -> ShowS
showList :: [Separator] -> ShowS
Show)

newtype ExactNumberWords = ExactNumberWords {ExactNumberWords -> Int
unExactWords :: Int}
  deriving stock (ExactNumberWords -> ExactNumberWords -> Bool
(ExactNumberWords -> ExactNumberWords -> Bool)
-> (ExactNumberWords -> ExactNumberWords -> Bool)
-> Eq ExactNumberWords
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExactNumberWords -> ExactNumberWords -> Bool
== :: ExactNumberWords -> ExactNumberWords -> Bool
$c/= :: ExactNumberWords -> ExactNumberWords -> Bool
/= :: ExactNumberWords -> ExactNumberWords -> Bool
Eq, Int -> ExactNumberWords -> ShowS
[ExactNumberWords] -> ShowS
ExactNumberWords -> String
(Int -> ExactNumberWords -> ShowS)
-> (ExactNumberWords -> String)
-> ([ExactNumberWords] -> ShowS)
-> Show ExactNumberWords
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExactNumberWords -> ShowS
showsPrec :: Int -> ExactNumberWords -> ShowS
$cshow :: ExactNumberWords -> String
show :: ExactNumberWords -> String
$cshowList :: [ExactNumberWords] -> ShowS
showList :: [ExactNumberWords] -> ShowS
Show)
  deriving newtype (Int -> ExactNumberWords
ExactNumberWords -> Int
ExactNumberWords -> [ExactNumberWords]
ExactNumberWords -> ExactNumberWords
ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
ExactNumberWords
-> ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
(ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords)
-> (Int -> ExactNumberWords)
-> (ExactNumberWords -> Int)
-> (ExactNumberWords -> [ExactNumberWords])
-> (ExactNumberWords -> ExactNumberWords -> [ExactNumberWords])
-> (ExactNumberWords -> ExactNumberWords -> [ExactNumberWords])
-> (ExactNumberWords
    -> ExactNumberWords -> ExactNumberWords -> [ExactNumberWords])
-> Enum ExactNumberWords
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ExactNumberWords -> ExactNumberWords
succ :: ExactNumberWords -> ExactNumberWords
$cpred :: ExactNumberWords -> ExactNumberWords
pred :: ExactNumberWords -> ExactNumberWords
$ctoEnum :: Int -> ExactNumberWords
toEnum :: Int -> ExactNumberWords
$cfromEnum :: ExactNumberWords -> Int
fromEnum :: ExactNumberWords -> Int
$cenumFrom :: ExactNumberWords -> [ExactNumberWords]
enumFrom :: ExactNumberWords -> [ExactNumberWords]
$cenumFromThen :: ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
enumFromThen :: ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
$cenumFromTo :: ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
enumFromTo :: ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
$cenumFromThenTo :: ExactNumberWords
-> ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
enumFromThenTo :: ExactNumberWords
-> ExactNumberWords -> ExactNumberWords -> [ExactNumberWords]
Enum, Enum ExactNumberWords
Real ExactNumberWords
(Real ExactNumberWords, Enum ExactNumberWords) =>
(ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords
    -> ExactNumberWords -> (ExactNumberWords, ExactNumberWords))
-> (ExactNumberWords
    -> ExactNumberWords -> (ExactNumberWords, ExactNumberWords))
-> (ExactNumberWords -> Integer)
-> Integral ExactNumberWords
ExactNumberWords -> Integer
ExactNumberWords
-> ExactNumberWords -> (ExactNumberWords, ExactNumberWords)
ExactNumberWords -> ExactNumberWords -> ExactNumberWords
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
quot :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$crem :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
rem :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$cdiv :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
div :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$cmod :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
mod :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$cquotRem :: ExactNumberWords
-> ExactNumberWords -> (ExactNumberWords, ExactNumberWords)
quotRem :: ExactNumberWords
-> ExactNumberWords -> (ExactNumberWords, ExactNumberWords)
$cdivMod :: ExactNumberWords
-> ExactNumberWords -> (ExactNumberWords, ExactNumberWords)
divMod :: ExactNumberWords
-> ExactNumberWords -> (ExactNumberWords, ExactNumberWords)
$ctoInteger :: ExactNumberWords -> Integer
toInteger :: ExactNumberWords -> Integer
Integral, Integer -> ExactNumberWords
ExactNumberWords -> ExactNumberWords
ExactNumberWords -> ExactNumberWords -> ExactNumberWords
(ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords)
-> (Integer -> ExactNumberWords)
-> Num ExactNumberWords
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
+ :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$c- :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
- :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$c* :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
* :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$cnegate :: ExactNumberWords -> ExactNumberWords
negate :: ExactNumberWords -> ExactNumberWords
$cabs :: ExactNumberWords -> ExactNumberWords
abs :: ExactNumberWords -> ExactNumberWords
$csignum :: ExactNumberWords -> ExactNumberWords
signum :: ExactNumberWords -> ExactNumberWords
$cfromInteger :: Integer -> ExactNumberWords
fromInteger :: Integer -> ExactNumberWords
Num, Eq ExactNumberWords
Eq ExactNumberWords =>
(ExactNumberWords -> ExactNumberWords -> Ordering)
-> (ExactNumberWords -> ExactNumberWords -> Bool)
-> (ExactNumberWords -> ExactNumberWords -> Bool)
-> (ExactNumberWords -> ExactNumberWords -> Bool)
-> (ExactNumberWords -> ExactNumberWords -> Bool)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> (ExactNumberWords -> ExactNumberWords -> ExactNumberWords)
-> Ord ExactNumberWords
ExactNumberWords -> ExactNumberWords -> Bool
ExactNumberWords -> ExactNumberWords -> Ordering
ExactNumberWords -> ExactNumberWords -> ExactNumberWords
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExactNumberWords -> ExactNumberWords -> Ordering
compare :: ExactNumberWords -> ExactNumberWords -> Ordering
$c< :: ExactNumberWords -> ExactNumberWords -> Bool
< :: ExactNumberWords -> ExactNumberWords -> Bool
$c<= :: ExactNumberWords -> ExactNumberWords -> Bool
<= :: ExactNumberWords -> ExactNumberWords -> Bool
$c> :: ExactNumberWords -> ExactNumberWords -> Bool
> :: ExactNumberWords -> ExactNumberWords -> Bool
$c>= :: ExactNumberWords -> ExactNumberWords -> Bool
>= :: ExactNumberWords -> ExactNumberWords -> Bool
$cmax :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
max :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
$cmin :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
min :: ExactNumberWords -> ExactNumberWords -> ExactNumberWords
Ord, Num ExactNumberWords
Ord ExactNumberWords
(Num ExactNumberWords, Ord ExactNumberWords) =>
(ExactNumberWords -> Rational) -> Real ExactNumberWords
ExactNumberWords -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ExactNumberWords -> Rational
toRational :: ExactNumberWords -> Rational
Real)

newtype FormatText = FormatText {FormatText -> [FormatLine]
fmtLines :: [FormatLine]}
  deriving stock (FormatText -> FormatText -> Bool
(FormatText -> FormatText -> Bool)
-> (FormatText -> FormatText -> Bool) -> Eq FormatText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatText -> FormatText -> Bool
== :: FormatText -> FormatText -> Bool
$c/= :: FormatText -> FormatText -> Bool
/= :: FormatText -> FormatText -> Bool
Eq, Int -> FormatText -> ShowS
[FormatText] -> ShowS
FormatText -> String
(Int -> FormatText -> ShowS)
-> (FormatText -> String)
-> ([FormatText] -> ShowS)
-> Show FormatText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatText -> ShowS
showsPrec :: Int -> FormatText -> ShowS
$cshow :: FormatText -> String
show :: FormatText -> String
$cshowList :: [FormatText] -> ShowS
showList :: [FormatText] -> ShowS
Show)

data FormatLine = FormatLine
  { FormatLine -> Separator
fmtSeparator :: Separator,
    FormatLine -> [Word]
fmtWords :: [Word]
  }
  deriving stock (FormatLine -> FormatLine -> Bool
(FormatLine -> FormatLine -> Bool)
-> (FormatLine -> FormatLine -> Bool) -> Eq FormatLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatLine -> FormatLine -> Bool
== :: FormatLine -> FormatLine -> Bool
$c/= :: FormatLine -> FormatLine -> Bool
/= :: FormatLine -> FormatLine -> Bool
Eq, Int -> FormatLine -> ShowS
[FormatLine] -> ShowS
FormatLine -> String
(Int -> FormatLine -> ShowS)
-> (FormatLine -> String)
-> ([FormatLine] -> ShowS)
-> Show FormatLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatLine -> ShowS
showsPrec :: Int -> FormatLine -> ShowS
$cshow :: FormatLine -> String
show :: FormatLine -> String
$cshowList :: [FormatLine] -> ShowS
showList :: [FormatLine] -> ShowS
Show)

-- | Format a list of words to a text blob
formatWords :: FormatOpts -> [Word] -> Text
formatWords :: FormatOpts -> [Word] -> Text
formatWords opts :: FormatOpts
opts@FormatOpts {Maybe ExactNumberWords
Separator
MaxHeight
MaxLen
optMaxLen :: FormatOpts -> MaxLen
optMaxHeight :: FormatOpts -> MaxHeight
optSeparator :: FormatOpts -> Separator
optExactWords :: FormatOpts -> Maybe ExactNumberWords
optMaxLen :: MaxLen
optMaxHeight :: MaxHeight
optSeparator :: Separator
optExactWords :: Maybe ExactNumberWords
..} =
  FormatText -> Text
renderFormatText (FormatText -> Text) -> ([Word] -> FormatText) -> [Word] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatText -> FormatText
take' (FormatText -> FormatText)
-> ([Word] -> FormatText) -> [Word] -> FormatText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatOpts -> [Word] -> FormatText
formatWords' FormatOpts
opts
  where
    take' :: FormatText -> FormatText
    take' :: FormatText -> FormatText
take' =
      case Maybe ExactNumberWords
optExactWords of
        Just (ExactNumberWords Int
exact) -> Int -> FormatText -> FormatText
takeWords Int
exact
        Maybe ExactNumberWords
Nothing -> Int -> FormatText -> FormatText
takeLines (MaxHeight -> Int
unMaxHeight MaxHeight
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' :: FormatOpts -> [Word] -> FormatText
formatWords' FormatOpts
opts [Word]
words' =
  [FormatLine] -> FormatText
FormatText ([FormatLine] -> FormatText) -> [FormatLine] -> FormatText
forall a b. (a -> b) -> a -> b
$
    FormatLine
line FormatLine -> [FormatLine] -> [FormatLine]
forall a. a -> [a] -> [a]
: FormatText -> [FormatLine]
fmtLines (FormatOpts -> [Word] -> FormatText
formatWords' FormatOpts
opts [Word]
restWords)
  where
    line :: FormatLine
line = FormatOpts -> [Word] -> FormatLine
formatLine FormatOpts
opts [Word]
words'
    -- TODO[sgillespie]: Benchmark this vs splitting
    restWords :: [Word]
restWords = Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
drop ([Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Word] -> Int) -> [Word] -> Int
forall a b. (a -> b) -> a -> b
$ FormatLine -> [Word]
fmtWords FormatLine
line) [Word]
words'

-- | Format a single line of words, up to maxLen characters
formatLine :: FormatOpts -> [Word] -> FormatLine
formatLine :: FormatOpts -> [Word] -> FormatLine
formatLine FormatOpts {Maybe ExactNumberWords
Separator
MaxHeight
MaxLen
optMaxLen :: FormatOpts -> MaxLen
optMaxHeight :: FormatOpts -> MaxHeight
optSeparator :: FormatOpts -> Separator
optExactWords :: FormatOpts -> Maybe ExactNumberWords
optMaxLen :: MaxLen
optMaxHeight :: MaxHeight
optSeparator :: Separator
optExactWords :: Maybe ExactNumberWords
..} =
  Separator -> [Word] -> FormatLine
FormatLine Separator
optSeparator
    ([Word] -> FormatLine)
-> ([Word] -> [Word]) -> [Word] -> FormatLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Word) -> [Text] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Word
Word
    ([Text] -> [Word]) -> ([Word] -> [Text]) -> [Word] -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Separator -> Text
unSeparator Separator
optSeparator)
    ([Text] -> [Text]) -> ([Word] -> [Text]) -> [Word] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
concatLine (MaxLen -> Int
unMaxLen MaxLen
optMaxLen)
    ([Text] -> [Text]) -> ([Word] -> [Text]) -> [Word] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (Separator -> Text
unSeparator Separator
optSeparator)
    ([Text] -> [Text]) -> ([Word] -> [Text]) -> [Word] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Text) -> [Word] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word -> Text
unWord
  where
    concatLine :: Int -> [Text] -> [Text]
    concatLine :: Int -> [Text] -> [Text]
concatLine Int
len (Text
t : [Text]
ts)
      | Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
concatLine (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
t) [Text]
ts
      | Bool
otherwise = []
    concatLine Int
_ [] = String -> [Text]
forall a. HasCallStack => String -> a
error String
"Ran out of words"

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

takeLines :: Int -> FormatText -> FormatText
takeLines :: Int -> FormatText -> FormatText
takeLines Int
n (FormatText [FormatLine]
ls) = [FormatLine] -> FormatText
FormatText ([FormatLine] -> FormatText) -> [FormatLine] -> FormatText
forall a b. (a -> b) -> a -> b
$ Int -> [FormatLine] -> [FormatLine]
forall a. Int -> [a] -> [a]
take Int
n [FormatLine]
ls

takeWords :: Int -> FormatText -> FormatText
takeWords :: Int -> FormatText -> FormatText
takeWords Int
_ (FormatText []) = String -> FormatText
forall a. HasCallStack => String -> a
error String
"Ran out of words"
takeWords Int
n (FormatText (l :: FormatLine
l@(FormatLine Separator
sep [Word]
ws) : [FormatLine]
ls))
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
ws = [FormatLine] -> FormatText
FormatText ([FormatLine] -> FormatText) -> [FormatLine] -> FormatText
forall a b. (a -> b) -> a -> b
$ FormatLine
l FormatLine -> [FormatLine] -> [FormatLine]
forall a. a -> [a] -> [a]
: [FormatLine]
ls'
  | Bool
otherwise = [FormatLine] -> FormatText
FormatText [Separator -> [Word] -> FormatLine
FormatLine Separator
sep (Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take Int
n [Word]
ws)]
  where
    (FormatText [FormatLine]
ls') = Int -> FormatText -> FormatText
takeWords (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
ws) ([FormatLine] -> FormatText
FormatText [FormatLine]
ls)