{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}

module Text.Layout.Table.Cell where

import Control.Monad (join)
import qualified Data.Text as T

import Text.Layout.Table.Primitives.AlignInfo
import Text.Layout.Table.Primitives.CellMod
import Text.Layout.Table.Spec.CutMark
import Text.Layout.Table.Spec.OccSpec
import Text.Layout.Table.Spec.Position
import Text.Layout.Table.StringBuilder

-- | Ensure a value is not negative.
truncateNegative :: Int -> Int
truncateNegative :: Int -> Int
truncateNegative = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0

-- | An object along with the amount that its length should be adjusted on both the left and right.
-- Positive numbers are padding and negative numbers are trimming.
data CellView a =
    CellView
    { forall a. CellView a -> a
baseCell :: a
    , forall a. CellView a -> Int
leftAdjustment :: Int
    , forall a. CellView a -> Int
rightAdjustment :: Int
    } deriving (CellView a -> CellView a -> Bool
(CellView a -> CellView a -> Bool)
-> (CellView a -> CellView a -> Bool) -> Eq (CellView a)
forall a. Eq a => CellView a -> CellView a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellView a -> CellView a -> Bool
$c/= :: forall a. Eq a => CellView a -> CellView a -> Bool
== :: CellView a -> CellView a -> Bool
$c== :: forall a. Eq a => CellView a -> CellView a -> Bool
Eq, Eq (CellView a)
Eq (CellView a)
-> (CellView a -> CellView a -> Ordering)
-> (CellView a -> CellView a -> Bool)
-> (CellView a -> CellView a -> Bool)
-> (CellView a -> CellView a -> Bool)
-> (CellView a -> CellView a -> Bool)
-> (CellView a -> CellView a -> CellView a)
-> (CellView a -> CellView a -> CellView a)
-> Ord (CellView a)
CellView a -> CellView a -> Bool
CellView a -> CellView a -> Ordering
CellView a -> CellView a -> CellView a
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
forall {a}. Ord a => Eq (CellView a)
forall a. Ord a => CellView a -> CellView a -> Bool
forall a. Ord a => CellView a -> CellView a -> Ordering
forall a. Ord a => CellView a -> CellView a -> CellView a
min :: CellView a -> CellView a -> CellView a
$cmin :: forall a. Ord a => CellView a -> CellView a -> CellView a
max :: CellView a -> CellView a -> CellView a
$cmax :: forall a. Ord a => CellView a -> CellView a -> CellView a
>= :: CellView a -> CellView a -> Bool
$c>= :: forall a. Ord a => CellView a -> CellView a -> Bool
> :: CellView a -> CellView a -> Bool
$c> :: forall a. Ord a => CellView a -> CellView a -> Bool
<= :: CellView a -> CellView a -> Bool
$c<= :: forall a. Ord a => CellView a -> CellView a -> Bool
< :: CellView a -> CellView a -> Bool
$c< :: forall a. Ord a => CellView a -> CellView a -> Bool
compare :: CellView a -> CellView a -> Ordering
$ccompare :: forall a. Ord a => CellView a -> CellView a -> Ordering
Ord, Int -> CellView a -> ShowS
[CellView a] -> ShowS
CellView a -> String
(Int -> CellView a -> ShowS)
-> (CellView a -> String)
-> ([CellView a] -> ShowS)
-> Show (CellView a)
forall a. Show a => Int -> CellView a -> ShowS
forall a. Show a => [CellView a] -> ShowS
forall a. Show a => CellView a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellView a] -> ShowS
$cshowList :: forall a. Show a => [CellView a] -> ShowS
show :: CellView a -> String
$cshow :: forall a. Show a => CellView a -> String
showsPrec :: Int -> CellView a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CellView a -> ShowS
Show, (forall a b. (a -> b) -> CellView a -> CellView b)
-> (forall a b. a -> CellView b -> CellView a) -> Functor CellView
forall a b. a -> CellView b -> CellView a
forall a b. (a -> b) -> CellView a -> CellView b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CellView b -> CellView a
$c<$ :: forall a b. a -> CellView b -> CellView a
fmap :: forall a b. (a -> b) -> CellView a -> CellView b
$cfmap :: forall a b. (a -> b) -> CellView a -> CellView b
Functor)

-- | Add an adjustment to the left and right of a 'Cell'.
-- Positive numbers are padding and negative numbers are trimming.
adjustCell :: Int -> Int -> a -> CellView a
adjustCell :: forall a. Int -> Int -> a -> CellView a
adjustCell Int
l Int
r a
a = a -> Int -> Int -> CellView a
forall a. a -> Int -> Int -> CellView a
CellView a
a Int
l Int
r

-- | Drop a number of characters from the left side. Treats negative numbers
-- as zero.
dropLeft :: Int -> a -> CellView a
dropLeft :: forall a. Int -> a -> CellView a
dropLeft Int
n = Int -> Int -> a -> CellView a
forall a. Int -> Int -> a -> CellView a
dropBoth Int
n Int
0

-- | Drop a number of characters from the right side. Treats negative
-- numbers as zero.
dropRight :: Int -> a -> CellView a
dropRight :: forall a. Int -> a -> CellView a
dropRight = Int -> Int -> a -> CellView a
forall a. Int -> Int -> a -> CellView a
dropBoth Int
0

