-- | Produce justified text, which is spread over multiple rows. For a simple
-- cut, 'chunksOf' from the `split` package is best suited.
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Layout.Table.Justify
    ( -- * Text justification
      justify
    , justifyText
    , Line(..)
    , fitWords
    , concatPadLine

      -- * Helpers
    , dimorphicSummands
    , dimorphicSummandsBy
    , mixedDimorphicSummandsBy
    ) where

import Data.List (foldl')

import Text.Layout.Table.Primitives.Basic

-- | Uses 'words' to split the text into words and justifies it with 'justify'.
--
-- >>> justifyText 10 "This text will not fit on one line."
-- ["This  text","will   not","fit on one","line."]
--
justifyText :: Int -> String -> [String]
justifyText :: Int -> String -> [String]
justifyText Int
w = Int -> [String] -> [String]
justify Int
w ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

-- | Fits as many words on a line as possible depending on the given width.
-- Every line, except the last one, gets equally filled with spaces between the
-- words as far as possible.
justify :: Int -> [String] -> [String]
justify :: Int -> [String] -> [String]
justify Int
width = (Line -> String) -> (Line -> String) -> [Line] -> [String]
forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
mapInit (Int -> Line -> String
concatPadLine Int
width) ([String] -> String
unwords ([String] -> String) -> (Line -> [String]) -> Line -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> [String]
lineWords) ([Line] -> [String])
-> ([String] -> [Line]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [Line]
fitWords Int
width

-- | Intermediate representation for a line of words.
data Line
    = Line
    { Line -> Int
lineLength :: Int -- ^ The length of the current line with a single space as separator between the words.
    , Line -> Int
lineWordCount :: Int -- ^ The number of words on the current line.
    , Line -> [String]
lineWords :: [String] -- ^ The actual words of the line.
    } deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

-- | Join the words on a line together by filling it with spaces in between.
concatPadLine
    :: Int -- ^ The maximum length for lines.
    -> Line -- ^ The 'Line'.
    -> String -- The padded and concatenated line.
concatPadLine :: Int -> Line -> String
concatPadLine Int
width Line {Int
[String]
lineWords :: [String]
lineWordCount :: Int
lineLength :: Int
lineWordCount :: Line -> Int
lineLength :: Line -> Int
lineWords :: Line -> [String]
..} = case [String]
lineWords of
    [String
word] -> String
word
    [String]
_      -> [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ if Int
lineLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
width
                        then let fillAmount :: Int
fillAmount = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineLength
                                 gapCount :: Int
gapCount   = Int -> Int
forall a. Enum a => a -> a
pred Int
lineWordCount
                                 spaceSeps :: [String]
spaceSeps  = Int -> Int -> [String]
mixedDimorphicSpaces Int
fillAmount Int
gapCount [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""]
                             in (String -> ShowS) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> ShowS
forall a. [a] -> [a] -> [a]
(++) [String]
lineWords [String]
spaceSeps
                        else [String]
lineWords

-- | Fit as much words on a line as possible. Produce a list of the length of
-- the line with one space between the words, the word count and the words.
--
-- Cutting below word boundaries is not yet supported.
fitWords
    :: Int -- ^ The number of characters available per line.
    -> [String] -- ^ The words to join with whitespaces.
    -> [Line] -- ^ The list of line information.
fitWords :: Int -> [String] -> [Line]
fitWords Int
width = --gather 0 0 []
    FitState -> [Line]
finishFitState (FitState -> [Line])
-> ([String] -> FitState) -> [String] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FitState -> String -> FitState)
-> FitState -> [String] -> FitState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FitState -> String -> FitState
fitStep (Int -> Int -> [String] -> [Line] -> FitState
FitState Int
0 Int
0 [] [])
  where
    fitStep :: FitState -> String -> FitState
fitStep s :: FitState
s@FitState {Int
[String]
[Line]
fitStateLines :: FitState -> [Line]
fitStateWords :: FitState -> [String]
fitStateWordCount :: FitState -> Int
fitStateLineLen :: FitState -> Int
fitStateLines :: [Line]
fitStateWords :: [String]
fitStateWordCount :: Int
fitStateLineLen :: Int
..} String
word =
        let wLen :: Int
wLen       = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
word
            newLineLen :: Int
newLineLen = Int
fitStateLineLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wLen
            reinit :: ([Line] -> [Line]) -> FitState
reinit [Line] -> [Line]
f   = Int -> Int -> [String] -> [Line] -> FitState
FitState Int
wLen Int
1 [String
word] ([Line] -> FitState) -> [Line] -> FitState
forall a b. (a -> b) -> a -> b
$ [Line] -> [Line]
f [Line]
fitStateLines
        in if | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fitStateWords  -> ([Line] -> [Line]) -> FitState
reinit [Line] -> [Line]
forall a. a -> a
id
              | Int
newLineLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width -> Int -> Int -> [String] -> [Line] -> FitState
FitState Int
newLineLen (Int -> Int
forall a. Enum a => a -> a
succ Int
fitStateWordCount) (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
fitStateWords) [Line]
fitStateLines
              | Bool
otherwise           -> ([Line] -> [Line]) -> FitState
reinit (FitState -> Line
finishLine FitState
s Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:)

-- | State used while fitting words on a line.
data FitState
    = FitState
    { FitState -> Int
fitStateLineLen :: Int
    , FitState -> Int
fitStateWordCount :: Int
    , FitState -> [String]
fitStateWords :: [String]
    , FitState -> [Line]
fitStateLines :: [Line]
    }

-- | Completes the current line.
finishLine :: FitState -> Line
finishLine :: FitState -> Line
finishLine FitState {Int
[String]
[Line]
fitStateLines :: [Line]
fitStateWords :: [String]
fitStateWordCount :: Int
fitStateLineLen :: Int
fitStateLines :: FitState -> [Line]
fitStateWords :: FitState -> [String]
fitStateWordCount :: FitState -> Int
fitStateLineLen :: FitState -> Int
..} = Int -> Int -> [String] -> Line
Line Int
fitStateLineLen Int
fitStateWordCount ([String] -> Line) -> [String] -> Line
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
fitStateWords

finishFitState :: FitState -> [Line]
finishFitState :: FitState -> [Line]
finishFitState s :: FitState
s@FitState {Int
[String]
[Line]
fitStateLines :: [Line]
fitStateWords :: [String]
fitStateWordCount :: Int
fitStateLineLen :: Int
fitStateLines :: FitState -> [Line]
fitStateWords :: FitState -> [String]
fitStateWordCount :: FitState -> Int
fitStateLineLen :: FitState -> Int
..} = [Line] -> [Line]
forall a. [a] -> [a]
reverse ([Line] -> [Line]) -> [Line] -> [Line]
forall a b. (a -> b) -> a -> b
$ [Line] -> [Line]
finishLines [Line]
fitStateLines
  where
    finishLines :: [Line] -> [Line]
finishLines = case Int
fitStateWordCount of
        Int
0 -> [Line] -> [Line]
forall a. a -> a
id
        Int
_ -> (FitState -> Line
finishLine FitState
s Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:)

-- | Map inits with the first function and the last one with the last function.
mapInit :: (a -> b) -> (a -> b) -> [a] -> [b]
mapInit :: forall a b. (a -> b) -> (a -> b) -> [a] -> [b]
mapInit a -> b
_ a -> b
_ []       = []
mapInit a -> b
f a -> b
g (a
x : [a]
xs) = a -> [a] -> [b]
go a
x [a]
xs
  where
    go :: a -> [a] -> [b]
go a
y []        = [a -> b
g a
y]
    go a
y (a
y' : [a]
ys) = a -> b
f a
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: a -> [a] -> [b]
go a
y' [a]
ys

-- | Spread out spaces with different widths more evenly (in comparison to
-- 'dimorphicSpaces').
mixedDimorphicSpaces :: Int -> Int -> [String]
mixedDimorphicSpaces :: Int -> Int -> [String]
mixedDimorphicSpaces = (Int -> String) -> Int -> Int -> [String]
forall a. (Int -> a) -> Int -> Int -> [a]
mixedDimorphicSummandsBy Int -> String
spaces

-- | Splits a given number into summands of 2 different values, where the
-- first one is exactly one bigger than the second one. Splitting 40 spaces
-- into 9 almost equal parts would result in:
--
-- >>> dimorphicSummands 40 9
-- [5,5,5,5,4,4,4,4,4]
--
dimorphicSummands :: Int -> Int -> [Int]
dimorphicSummands :: Int -> Int -> [Int]
dimorphicSummands = (Int -> Int) -> Int -> Int -> [Int]
forall a. (Int -> a) -> Int -> Int -> [a]
dimorphicSummandsBy Int -> Int
forall a. a -> a
id

dimorphicSummandsBy :: (Int -> a) -> Int -> Int -> [a]
dimorphicSummandsBy :: forall a. (Int -> a) -> Int -> Int -> [a]
dimorphicSummandsBy Int -> a
_ Int
_ Int
0      = []
dimorphicSummandsBy Int -> a
f Int
n Int
splits = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
r a
largeS [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
splits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r) a
smallS
  where
    (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
splits
    largeS :: a
largeS = Int -> a
f (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
q
    smallS :: a
smallS = Int -> a
f Int
q

-- | Spread out summands evenly mixed as far as possible.
mixedDimorphicSummandsBy :: (Int -> a) -> Int -> Int -> [a]
mixedDimorphicSummandsBy :: forall a. (Int -> a) -> Int -> Int -> [a]
mixedDimorphicSummandsBy Int -> a
f Int
n Int
splits = Int -> Int -> [a]
go Int
r (Int
splits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)
  where
    go :: Int -> Int -> [a]
go Int
0 Int
s = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
s a
smallS
    go Int
l Int
0 = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
l a
largeS
    go Int
l Int
s = a
largeS a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
smallS a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> Int -> [a]
go (Int -> Int
forall a. Enum a => a -> a
pred Int
l) (Int -> Int
forall a. Enum a => a -> a
pred Int
s)

    (Int
q, Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
splits
    largeS :: a
largeS = Int -> a
f (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
q
    smallS :: a
smallS = Int -> a
f Int
q