{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
module Text.Layout.Table.Cell.WideString
    ( WideString(..)
    , WideText(..)
    ) where

import Data.String
import qualified Data.Text as T
import Text.DocLayout

import Text.Layout.Table.Cell
import Text.Layout.Table.Primitives.AlignInfo

-- | A newtype for String in which characters can be wider than one space.
newtype WideString = WideString String
    deriving (WideString -> WideString -> Bool
(WideString -> WideString -> Bool)
-> (WideString -> WideString -> Bool) -> Eq WideString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WideString -> WideString -> Bool
$c/= :: WideString -> WideString -> Bool
== :: WideString -> WideString -> Bool
$c== :: WideString -> WideString -> Bool
Eq, Eq WideString
Eq WideString
-> (WideString -> WideString -> Ordering)
-> (WideString -> WideString -> Bool)
-> (WideString -> WideString -> Bool)
-> (WideString -> WideString -> Bool)
-> (WideString -> WideString -> Bool)
-> (WideString -> WideString -> WideString)
-> (WideString -> WideString -> WideString)
-> Ord WideString
WideString -> WideString -> Bool
WideString -> WideString -> Ordering
WideString -> WideString -> WideString
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
min :: WideString -> WideString -> WideString
$cmin :: WideString -> WideString -> WideString
max :: WideString -> WideString -> WideString
$cmax :: WideString -> WideString -> WideString
>= :: WideString -> WideString -> Bool
$c>= :: WideString -> WideString -> Bool
> :: WideString -> WideString -> Bool
$c> :: WideString -> WideString -> Bool
<= :: WideString -> WideString -> Bool
$c<= :: WideString -> WideString -> Bool
< :: WideString -> WideString -> Bool
$c< :: WideString -> WideString -> Bool
compare :: WideString -> WideString -> Ordering
$ccompare :: WideString -> WideString -> Ordering
Ord, Int -> WideString -> [Char] -> [Char]
[WideString] -> [Char] -> [Char]
WideString -> [Char]
(Int -> WideString -> [Char] -> [Char])
-> (WideString -> [Char])
-> ([WideString] -> [Char] -> [Char])
-> Show WideString
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [WideString] -> [Char] -> [Char]
$cshowList :: [WideString] -> [Char] -> [Char]
show :: WideString -> [Char]
$cshow :: WideString -> [Char]
showsPrec :: Int -> WideString -> [Char] -> [Char]
$cshowsPrec :: Int -> WideString -> [Char] -> [Char]
Show, ReadPrec [WideString]
ReadPrec WideString
Int -> ReadS WideString
ReadS [WideString]
(Int -> ReadS WideString)
-> ReadS [WideString]
-> ReadPrec WideString
-> ReadPrec [WideString]
-> Read WideString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WideString]
$creadListPrec :: ReadPrec [WideString]
readPrec :: ReadPrec WideString
$creadPrec :: ReadPrec WideString
readList :: ReadS [WideString]
$creadList :: ReadS [WideString]
readsPrec :: Int -> ReadS WideString
$creadsPrec :: Int -> ReadS WideString
Read, NonEmpty WideString -> WideString
WideString -> WideString -> WideString
(WideString -> WideString -> WideString)
-> (NonEmpty WideString -> WideString)
-> (forall b. Integral b => b -> WideString -> WideString)
-> Semigroup WideString
forall b. Integral b => b -> WideString -> WideString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> WideString -> WideString
$cstimes :: forall b. Integral b => b -> WideString -> WideString
sconcat :: NonEmpty WideString -> WideString
$csconcat :: NonEmpty WideString -> WideString
<> :: WideString -> WideString -> WideString
$c<> :: WideString -> WideString -> WideString
Semigroup, Semigroup WideString
WideString
Semigroup WideString
-> WideString
-> (WideString -> WideString -> WideString)
-> ([WideString] -> WideString)
-> Monoid WideString
[WideString] -> WideString
WideString -> WideString -> WideString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [WideString] -> WideString
$cmconcat :: [WideString] -> WideString
mappend :: WideString -> WideString -> WideString
$cmappend :: WideString -> WideString -> WideString
mempty :: WideString
$cmempty :: WideString
Monoid, [Char] -> WideString
([Char] -> WideString) -> IsString WideString
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> WideString
$cfromString :: [Char] -> WideString
IsString)

instance Cell WideString where
    visibleLength :: WideString -> Int
visibleLength (WideString [Char]
s) = [Char] -> Int
forall a. HasChars a => a -> Int
realLength [Char]
s
    measureAlignment :: (Char -> Bool) -> WideString -> AlignInfo
measureAlignment Char -> Bool
p (WideString [Char]
s) = (Char -> Bool) -> [Char] -> AlignInfo
measureAlignmentWide Char -> Bool
p [Char]
s
    buildCell :: forall b. StringBuilder b => WideString -> b
buildCell (WideString [Char]
s) = [Char] -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell [Char]
s
    buildCellView :: forall b. StringBuilder b => CellView WideString -> b
