{-# LANGUAGE FlexibleInstances #-}
module Text.Layout.Table.Cell where

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

-- | Types that can be shortened, measured for visible characters, and turned
-- into a 'StringBuilder'.
class Cell a where
    -- Preprocessing functions:

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

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

    -- | Drop characters from both sides. Treats negative numbers as zero.
    dropBoth :: Int -> Int -> a -> a
    dropBoth Int
l Int
r = Int -> a -> a
forall a. Cell a => Int -> a -> a
dropRight Int
r (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> a
forall a. Cell a => Int -> a -> a
dropLeft Int
l

    -- | Returns the length of the visible characters as displayed on the
    -- output medium.
    visibleLength :: a -> Int

    -- | Measure the preceeding 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

    {-# MINIMAL visibleLength, measureAlignment, buildCell, (dropBoth | (dropLeft, dropRight))  #-}

instance Cell String where
    dropLeft :: Int -> String -> String
dropLeft = Int -> String -> String
forall a. Int -> [a] -> [a]
drop
    dropRight :: Int -> String -> String
dropRight Int
n = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
    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 :: String -> b
buildCell = String -> b
forall b. StringBuilder b => String -> b
stringB

remSpacesB :: (Cell a, StringBuilder b) => Int -> a -> b
remSpacesB :: 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

remSpacesB' :: StringBuilder b => Int -> Int -> b
remSpacesB' :: Int -> Int -> b
remSpacesB' Int
n Int
k = Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k

-- | Fill the right side with spaces if necessary.
fillRight :: (Cell a, StringBuilder b) => Int -> a -> b
fillRight :: Int -> a -> b
fillRight Int
n a
c = a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> a -> b
forall a b. (Cell a, StringBuilder b) => Int -> a -> b
remSpacesB Int
n a
c

-- | Fill both sides with spaces if necessary.
fillCenter :: (Cell a, StringBuilder b) => Int -> a -> b
fillCenter :: Int -> a -> b
fillCenter Int
n a
c = Int -> b
forall a. StringBuilder a => Int -> a
spacesB Int
q b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
spacesB (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
- a -> Int
forall a. Cell a => a -> Int
visibleLength a
c
    (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, StringBuilder b) => Int -> a -> b
fillLeft :: Int -> a -> b
fillLeft Int
n a
c = Int -> a -> b
forall a b. (Cell a, StringBuilder b) => Int -> a -> b
remSpacesB Int
n a
c b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c

-- | Assume the given length is greater or equal than the length of the cell
-- passed. Pads the given cell accordingly using the position specification.
--
-- >>> pad left 10 "foo" :: String
-- "foo       "
--
pad :: (Cell a, StringBuilder b) => Position o -> Int -> a -> b
pad :: Position o -> Int -> a -> b
pad Position o
p = case Position o
p of
    Position o
Start  -> Int -> a -> b
forall a b. (Cell a, StringBuilder b) => Int -> a -> b
fillRight
    Position o
Center -> Int -> a -> b
forall a b. (Cell a, StringBuilder b) => Int -> a -> b
fillCenter
    Position o
End    -> Int -> a -> b
forall a b. (Cell a, StringBuilder b) => Int -> a -> b
fillLeft

-- | 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'.
--
-- >>> trimOrPad left (singleCutMark "..") 10 "A longer text." :: String
-- "A longer.."
--
trimOrPad :: (Cell a, StringBuilder b) => Position o -> CutMark -> Int -> a -> b
trimOrPad :: Position o -> CutMark -> Int -> a -> b
trimOrPad Position o
p CutMark
cm Int
n a
c = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> Int
forall a. Cell a => a -> Int
visibleLength a
c) Int
n of
    Ordering
LT -> Position o -> Int -> a -> b
forall a b o.
(Cell a, StringBuilder b) =>
Position o -> Int -> a -> b
pad Position o
p Int
n a
c
    Ordering
EQ -> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c
    Ordering
GT -> Position o -> CutMark -> Int -> a -> b
forall a b o.
(Cell a, StringBuilder b) =>
Position o -> CutMark -> Int -> a -> b
trim Position o
p CutMark
cm Int
n a
c

-- | Trim a cell based on the position. Preconditions that require to be met
-- (otherwise the function will produce garbage):
-- prop> visibleLength c > n
trim :: (Cell a, StringBuilder b) => Position o -> CutMark -> Int -> a -> b
trim :: Position o -> CutMark -> Int -> a -> b
trim Position o
p CutMark
cm Int
n a
c = case Position o
p of
    Position o
Start  -> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> a -> a
forall a. Cell a => Int -> a -> a
dropRight (Int
cutLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen) a
c) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (CutMark -> String
rightMark CutMark
cm)
    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) -> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (CutMark -> String
leftMark CutMark
cm) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> a -> a
forall a. Cell a => Int -> a -> a
dropLeft (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) a
c)
        (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
                  then String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (CutMark -> String
leftMark CutMark
cm) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> Int -> a -> a
forall a. Cell a => Int -> Int -> a -> a
dropBoth (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) a
c)
                       b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (CutMark -> String
rightMark CutMark
cm)
                  else case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
                      (Int
qn, Int
rn) -> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
qn (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CutMark -> String
leftMark CutMark
cm)
                                  b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
