{-# LANGUAGE BlockArguments #-}

module Ghcitui.Brick.EventUtils
    ( shortenText
    , commonPrefixes
    , reflowText
    , invalidateLineCache
    ) where

import qualified Brick.Main as B
import qualified Brick.Types as B

import Data.List (foldl')
import qualified Data.Text as T

-- | Limit text to a given length, and cut with an elipses.
shortenText :: Int -> T.Text -> T.Text
shortenText :: Int -> Text -> Text
shortenText Int
maxLen Text
text
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLen = Text
text
    | Bool
otherwise = Int -> Text -> Text
T.take (Int
maxLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…"
  where
    len :: Int
len = Text -> Int
T.length Text
text

-- | Return the shared prefix among all the input Texts.
commonPrefixes :: [T.Text] -> T.Text
commonPrefixes :: [Text] -> Text
commonPrefixes [] = Text
""
commonPrefixes (Text
t : [Text]
ts) = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Text -> Text -> Text
folder Text
t [Text]
ts
  where
    folder :: T.Text -> T.Text -> T.Text
    folder :: Text -> Text -> Text
folder Text
acc Text
t' = case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
acc Text
t' of
        Just (Text
p, Text
_, Text
_) -> Text
p
        Maybe (Text, Text, Text)
_ -> Text
""

-- TODO: Invalidate only the lines instead of the entire application.
invalidateLineCache :: (Ord n) => B.EventM n (state n) ()
invalidateLineCache :: forall n (state :: * -> *). Ord n => EventM n (state n) ()
invalidateLineCache = EventM n (state n) ()
forall n s. Ord n => EventM n s ()
B.invalidateCache

{- | Reflow entries of text into columns.
     Mostly useful right now for printing autocomplete suggestions into columns.
-}
reflowText
    :: Int
    -- ^ Num columns
    -> Int
    -- ^ Column width
    -> [T.Text]
    -- ^ Text entries to reflow
    -> [T.Text]
    -- ^ Reflowed lines.
reflowText :: Int -> Int -> [Text] -> [Text]
reflowText Int
numCols Int
colWidth = [Text] -> [Text]
go
  where
    go :: [T.Text] -> [T.Text]
    go :: [Text] -> [Text]
go [] = []
    go [Text]
entries' = [Text] -> Text
makeLine [Text]
toMakeLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
rest
      where
        ([Text]
toMakeLine, [Text]
rest) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
numCols [Text]
entries'
    maxTextLen :: Int
maxTextLen = Int
colWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    makeLine :: [Text] -> Text
makeLine [Text]
xs = [Text] -> Text
T.concat (Int -> Char -> Text -> Text
T.justifyLeft Int
colWidth Char
' ' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
shortenText Int
maxTextLen (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
xs)