buildCellView = (WideString -> b)
-> (Int -> WideString -> WideString)
-> (Int -> WideString -> WideString)
-> CellView WideString
-> b
forall b a.
StringBuilder b =>
(a -> b) -> (Int -> a -> a) -> (Int -> a -> a) -> CellView a -> b
buildCellViewLRHelper
      (\(WideString [Char]
s) -> [Char] -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell [Char]
s)
      (\Int
i (WideString [Char]
s) -> [Char] -> WideString
WideString ([Char] -> WideString) -> [Char] -> WideString
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [Char] -> [Char]
dropWide Bool
True Int
i [Char]
s)
      (\Int
i (WideString [Char]
s) -> [Char] -> WideString
WideString ([Char] -> WideString)
-> ([Char] -> [Char]) -> [Char] -> WideString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> [Char] -> [Char]
dropWide Bool
False Int
i ([Char] -> WideString) -> [Char] -> WideString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
s)

-- | Drop characters from the left side of a 'String' until at least the
-- provided width has been removed.
--
-- The provided `Bool` determines whether to continue dropping zero-width
-- characters after the requested width has been dropped.
dropWide :: Bool -> Int -> String -> String
dropWide :: Bool -> Int -> [Char] -> [Char]
dropWide Bool
_ Int
_ [] = []
dropWide Bool
gobbleZeroWidth Int
i l :: [Char]
l@(Char
x : [Char]
xs)
    | Bool
gobbleZeroWidth Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
charLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> Int -> [Char] -> [Char]
dropWide Bool
gobbleZeroWidth Int
i [Char]
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0       = [Char]
l
    | Int
charLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = Bool -> Int -> [Char] -> [Char]
dropWide Bool
gobbleZeroWidth (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
charLen) [Char]
xs
    | Bool
otherwise    = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
charLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Bool -> Int -> [Char] -> [Char]
dropWide Bool
gobbleZeroWidth Int
0 [Char]
xs
  where
    charLen :: Int
charLen = Char -> Int
charWidth Char
x

measureAlignmentWide :: (Char -> Bool) -> String -> AlignInfo
measureAlignmentWide :: (Char -> Bool) -> [Char] -> AlignInfo
measureAlignmentWide Char -> Bool
p [Char]
xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p [Char]
xs of
    ([Char]
ls, [Char]
rs) -> Int -> Maybe Int -> AlignInfo
AlignInfo ([Char] -> Int
forall a. HasChars a => a -> Int
realLength [Char]
ls) (Maybe Int -> AlignInfo) -> Maybe Int -> AlignInfo
forall a b. (a -> b) -> a -> b
$ case [Char]
rs of
        []      -> Maybe Int
forall a. Maybe a
Nothing
        Char
_ : [Char]
rs' -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. HasChars a => a -> Int
realLength [Char]
rs'

-- | A newtype for Text in which characters can be wider than one space.
newtype WideText = WideText T.Text
    deriving (WideText -> WideText -> Bool
(WideText -> WideText -> Bool)
-> (WideText -> WideText -> Bool) -> Eq WideText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WideText -> WideText -> Bool
$c/= :: WideText -> WideText -> Bool
== :: WideText -> WideText -> Bool
$c== :: WideText -> WideText -> Bool
Eq, Eq WideText
Eq WideText
-> (WideText -> WideText -> Ordering)
-> (WideText -> WideText -> Bool)
-> (WideText -> WideText -> Bool)
-> (WideText -> WideText -> Bool)
-> (WideText -> WideText -> Bool)
-> (WideText -> WideText -> WideText)
-> (WideText -> WideText -> WideText)
-> Ord WideText
WideText -> WideText -> Bool
WideText -> WideText -> Ordering
WideText -> WideText -> WideText
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
min :: WideText -> WideText -> WideText
$cmin :: WideText -> WideText -> WideText
max :: WideText -> WideText -> WideText
$cmax :: WideText -> WideText -> WideText
>= :: WideText -> WideText -> Bool
$c>= :: WideText -> WideText -> Bool
> :: WideText -> WideText -> Bool
$c> :: WideText -> WideText -> Bool
<= :: WideText -> WideText -> Bool
$c<= :: WideText -> WideText -> Bool
< :: WideText -> WideText -> Bool
$c< :: WideText -> WideText -> Bool
compare :: WideText -> WideText -> Ordering
$ccompare :: WideText -> WideText -> Ordering
Ord, Int -> WideText -> [Char] -> [Char]
[WideText] -> [Char] -> [Char]
WideText -> [Char]
(Int -> WideText -> [Char] -> [Char])
-> (WideText -> [Char])
-> ([WideText] -> [Char] -> [Char])
-> Show WideText
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [WideText] -> [Char] -> [Char]
$cshowList :: [WideText] -> [Char] -> [Char]
show :: WideText -> [Char]
$cshow :: WideText -> [Char]
showsPrec :: Int -> WideText -> [Char] -> [Char]
$cshowsPrec :: Int -> WideText -> [Char] -> [Char]
Show, ReadPrec [WideText]
ReadPrec WideText
Int -> ReadS WideText
ReadS [WideText]
(Int -> ReadS WideText)
-> ReadS [WideText]
-> ReadPrec WideText
-> ReadPrec [WideText]
-> Read WideText
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WideText]
$creadListPrec :: ReadPrec [WideText]
readPrec :: ReadPrec WideText
$creadPrec :: ReadPrec WideText
readList :: ReadS [WideText]
$creadList :: ReadS [WideText]
readsPrec :: Int -> ReadS WideText
$creadsPrec :: Int -> ReadS WideText
Read, NonEmpty WideText -> WideText
WideText -> WideText -> WideText
(WideText -> WideText -> WideText)
-> (NonEmpty WideText -> WideText)
-> (forall b. Integral b => b -> WideText -> WideText)
-> Semigroup WideText
forall b. Integral b => b -> WideText -> WideText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> WideText -> WideText
$cstimes :: forall b. Integral b => b -> WideText -> WideText
sconcat :: NonEmpty WideText -> WideText
$csconcat :: NonEmpty WideText -> WideText
<> :: WideText -> WideText -> WideText
$c<> :: WideText -> WideText -> WideText
Semigroup, Semigroup WideText
WideText
Semigroup WideText
-> WideText
-> (WideText -> WideText -> WideText)
-> ([WideText] -> WideText)
-> Monoid WideText
[WideText] -> WideText
WideText -> WideText -> WideText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [WideText] -> WideText
$cmconcat :: [WideText] -> WideText
mappend :: WideText -> WideText -> WideText
$cmappend :: WideText -> WideText -> WideText
mempty :: WideText
$cmempty :: WideText
Monoid, [Char] -> WideText
([Char] -> WideText) -> IsString WideText
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> WideText
$cfromString :: [Char] -> WideText
IsString)

