{-# LANGUAGE DeriveFunctor #-}
-- | Provides formatting to an instance of 'Cell'. For example, in a unix
-- terminal one could use the following:
--
-- >>> buildCell (formatted "\ESC[31m" "Hello World!" "\ESC[0m") :: String
-- Hello World!
--
-- The text then appears in dull red.
module Text.Layout.Table.Cell.Formatted
    ( Formatted
    , formatted
    , plain
    ) where

import Data.String

import Text.Layout.Table.Cell
import Text.Layout.Table.StringBuilder

data Formatted a
    = Formatted
    { Formatted a -> String
prefix :: String
    , Formatted a -> a
content :: a
    , Formatted a -> String
suffix :: String
    } deriving a -> Formatted b -> Formatted a
(a -> b) -> Formatted a -> Formatted b
(forall a b. (a -> b) -> Formatted a -> Formatted b)
-> (forall a b. a -> Formatted b -> Formatted a)
-> Functor Formatted
forall a b. a -> Formatted b -> Formatted a
forall a b. (a -> b) -> Formatted a -> Formatted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Formatted b -> Formatted a
$c<$ :: forall a b. a -> Formatted b -> Formatted a
fmap :: (a -> b) -> Formatted a -> Formatted b
$cfmap :: forall a b. (a -> b) -> Formatted a -> Formatted b
Functor

-- | Create a value from content that is kept plain without any formatting.
plain :: a -> Formatted a
plain :: a -> Formatted a
plain a
x = String -> a -> String -> Formatted a
forall a. String -> a -> String -> Formatted a
Formatted String
"" a
x String
""

-- | Create a formatted value with formatting directives that are applied to
-- the whole value. The actual formatting has to be done by the backend.
formatted
    :: String -- ^ Prefix text directives for formatting.
    -> a -- ^ The content to be formatted.
    -> String -- ^ Suffix text directives for formatting.
    -> Formatted a
formatted :: String -> a -> String -> Formatted a
formatted = String -> a -> String -> Formatted a
forall a. String -> a -> String -> Formatted a
Formatted

instance IsString a => IsString (Formatted a) where
    fromString :: String -> Formatted a
fromString = a -> Formatted a
forall a. a -> Formatted a
plain (a -> Formatted a) -> (String -> a) -> String -> Formatted a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

instance Cell a => Cell (Formatted a) where
    dropLeft :: Int -> Formatted a -> Formatted a
dropLeft Int
i = (a -> a) -> Formatted a -> Formatted a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Formatted a -> Formatted a)
-> (a -> a) -> Formatted a -> Formatted a
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
forall a. Cell a => Int -> a -> a
dropLeft Int
i
    dropRight :: Int -> Formatted a -> Formatted a
dropRight Int
i = (a -> a) -> Formatted a -> Formatted a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Formatted a -> Formatted a)
-> (a -> a) -> Formatted a -> Formatted a
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
forall a. Cell a => Int -> a -> a
dropRight Int
i
    dropBoth :: Int -> Int -> Formatted a -> Formatted a
dropBoth Int
l Int
r = (a -> a) -> Formatted a -> Formatted a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Formatted a -> Formatted a)
-> (a -> a) -> Formatted a -> Formatted a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> a -> a
forall a. Cell a => Int -> Int -> a -> a
dropBoth Int
l Int
r
    visibleLength :: Formatted a -> Int
visibleLength = a -> Int
forall a. Cell a => a -> Int
visibleLength (a -> Int) -> (Formatted a -> a) -> Formatted a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatted a -> a
forall a. Formatted a -> a
content
    measureAlignment :: (Char -> Bool) -> Formatted a -> AlignInfo
measureAlignment Char -> Bool
p = (Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
p (a -> AlignInfo) -> (Formatted a -> a) -> Formatted a -> AlignInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatted a -> a
forall a. Formatted a -> a
content

    -- | Surrounds the content with the directives.
    buildCell :: Formatted a -> b
buildCell Formatted a
h = String -> b
forall a. StringBuilder a => String -> a
stringB (Formatted a -> String
forall a. Formatted a -> String
prefix Formatted a
h) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Formatted a -> a
forall a. Formatted a -> a
content Formatted a
h) b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB (Formatted a -> String
forall a. Formatted a -> String
suffix Formatted a
h)