{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Layout.Table.Justify
(
justify
, justifyText
, Line(..)
, fitWords
, concatPadLine
, dimorphicSummands
, dimorphicSummandsBy
, mixedDimorphicSummandsBy
) where
import Data.List (foldl')
import Text.Layout.Table.Primitives.Basic
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
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
data Line
= Line
{ Line -> Int
lineLength :: Int
, Line -> Int
lineWordCount :: Int
, Line -> [String]
lineWords :: [String]
} 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)
concatPadLine
:: Int
-> Line
-> String
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
fitWords
:: Int
-> [String]
-> [Line]
fitWords :: Int -> [String] -> [Line]
fitWords Int
width =
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]
:)
data FitState
= FitState
{ FitState -> Int
fitStateLineLen :: Int
, FitState -> Int
fitStateWordCount :: Int
, FitState -> [String]
fitStateWords :: [String]
, FitState -> [Line]
fitStateLines :: [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]
:)
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
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
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
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