-- | Drop characters from both sides. Treats negative numbers as zero.
dropBoth :: Int -> Int -> a -> CellView a
dropBoth :: forall a. Int -> Int -> a -> CellView a
dropBoth Int
l Int
r = Int -> Int -> a -> CellView a
forall a. Int -> Int -> a -> CellView a
adjustCell (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
truncateNegative Int
l) (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
truncateNegative Int
r)

instance Applicative CellView where
  pure :: forall a. a -> CellView a
pure a
x = a -> Int -> Int -> CellView a
forall a. a -> Int -> Int -> CellView a
CellView a
x Int
0 Int
0
  (CellView a -> b
f Int
l Int
r) <*> :: forall a b. CellView (a -> b) -> CellView a -> CellView b
<*> (CellView a
x Int
l' Int
r') = b -> Int -> Int -> CellView b
forall a. a -> Int -> Int -> CellView a
CellView (a -> b
f a
x) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r')

instance Monad CellView where
  (CellView a
x Int
l Int
r) >>= :: forall a b. CellView a -> (a -> CellView b) -> CellView b
>>= a -> CellView b
f = let CellView b
y Int
l' Int
r' = a -> CellView b
f a
x in b -> Int -> Int -> CellView b
forall a. a -> Int -> Int -> CellView a
CellView b
y (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r')

-- | The total amount of adjustment in 'CellView'.
totalAdjustment :: CellView a -> Int
totalAdjustment :: forall a. CellView a -> Int
totalAdjustment CellView a
a = CellView a -> Int
forall a. CellView a -> Int
leftAdjustment CellView a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CellView a -> Int
forall a. CellView a -> Int
rightAdjustment CellView a
a

-- | Redistribute padding or trimming using a given ratio.
redistributeAdjustment :: Int -> Int -> CellView a -> CellView a
redistributeAdjustment :: forall a. Int -> Int -> CellView a -> CellView a
redistributeAdjustment Int
l Int
r CellView a
a = a -> Int -> Int -> CellView a
forall a. a -> Int -> Int -> CellView a
CellView (CellView a -> a
forall a. CellView a -> a
baseCell CellView a
a) Int
lAdjustment Int
rAdjustment
  where
    lAdjustment :: Int
lAdjustment = (CellView a -> Int
forall a. CellView a -> Int
totalAdjustment CellView a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r)
    rAdjustment :: Int
rAdjustment = CellView a -> Int
forall a. CellView a -> Int
totalAdjustment CellView a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lAdjustment

-- | Types that can be measured for visible characters, define a sub-string
-- operation and turned into a 'StringBuilder'.
class Cell a where
    -- | Returns the length of the visible characters as displayed on the
    -- output medium.
    visibleLength :: a -> Int

    -- | Measure the preceding and following characters for a position where
    -- the predicate matches.
    measureAlignment :: (Char -> Bool) -> a -> AlignInfo

    -- | Insert the contents into a 'StringBuilder'.
    buildCell :: StringBuilder b => a -> b
    buildCell = CellView a -> b
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView (CellView a -> b) -> (a -> CellView a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CellView a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    -- | Insert the contents into a 'StringBuilder', padding or trimming as
    -- necessary.
    --
    -- The 'Cell' instance of 'CellView a' means that this can usually be
    -- substituted with 'buildCell', and is only needed for defining the
    -- instance.
    buildCellView :: StringBuilder b => CellView a -> b

    {-# MINIMAL visibleLength, measureAlignment, buildCellView #-}

instance Cell a => Cell (CellView a) where
    visibleLength :: CellView a -> Int
visibleLength (CellView a
a Int
l Int
r) = a -> Int
forall a. Cell a => a -> Int
visibleLength a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r
    measureAlignment :: (Char -> Bool) -> CellView a -> AlignInfo
measureAlignment Char -> Bool
f (CellView a
a Int
l Int
r) = case Maybe Int
mMatchRemaining of
        -- No match
        Maybe Int
Nothing -> Int -> Maybe Int -> AlignInfo
AlignInfo (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
matchAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) Maybe Int
forall a. Maybe a
Nothing
        -- There is a match, but it is cut off from the left or right
        Just Int
matchRemaining | Int
matchAt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
l Bool -> Bool -> Bool
|| Int
matchRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
r -> Int -> Maybe Int -> AlignInfo
AlignInfo (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
matchAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
matchRemaining Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) Maybe Int
forall a. Maybe a
Nothing
        -- There is a match, and it is not cut off
        Just Int
matchRemaining -> Int -> Maybe Int -> AlignInfo
AlignInfo (Int
matchAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
matchRemaining Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r)
      where
        AlignInfo Int
matchAt Maybe Int
mMatchRemaining = (Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
f a
a
    buildCell :: forall b. StringBuilder b => CellView a -> b
buildCell = CellView a -> b
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView
    buildCellView :: forall b. StringBuilder b => CellView (CellView a) -> b
buildCellView = CellView a -> b
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView (CellView a -> b)
-> (CellView (CellView a) -> CellView a)
-> CellView (CellView a)
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellView (CellView a) -> CellView a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

instance Cell a => Cell (Maybe a) where
    visibleLength :: Maybe a -> Int
visibleLength = Int -> (a -> Int) -> Maybe a -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 a -> Int
forall a. Cell a => a -> Int
visibleLength
    measureAlignment :: (Char -> Bool) -> Maybe a -> AlignInfo
measureAlignment Char -> Bool
p = AlignInfo -> (a -> AlignInfo) -> Maybe a -> AlignInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AlignInfo
forall a. Monoid a => a
mempty ((Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
p)
    buildCell :: forall b. StringBuilder b => Maybe a -> b
buildCell = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
forall a. Monoid a => a
mempty a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell
    buildCellView :: forall b. StringBuilder b => CellView (Maybe a) -> b
buildCellView (CellView Maybe a
a Int
l Int
r) = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) (CellView a -> b
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView (CellView a -> b) -> (a -> CellView a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> CellView a
forall a. Int -> Int -> a -> CellView a
adjustCell Int
l Int
r) Maybe a
a

instance (Cell a, Cell b) => Cell (Either a b) where
    visibleLength :: Either a b -> Int
visibleLength = (a -> Int) -> (b -> Int) -> Either a b -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Int
forall a. Cell a => a -> Int
visibleLength b -> Int
forall a. Cell a => a -> Int
visibleLength
    measureAlignment :: (Char -> Bool) -> Either a b -> AlignInfo
measureAlignment Char -> Bool
p = (a -> AlignInfo) -> (b -> AlignInfo) -> Either a b -> AlignInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
p) ((Char -> Bool) -> b -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
p)
    buildCell :: forall b. StringBuilder b => Either a b -> b
buildCell = (a -> b) -> (b -> b) -> Either a b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell b -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell
    buildCellView :: forall b. StringBuilder b => CellView (Either a b) -> b
buildCellView (CellView Either a b
a Int
l Int
r) = (a -> b) -> (b -> b) -> Either a b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> b
forall {a} {b}. (Cell a, StringBuilder b) => a -> b
go b -> b
forall {a} {b}. (Cell a, StringBuilder b) => a -> b
go Either a b
a
      where
        go :: a -> b
go a
x = CellView a -> b
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView (CellView a -> b) -> CellView a -> b
forall a b. (a -> b) -> a -> b
$ a -> Int -> Int -> CellView a
forall a. a -> Int -> Int -> CellView a
CellView a
x Int
l Int
r

instance Cell String where
    visibleLength :: String -> Int
visibleLength = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    measureAlignment :: (Char -> Bool) -> String -> AlignInfo
measureAlignment Char -> Bool
p String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
xs of
        (String
ls, String
rs) -> Int -> Maybe Int -> AlignInfo
AlignInfo (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ls) (Maybe Int -> AlignInfo) -> Maybe Int -> AlignInfo
forall a b. (a -> b) -> a -> b
$ case String
rs of
            []      -> Maybe Int
forall a. Maybe a
Nothing
            Char
_ : String
rs' -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rs'

    buildCell :: forall b. StringBuilder b => String -> b
buildCell = String -> b
forall b. StringBuilder b => String -> b
stringB
    buildCellView :: forall b. StringBuilder b => CellView String -> b
buildCellView = (String -> b)
-> (Int -> ShowS) -> (Int -> ShowS) -> CellView String -> b
forall b a.
StringBuilder b =>
(a -> b) -> (Int -> a -> a) -> (Int -> a -> a) -> CellView a -> b
buildCellViewLRHelper String -> b
forall b. StringBuilder b => String -> b
stringB Int -> ShowS
forall a. Int -> [a] -> [a]
drop (\Int
n String
s -> (Char -> Char -> Char) -> String -> ShowS
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> Char
forall a b. a -> b -> a
const String
s ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
n String
s)

instance Cell T.Text where
    visibleLength :: Text -> Int
visibleLength = Text -> Int
T.length
    measureAlignment :: (Char -> Bool) -> Text -> AlignInfo
measureAlignment Char -> Bool
p Text
xs = case (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
p Text
xs of
        (Text
ls, Text
rs) -> Int -> Maybe Int -> AlignInfo
AlignInfo (Text -> Int
T.length Text
ls) (Maybe Int -> AlignInfo) -> Maybe Int -> AlignInfo
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
rs
            then Maybe Int
forall a. Maybe a
Nothing
            else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    buildCell :: forall b. StringBuilder b => Text -> b
buildCell = Text -> b
forall b. StringBuilder b => Text -> b
textB
    buildCellView :: forall b. StringBuilder b => CellView Text -> b
buildCellView = (Text -> b)
-> (Int -> Text -> Text)
-> (Int -> Text -> Text)
-> CellView Text
-> b
forall b a.
StringBuilder b =>
(a -> b) -> (Int -> a -> a) -> (Int -> a -> a) -> CellView a -> b
buildCellViewLRHelper Text -> b
forall b. StringBuilder b => Text -> b
textB Int -> Text -> Text
T.drop Int -> Text -> Text
T.dropEnd

-- | Construct 'buildCellView' from a builder function, a function for
-- trimming from the left, and a function for trimming from the right.
--
-- Used to define instances of 'Cell'.
buildCellViewLRHelper :: StringBuilder b
                      => (a -> b)  -- ^ Builder function for 'a'.
                      -> (Int -> a -> a)  -- ^ Function for trimming on the left.
                      -> (Int -> a -> a)  -- ^ Function for trimming on the right.
                      -> CellView a
                      -> b
buildCellViewLRHelper :: forall b a.
StringBuilder b =>
(a -> b) -> (Int -> a -> a) -> (Int -> a -> a) -> CellView a -> b
buildCellViewLRHelper a -> b
build Int -> a -> a
trimL Int -> a -> a
trimR =
    (a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
forall b a.
StringBuilder b =>
(a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
buildCellViewHelper a -> b
build (\Int
i -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> a
trimL Int
i) (\Int
i -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> a
trimR Int
i) (\Int
l Int
r -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> a
trimL Int
l (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> a
trimR Int
r)

-- | Construct 'buildCellView' from a builder function, and a function for
-- trimming from the left and right simultaneously.
--
-- Used to define instanced of 'Cell'.
buildCellViewBothHelper
    :: StringBuilder b
    => (a -> b)  -- ^ Builder function for 'a'.
    -> (Int -> Int -> a -> a)  -- ^ Function for trimming on the left and right simultaneously.
    -> CellView a
    -> b
buildCellViewBothHelper :: forall b a.
StringBuilder b =>
(a -> b) -> (Int -> Int -> a -> a) -> CellView a -> b
buildCellViewBothHelper a -> b
build Int -> Int -> a -> a
trimBoth =
    (a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
forall b a.
StringBuilder b =>
(a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
buildCellViewHelper a -> b
build (\Int
i -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> a
trimBoth Int
i Int
0) (\Int
i -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> a
trimBoth Int
0 Int
i) (\Int
l Int
r -> a -> b
build (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> a
trimBoth Int
l Int
r)

-- | Construct 'buildCellView' from builder functions and trimming functions.
--
-- Used to define instances of 'Cell'.
buildCellViewHelper
    :: StringBuilder b
    => (a -> b)  -- ^ Builder function for 'a'.
    -> (Int -> a -> b)  -- ^ Function for trimming on the left.
    -> (Int -> a -> b)  -- ^ Function for trimming on the right.
    -> (Int -> Int -> a -> b)  -- ^ Function for trimming on the left and right simultaneously.
    -> CellView a
    -> b
buildCellViewHelper :: forall b a.
StringBuilder b =>
(a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
buildCellViewHelper a -> b
build Int -> a -> b
trimL Int -> a -> b
trimR Int -> Int -> a -> b
trimBoth (CellView a
a Int
l Int
r) =
    case (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
0, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
r Int
0) of
        (Ordering
GT, Ordering
GT) -> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
l b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
build a
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
r
        (Ordering
GT, Ordering
LT) -> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
l b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> a -> b
trimR (Int -> Int
forall a. Num a => a -> a
negate Int
r) a
a
        (Ordering
GT, Ordering
EQ) -> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
l b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
build a
a
        (Ordering
LT, Ordering
GT) -> Int -> a -> b
trimL (Int -> Int
forall a. Num a => a -> a
negate Int
l) a
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
r
        (Ordering
LT, Ordering
LT) -> Int -> Int -> a -> b
trimBoth (Int -> Int
forall a. Num a => a -> a
negate Int
l) (Int -> Int
forall a. Num a => a -> a
negate Int
r) a
a
        (Ordering
LT, Ordering
EQ) -> Int -> a -> b
trimL (Int -> Int
forall a. Num a => a -> a
negate Int
l) a
a
        (Ordering
EQ, Ordering
GT) -> a -> b
build a
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
r
        (Ordering
EQ, Ordering
LT) -> Int -> a -> b
trimR (Int -> Int
forall a. Num a => a -> a
negate Int
r) a
a
        (Ordering
EQ, Ordering
EQ) -> a -> b
build a
a

-- | Creates a 'StringBuilder' with the amount of missing spaces.
remSpacesB
    :: (Cell a, StringBuilder b)
    => Int -- ^ The expected length.
    -> a -- ^ A cell.
    -> b
remSpacesB :: forall a b. (Cell a, StringBuilder b) => Int -> a -> b
remSpacesB Int
n a
c = Int -> Int -> b
forall b. StringBuilder b => Int -> Int -> b
remSpacesB' Int
n (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Cell a => a -> Int
visibleLength a
c

-- | Fill the right side with spaces if necessary.
fillRight :: Cell a => Int -> a -> CellMod a
fillRight :: forall a. Cell a => Int -> a -> CellMod a
fillRight Int
n a
c = Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillRight' Int
n (a -> Int
forall a. Cell a => a -> Int
visibleLength a
c) a
c

-- | Fill the right side with spaces if necessary. Preconditions that are
-- required to be met (otherwise the function will produce garbage):
--
-- prop> visibleLength c == k
fillRight' :: Cell a => Int -> Int -> a -> CellMod a
fillRight' :: forall a. Cell a => Int -> Int -> a -> CellMod a
fillRight' Int
n Int
k = Int -> a -> CellMod a
forall a. Int -> a -> CellMod a
padCellRight (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)

-- | Fill both sides with spaces if necessary.
fillCenter :: Cell a => Int -> a -> CellMod a
fillCenter :: forall a. Cell a => Int -> a -> CellMod a
fillCenter Int
n a
c = Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillCenter' Int
n (a -> Int
forall a. Cell a => a -> Int
visibleLength a
c) a
c

-- | Fill both sides with spaces if necessary. Preconditions that are
-- required to be met (otherwise the function will produce garbage):
--
-- prop> visibleLength c == k
fillCenter' :: Cell a => Int -> Int -> a -> CellMod a
fillCenter' :: forall a. Cell a => Int -> Int -> a -> CellMod a
fillCenter' Int
n Int
k = Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
padCell Int
q (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r)
  where
    missing :: Int
missing = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
    (Int
q, Int
r)  = Int
missing Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2

-- | Fill the left side with spaces if necessary.
fillLeft :: Cell a => Int -> a -> CellMod a
fillLeft :: forall a. Cell a => Int -> a -> CellMod a
fillLeft Int
n a
c = Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillLeft' Int
n (a -> Int
forall a. Cell a => a -> Int
visibleLength a
c) a
c

-- | Fill the left side with spaces if necessary. Preconditions that are
-- required to be met (otherwise the function will produce garbage):
--
-- prop> visibleLength c == k
fillLeft' :: Cell a => Int -> Int -> a -> CellMod a
fillLeft' :: forall a. Cell a => Int -> Int -> a -> CellMod a
fillLeft' Int
n Int
k = Int -> a -> CellMod a
forall a. Int -> a -> CellMod a
padCellLeft (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k)

-- | Pads the given cell accordingly using the position specification.
--
-- >>> buildCellMod noCutMark $ pad left 10 "foo" :: String
-- "foo       "
pad :: Cell a => Position o -> Int -> a -> CellMod a
pad :: forall a o. Cell a => Position o -> Int -> a -> CellMod a
pad Position o
p Int
n a
c = Position o -> Int -> Int -> a -> CellMod a
forall a o. Cell a => Position o -> Int -> Int -> a -> CellMod a
pad' Position o
p Int
n (a -> Int
forall a. Cell a => a -> Int
visibleLength a
c) a
c

-- | Pads the given cell accordingly using the position specification.
-- Preconditions that are required to be met (otherwise the function will
-- produce garbage):
--
-- prop> visibleLength c == k
pad' :: Cell a => Position o -> Int -> Int -> a -> CellMod a
pad' :: forall a o. Cell a => Position o -> Int -> Int -> a -> CellMod a
pad' Position o
p Int
n Int
k = case Position o
p of
    Position o
Start  -> Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillRight' Int
n Int
k
    Position o
Center -> Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillCenter' Int
n Int
k
    Position o
End    -> Int -> Int -> a -> CellMod a
forall a. Cell a => Int -> Int -> a -> CellMod a
fillLeft' Int
n Int
k

-- | If the given text is too long, the 'String' will be shortened according to
-- the position specification. Adds cut marks to indicate that the column has
-- been trimmed in length, otherwise it behaves like 'pad'.
--
-- >>> let cm = singleCutMark ".."
-- >>> buildCellMod cm $ trimOrPad left cm 10 "A longer text." :: String
-- "A longer.."
--
trimOrPad :: Cell a => Position o -> CutMark -> Int -> a -> CellMod a
trimOrPad :: forall a o.
Cell a =>
Position o -> CutMark -> Int -> a -> CellMod a
trimOrPad Position o
p CutMark
cutMark Int
n a
c = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
n of
    Ordering
LT -> Position o -> Int -> Int -> a -> CellMod a
forall a o. Cell a => Position o -> Int -> Int -> a -> CellMod a
pad' Position o
p Int
n Int
k a
c
    Ordering
EQ -> a -> CellMod a
forall a. a -> CellMod a
keepCell a
c
    Ordering
GT -> Position o -> CutMark -> Int -> Int -> a -> CellMod a
forall a o.
Cell a =>
Position o -> CutMark -> Int -> Int -> a -> CellMod a
trim' Position o
p CutMark
cutMark Int
n Int
k a
c
  where
    k :: Int
k = a -> Int
forall a. Cell a => a -> Int
visibleLength a
c

-- | If the given text is too long, it will be trimmed to length `upper`
-- according to the position specification, and cut marks will be added to
-- indicate that the column has been trimmed in length. Otherwise, if
-- the given text is too short, it will be padded to length `lower`.
--
-- >>> let cm = singleCutMark ".."
-- >>> buildCellMod cm $ trimOrPadBetween left cm 7 10 "A longer text." :: String
-- "A longer.."
-- >>> buildCellMod cm $ trimOrPadBetween left cm 7 10 "Short" :: String
-- "Short  "
-- >>> buildCellMod cm $ trimOrPadBetween left cm 7 10 "A medium" :: String
-- "A medium"
--
-- Preconditions that are required to be met (otherwise the output will be
-- counterintuitive):
--
-- prop> lower <= upper
trimOrPadBetween
    :: Cell a
    => Position o
    -> CutMark
    -> Int  -- ^ The length `lower` to pad to if too short
    -> Int  -- ^ The length `upper` to trim to if too long
    -> a
    -> CellMod a
trimOrPadBetween :: forall a o.
Cell a =>
Position o -> CutMark -> Int -> Int -> a -> CellMod a
trimOrPadBetween Position o
p CutMark
cutMark Int
lower Int
upper a
c
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lower = Position o -> CutMark -> Int -> Int -> a -> CellMod a
forall a o.
Cell a =>
Position o -> CutMark -> Int -> Int -> a -> CellMod a
trim' Position o
p CutMark
cutMark Int
upper Int
k a
c
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upper = Position o -> Int -> Int -> a -> CellMod a
forall a o. Cell a => Position o -> Int -> Int -> a -> CellMod a
pad' Position o
p Int
lower Int
k a
c
    | Bool
otherwise = a -> CellMod a
forall a. a -> CellMod a
keepCell a
c
  where
    k :: Int
k = a -> Int
forall a. Cell a => a -> Int
visibleLength a
c

-- | Trim a cell based on the position. Cut marks may be trimmed if necessary.
trim :: Cell a => Position o -> CutMark -> Int -> a -> CellMod a
trim :: forall a o.
Cell a =>
Position o -> CutMark -> Int -> a -> CellMod a
trim Position o
p CutMark
cutMark Int
n a
c = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n then a -> CellMod a
forall a. a -> CellMod a
keepCell a
c else Position o -> CutMark -> Int -> Int -> a -> CellMod a
forall a o.
Cell a =>
Position o -> CutMark -> Int -> Int -> a -> CellMod a
trim' Position o
p CutMark
cutMark Int
n Int
k a
c
  where
    k :: Int
k = a -> Int
forall a. Cell a => a -> Int
visibleLength a
c

-- | Trim a cell based on the position. Cut marks may be trimmed if necessary.
--
-- Preconditions that are required to be met (otherwise the function will produce garbage):
--
-- prop> visibleLength c > n
-- prop> visibleLength c == k
trim' :: Cell a => Position o -> CutMark -> Int -> Int -> a -> CellMod a
trim' :: forall a o.
Cell a =>
Position o -> CutMark -> Int -> Int -> a -> CellMod a
trim' Position o
p CutMark
cutMark Int
n Int
k = case Position o
p of
    Position o
Start  -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
trimCellRight (Int
cutLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
rightLen)
    Position o
Center -> case Int
cutLen Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
        (Int
0, Int
1) -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
trimCellLeft (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) Int
n
        (Int
q, Int
r) -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen
                  -- Both cutmarks fit.
                  then Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
trimCell (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) (Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
q) Int
leftLen Int
rightLen
                  else case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
                    (Int
qn, Int
rn) -> Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
trimCell Int
k Int
0 Int
qn (Int
qn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rn)
    Position o
End    -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
trimCellLeft (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cutLen) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
leftLen)
  where
    leftLen :: Int
leftLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ CutMark -> String
leftMark CutMark
cutMark
    rightLen :: Int
rightLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ CutMark -> String
rightMark CutMark
cutMark

    cutLen :: Int
cutLen = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n

-- | Align a cell by first locating the position to align with and then padding
-- on both sides. If no such position is found, it will align it such that it
-- gets aligned before that position.
--
-- >>> let { os = predOccSpec (== '.') ; ai = deriveAlignInfo os "iiii.fff" }
-- >>> in buildCellMod noCutMark . align os ai <$> ["1.5", "30", ".25"] :: [String]
-- ["   1.5  ","  30    ","    .25 "]
--
-- This function assumes that the given 'String' fits the 'AlignInfo'. Thus:
--
-- prop> ai <> deriveAlignInfo s = ai
--
align :: Cell a => OccSpec -> AlignInfo -> a -> CellMod a
align :: forall a. Cell a => OccSpec -> AlignInfo -> a -> CellMod a
align OccSpec
oS (AlignInfo Int
ln Maybe Int
optRN) a
c = case (Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment (OccSpec -> Char -> Bool
predicate OccSpec
oS) a
c of
    AlignInfo Int
lk Maybe Int
optRK -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
padCell (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lk) (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. Enum a => a -> a
succ Maybe Int
optRN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. Enum a => a -> a
succ Maybe Int
optRK) a
c

data CutAction
    = FillCA Int
    | CutCA Int
    | NoneCA
    deriving (CutAction -> CutAction -> Bool
(CutAction -> CutAction -> Bool)
-> (CutAction -> CutAction -> Bool) -> Eq CutAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CutAction -> CutAction -> Bool
$c/= :: CutAction -> CutAction -> Bool
== :: CutAction -> CutAction -> Bool
$c== :: CutAction -> CutAction -> Bool
Eq, Int -> CutAction -> ShowS
[CutAction] -> ShowS
CutAction -> String
(Int -> CutAction -> ShowS)
-> (CutAction -> String)
-> ([CutAction] -> ShowS)
-> Show CutAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CutAction] -> ShowS
$cshowList :: [CutAction] -> ShowS
show :: CutAction -> String
$cshow :: CutAction -> String
showsPrec :: Int -> CutAction -> ShowS
$cshowsPrec :: Int -> CutAction -> ShowS
Show)

surplusSpace :: CutAction -> Int
surplusSpace :: CutAction -> Int
surplusSpace CutAction
ca = case CutAction
ca of
    CutCA Int
n  -> Int -> Int
forall a. Num a => a -> a
negate Int
n
    FillCA Int
n -> Int
n
    CutAction
_        -> Int
0

determineCutAction :: Int -> Int -> CutAction
determineCutAction :: Int -> Int -> CutAction
determineCutAction Int
requiredW Int
actualW = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
requiredW Int
actualW of
    Ordering
LT -> Int -> CutAction
CutCA (Int -> CutAction) -> Int -> CutAction
forall a b. (a -> b) -> a -> b
$ Int
actualW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
requiredW
    Ordering
EQ -> CutAction
NoneCA
    Ordering
GT -> Int -> CutAction
FillCA (Int -> CutAction) -> Int -> CutAction
forall a b. (a -> b) -> a -> b
$ Int
requiredW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actualW

data CutInfo
    -- | Apply a cut action to each side.
    = SidesCI CutAction CutAction
    -- | Apply a mark to a whitespace string pointing to the left.
    | MarkLeftCI
    -- | Apply a mark to a whitespace string pointing to the right.
    | MarkRightCI
    deriving (CutInfo -> CutInfo -> Bool
(CutInfo -> CutInfo -> Bool)
-> (CutInfo -> CutInfo -> Bool) -> Eq CutInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CutInfo -> CutInfo -> Bool
$c/= :: CutInfo -> CutInfo -> Bool
== :: CutInfo -> CutInfo -> Bool
$c== :: CutInfo -> CutInfo -> Bool
Eq, Int -> CutInfo -> ShowS
[CutInfo] -> ShowS
CutInfo -> String
(Int -> CutInfo -> ShowS)
-> (CutInfo -> String) -> ([CutInfo] -> ShowS) -> Show CutInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CutInfo] -> ShowS
$cshowList :: [CutInfo] -> ShowS
show :: CutInfo -> String
$cshow :: CutInfo -> String
showsPrec :: Int -> CutInfo -> ShowS
$cshowsPrec :: Int -> CutInfo -> ShowS
Show)

-- | Compares the view range, that represents the visible part, with the cell
-- range, which is the position of the cell relative to the alignment, and
-- determines the actions that should be performed.
determineCuts :: Int -> Int -> Int -> Int -> CutInfo
determineCuts :: Int -> Int -> Int -> Int -> CutInfo
determineCuts Int
vl Int
vr Int
cl Int
cr
    | Int
vr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cl  = CutInfo
MarkRightCI
    | Int
cr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
vl  = CutInfo
MarkLeftCI
    | Bool
otherwise = CutAction -> CutAction -> CutInfo
SidesCI (Int -> Int -> CutAction
determineCutAction Int
cl Int
vl) (Int -> Int -> CutAction
determineCutAction Int
vr Int
cr)

-- | If the amount to be cut is bigger than the cell length then any missing
-- amount is taken away from any remaining padding.
numSpacesAfterCut :: CutAction -> Int -> Int -> Int
numSpacesAfterCut :: CutAction -> Int -> Int -> Int
numSpacesAfterCut CutAction
ca Int
cellLen Int
cutAmount = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
r Int
0
  where
    s :: Int
s = CutAction -> Int
surplusSpace CutAction
ca
    r :: Int
r = Int
cellLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cutAmount

applyCutInfo
    :: Cell a
    => CutInfo
    -> CutMark
    -> Int
    -> Int
    -> a
    -> CellMod a
applyCutInfo :: forall a.
Cell a =>
CutInfo -> CutMark -> Int -> Int -> a -> CellMod a
applyCutInfo CutInfo
ci CutMark
cutMark Int
availSpace Int
cellLen = case CutInfo
ci of
    -- The cuts might interfere with each other. Properly distribute available
    -- length between both cut marks.
    SidesCI (CutCA Int
lCut) (CutCA Int
rCut) ->
        let (Int
q, Int
r) = Int
availSpace Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2
        in Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
modifyCellWithCutMarkLen (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen)
                                    (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
                                    Int
q
                                    (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r)
    -- The left cut might need some of the right padding.
    SidesCI (CutCA Int
lCut) CutAction
rCA          ->
        Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
modifyCellWithCutMarkLen (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen)
                                 (CutAction -> Int -> Int -> Int
numSpacesAfterCut CutAction
rCA Int
cellLen (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen)
                                 Int
availSpace
                                 Int
0
    -- The right cut might need some of the left padding.
    SidesCI CutAction
lCA (CutCA Int
rCut)          ->
        Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
modifyCellWithCutMarkLen (CutAction -> Int -> Int -> Int
numSpacesAfterCut CutAction
lCA Int
cellLen (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
                                 (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
                                 Int
0
                                 Int
availSpace
    -- Filtered out all cuts at this point.
    SidesCI CutAction
lCA CutAction
rCA                   ->
        Int -> Int -> a -> CellMod a
forall a. Int -> Int -> a -> CellMod a
padCell (CutAction -> Int
surplusSpace CutAction
lCA) (CutAction -> Int
surplusSpace CutAction
rCA)
    CutInfo
MarkRightCI                       ->
        Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
modifyCellWithCutMarkLen (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
availSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rightLen)
                                 (Int -> Int
forall a. Num a => a -> a
negate Int
cellLen)
                                 Int
0
                                 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
availSpace Int
rightLen)
    CutInfo
MarkLeftCI                        ->
        Int -> Int -> Int -> Int -> a -> CellMod a
forall a. Int -> Int -> Int -> Int -> a -> CellMod a
modifyCellWithCutMarkLen (Int -> Int
forall a. Num a => a -> a
negate Int
cellLen)
                                 (Int -> Int
truncateNegative (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
availSpace Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leftLen)
                                 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
availSpace Int
leftLen)
                                 Int
0
  where
    leftLen :: Int
leftLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ CutMark -> String
leftMark CutMark
cutMark
    rightLen :: Int
rightLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ CutMark -> String
rightMark CutMark
cutMark

-- | Given a position, the available width, and the length of an alignment
-- (left and right side, separator is implied) compute a range for the view.
-- The lower bound is inclusive and the upper bound exclusive.
viewRange :: Position o -> Int -> Int -> Int -> (Int, Int)
viewRange :: forall o. Position o -> Int -> Int -> Int -> (Int, Int)
viewRange Position o
p Int
availSpace Int
l Int
r = case Position o
p of
    Position o
Start  -> (Int
0, Int
availSpace)
    Position o
Center -> let (Int
cq, Int
cr) = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
availSpace) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2
                  start :: Int
start    = Int
cq Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cr
              in (Int
start, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
availSpace)
    Position o
End    -> let end :: Int
end = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              in (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
availSpace, Int
end)

-- | Given the maximum left alignment and the alignment of the cell create a
-- range that describes the position of the cell. The lower bound is inclusive
-- and the upper bound exclusive.
cellRange :: Int -> AlignInfo -> (Int, Int)
cellRange :: Int -> AlignInfo -> (Int, Int)
cellRange Int
lMax cellAlignInfo :: AlignInfo
cellAlignInfo@(AlignInfo Int
l Maybe Int
_) = (Int
cl, Int
cl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AlignInfo -> Int
widthAI AlignInfo
cellAlignInfo)
  where
    cl :: Int
cl = Int
lMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l

-- | Aligns a cell using a fixed width, fitting it to the width by either
-- filling or cutting while respecting the alignment.
alignFixed
    :: Cell a
    => Position o
    -> CutMark
    -> Int
    -> OccSpec
    -> AlignInfo
    -> a
    -> CellMod a
alignFixed :: forall a o.
Cell a =>
Position o
-> CutMark -> Int -> OccSpec -> AlignInfo -> a -> CellMod a
alignFixed Position o
p CutMark
cutMark Int
n OccSpec
oS (AlignInfo Int
lMax Maybe Int
optRMax) a
c = case Maybe Int
optRMax of
    Maybe Int
Nothing   -> Position o -> CutMark -> Int -> a -> CellMod a
forall a o.
Cell a =>
Position o -> CutMark -> Int -> a -> CellMod a
trimOrPad Position o
p CutMark
cutMark Int
n a
c
    Just Int
rMax -> let (Int
vl, Int
vr)            = Position o -> Int -> Int -> Int -> (Int, Int)
forall o. Position o -> Int -> Int -> Int -> (Int, Int)
viewRange Position o
p Int
n Int
lMax Int
rMax
                     (Int
cl, Int
cr)            = Int -> AlignInfo -> (Int, Int)
cellRange Int
lMax (AlignInfo -> (Int, Int)) -> AlignInfo -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment (OccSpec -> Char -> Bool
predicate OccSpec
oS) a
c
                     cutInfo :: CutInfo
cutInfo             = Int -> Int -> Int -> Int -> CutInfo
determineCuts Int
vl Int
vr Int
cl Int
cr
                     cellLen :: Int
cellLen             = Int
cr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cl
                 in CutInfo -> CutMark -> Int -> Int -> a -> CellMod a
forall a.
Cell a =>
CutInfo -> CutMark -> Int -> Int -> a -> CellMod a
applyCutInfo CutInfo
cutInfo CutMark
cutMark Int
n Int
cellLen a
c

-- | Interpret 'CellMod' to create a builder.
buildCellMod
    :: (Cell c, StringBuilder s)
    => CutMark
    -> CellMod c
    -> s
buildCellMod :: forall c s. (Cell c, StringBuilder s) => CutMark -> CellMod c -> s
buildCellMod CutMark
cutMark CellMod {c
Int
rightCutMarkLenCM :: forall a. CellMod a -> Int
leftCutMarkLenCM :: forall a. CellMod a -> Int
rightAdjustmentCM :: forall a. CellMod a -> Int
leftAdjustmentCM :: forall a. CellMod a -> Int
baseCellCM :: forall a. CellMod a -> a
rightCutMarkLenCM :: Int
leftCutMarkLenCM :: Int
rightAdjustmentCM :: Int
leftAdjustmentCM :: Int
baseCellCM :: c
..} =
    -- 'buildCellView' takes care of padding and trimming.
    (Int -> s) -> Int -> s
forall {t} {t}. (Ord t, Num t, Monoid t) => (t -> t) -> t -> t
applyMarkOrEmpty Int -> s
forall a. StringBuilder a => Int -> a
applyLeftMark Int
leftCutMarkLenCM
    s -> s -> s
forall a. Semigroup a => a -> a -> a
<> CellView c -> s
forall a b. (Cell a, StringBuilder b) => CellView a -> b
buildCellView (c -> Int -> Int -> CellView c
forall a. a -> Int -> Int -> CellView a
CellView c
baseCellCM Int
leftAdjustmentCM Int
rightAdjustmentCM)
    s -> s -> s
forall a. Semigroup a => a -> a -> a
<> (Int -> s) -> Int -> s
forall {t} {t}. (Ord t, Num t, Monoid t) => (t -> t) -> t -> t
applyMarkOrEmpty Int -> s
forall a. StringBuilder a => Int -> a
applyRightMark Int
rightCutMarkLenCM
  where
    applyMarkOrEmpty :: (t -> t) -> t -> t
applyMarkOrEmpty t -> t
applyMark t
k = if t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 then t -> t
applyMark t
k else t
forall a. Monoid a => a
mempty

    applyLeftMark :: Int -> a
applyLeftMark Int
k  = String -> a
forall b. StringBuilder b => String -> b
stringB (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
k ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ CutMark -> String
leftMark CutMark
cutMark
    applyRightMark :: Int -> c
applyRightMark Int
k = String -> c
forall b. StringBuilder b => String -> b
stringB (String -> c) -> ShowS -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse (String -> c) -> String -> c
forall a b. (a -> b) -> a -> b
$ CutMark -> String
rightMark CutMark
cutMark