qn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rn) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CutMark -> String
rightMark CutMark
cm)
    Position o
End    -> String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (CutMark -> String
leftMark CutMark
cm) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> a -> a
forall a. Cell a => Int -> a -> a
dropLeft (Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cutLen) a
c)
  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
cm
    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
cm

    cutLen :: Int
cutLen = a -> Int
forall a. Cell a => a -> Int
visibleLength a
c 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 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, StringBuilder b) => OccSpec -> AlignInfo -> a -> b
align :: OccSpec -> AlignInfo -> a -> b
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 -> b
forall b. StringBuilder b => Int -> Int -> b
remSpacesB' Int
ln Int
lk b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> b
forall b. StringBuilder b => Int -> Int -> b
remSpacesB' (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) -> 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)

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 -> String -> String
[CutAction] -> String -> String
CutAction -> String
(Int -> CutAction -> String -> String)
-> (CutAction -> String)
-> ([CutAction] -> String -> String)
-> Show CutAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CutAction] -> String -> String
$cshowList :: [CutAction] -> String -> String
show :: CutAction -> String
$cshow :: CutAction -> String
showsPrec :: Int -> CutAction -> String -> String
$cshowsPrec :: Int -> CutAction -> String -> String
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 -> String -> String
[CutInfo] -> String -> String
CutInfo -> String
(Int -> CutInfo -> String -> String)
-> (CutInfo -> String)
-> ([CutInfo] -> String -> String)
-> Show CutInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CutInfo] -> String -> String
$cshowList :: [CutInfo] -> String -> String
show :: CutInfo -> String
$cshow :: CutInfo -> String
showsPrec :: Int -> CutInfo -> String -> String
$cshowsPrec :: Int -> CutInfo -> String -> String
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.
spacesAfterCut :: StringBuilder b => CutAction -> Int -> Int -> b
spacesAfterCut :: CutAction -> Int -> Int -> b
spacesAfterCut CutAction
ca Int
cellLen Int
cutAmount = Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ 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, StringBuilder b)
    => CutInfo
    -> CutMark
    -> Int
    -> Int
    -> a
    -> b
applyCutInfo :: CutInfo -> CutMark -> Int -> Int -> a -> b
applyCutInfo CutInfo
ci CutMark
cm Int
availSpace Int
cellLen a
c = 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 -> b
forall a. StringBuilder a => Int -> a
applyLeftMark Int
q
           b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> Int -> a -> a
forall a. Cell a => Int -> Int -> a -> a
dropBoth (Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) (Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen) a
c)
           b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
applyRightMark (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 -> b
forall a. StringBuilder a => Int -> a
applyLeftMark Int
availSpace
        b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> a -> a
forall a. Cell a => Int -> a -> a
dropLeft (Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen) a
c)
        b -> b -> b
forall a. Semigroup a => a -> a -> a
<> CutAction -> Int -> Int -> b
forall b. StringBuilder b => CutAction -> Int -> Int -> b
spacesAfterCut CutAction
rCA Int
cellLen (Int
lCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen)
    -- The right cut might need some of the left padding.
    SidesCI CutAction
lCA (CutCA Int
rCut)          ->
        CutAction -> Int -> Int -> b
forall b. StringBuilder b => CutAction -> Int -> Int -> b
spacesAfterCut CutAction
lCA Int
cellLen (Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen)
        b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Int -> a -> a
forall a. Cell a => Int -> a -> a
dropRight (Int
rCut Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightLen) a
c)
        b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
applyRightMark Int
availSpace
    -- Filtered out all cuts at this point.
    SidesCI CutAction
lCA CutAction
rCA                   ->
        let spacesB' :: CutAction -> b
spacesB' = Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> b) -> (CutAction -> Int) -> CutAction -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutAction -> Int
surplusSpace
        in CutAction -> b
spacesB' CutAction
lCA b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell a
c b -> b -> b
forall a. Semigroup a => a -> a -> a
<> CutAction -> b
spacesB' CutAction
rCA
    CutInfo
MarkRightCI                       ->
        Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (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) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
applyRightMark Int
availSpace
    CutInfo
MarkLeftCI                        ->
        Int -> b
forall a. StringBuilder a => Int -> a
applyLeftMark Int
availSpace b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Int -> b
forall a. StringBuilder a => Int -> a
spacesB (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (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)
  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
cm
    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
cm

    applyLeftMark :: Int -> b
applyLeftMark Int
k  = String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
k (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CutMark -> String
leftMark CutMark
cm
    applyRightMark :: Int -> b
applyRightMark Int
k = String -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
rightLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CutMark -> String
rightMark CutMark
cm

-- | 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 :: 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, StringBuilder b)
    => Position o
    -> CutMark
    -> Int
    -> OccSpec
    -> AlignInfo
    -> a
    -> b
alignFixed :: Position o -> CutMark -> Int -> OccSpec -> AlignInfo -> a -> b
alignFixed Position o
p CutMark
cm 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 -> b
forall a b o.
(Cell a, StringBuilder b) =>
Position o -> CutMark -> Int -> a -> b
trimOrPad Position o
p CutMark
cm 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 -> b
forall a b.
(Cell a, StringBuilder b) =>
CutInfo -> CutMark -> Int -> Int -> a -> b
applyCutInfo CutInfo
cutInfo CutMark
cm Int
n Int
cellLen a
c