instance Cell WideText where
    visibleLength :: WideText -> Int
visibleLength (WideText Text
s) = Text -> Int
forall a. HasChars a => a -> Int
realLength Text
s
    measureAlignment :: (Char -> Bool) -> WideText -> AlignInfo
measureAlignment Char -> Bool
p (WideText Text
s) = (Char -> Bool) -> Text -> AlignInfo
measureAlignmentWideT Char -> Bool
p Text
s
    buildCell :: forall b. StringBuilder b => WideText -> b
buildCell (WideText Text
s) = Text -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell Text
s
    buildCellView :: forall b. StringBuilder b => CellView WideText -> b
buildCellView = (WideText -> b)
-> (Int -> WideText -> WideText)
-> (Int -> WideText -> WideText)
-> CellView WideText
-> b
forall b a.
StringBuilder b =>
(a -> b) -> (Int -> a -> a) -> (Int -> a -> a) -> CellView a -> b
buildCellViewLRHelper
        (\(WideText Text
s) -> Text -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell Text
s)
        (\Int
i (WideText Text
s) -> Text -> WideText
WideText (Text -> WideText) -> Text -> WideText
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
dropLeftWideT Int
i Text
s)
        (\Int
i (WideText Text
s) -> Text -> WideText
WideText (Text -> WideText) -> Text -> WideText
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
dropRightWideT Int
i Text
s)

dropLeftWideT :: Int -> T.Text -> T.Text
dropLeftWideT :: Int -> Text -> Text
dropLeftWideT Int
i Text
txt = case Text -> Maybe (Char, Text)
T.uncons Text
txt of
    Maybe (Char, Text)
Nothing -> Text
txt
    Just (Char
x, Text
xs) -> let l :: Int
l = Char -> Int
charWidth Char
x in if
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Int -> Text -> Text
dropLeftWideT Int
i Text
xs
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    -> Text
txt
        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i    -> Int -> Text -> Text
dropLeftWideT (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Text
xs
        | Bool
otherwise -> Int -> Text -> Text
T.replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
dropLeftWideT Int
0 Text
xs

dropRightWideT :: Int -> T.Text -> T.Text
dropRightWideT :: Int -> Text -> Text
dropRightWideT Int
i Text
txt = case Text -> Maybe (Text, Char)
T.unsnoc Text
txt of
    Maybe (Text, Char)
Nothing -> Text
txt
    Just (Text
xs, Char
x) -> let l :: Int
l = Char -> Int
charWidth Char
x in if
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    -> Text
txt
        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i    -> Int -> Text -> Text
dropRightWideT (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Text
xs
        | Bool
otherwise -> Text
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Text
" "

measureAlignmentWideT :: (Char -> Bool) -> T.Text -> AlignInfo
measureAlignmentWideT :: (Char -> Bool) -> Text -> AlignInfo
measureAlignmentWideT 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
forall a. HasChars a => a -> Int
realLength 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) -> (Text -> Int) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
forall a. HasChars a => a -> Int
realLength (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
rs