{-# LANGUAGE FlexibleContexts #-}
module Vgrep.Text (
    -- * Utilities for rendering 'Text'
    -- | Tabs and other characters below ASCII 32 cause problems in
    -- "Graphics.Vty", so we expand them to readable characters, e.g. @\\r@ to
    -- @^13@. Tabs are expanded to the configured 'Vgrep.Environment._tabstop'.
      expandForDisplay
    , expandLineForDisplay
    , expandFormattedLine
    ) where

import           Control.Lens.Compat
import           Control.Monad.Reader.Class
import           Data.Char
import           Data.Text                  (Text)
import qualified Data.Text                  as T

import Vgrep.Ansi
import Vgrep.Environment


-- | Expand a list of lines
expandForDisplay
    :: (Functor f, MonadReader Environment m)
    => f Text -> m (f Text)
expandForDisplay :: f Text -> m (f Text)
expandForDisplay f Text
inputLines = do
    TabWidth
tw <- m TabWidth
forall (m :: * -> *). MonadReader Environment m => m TabWidth
tabWidth
    f Text -> m (f Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TabWidth -> Text -> Text
expandText TabWidth
tw) f Text
inputLines)

-- | Expand a single line
expandLineForDisplay :: MonadReader Environment m => Text -> m Text
expandLineForDisplay :: Text -> m Text
expandLineForDisplay Text
inputLine = do
    TabWidth
tw <- m TabWidth
forall (m :: * -> *). MonadReader Environment m => m TabWidth
tabWidth
    Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TabWidth -> Text -> Text
expandText TabWidth
tw Text
inputLine)

-- | Expand an ANSI formatted line
expandFormattedLine :: MonadReader Environment m => Formatted a -> m (Formatted a)
expandFormattedLine :: Formatted a -> m (Formatted a)
expandFormattedLine Formatted a
inputLine = do
    TabWidth
tw <- m TabWidth
forall (m :: * -> *). MonadReader Environment m => m TabWidth
tabWidth
    Formatted a -> m (Formatted a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Text -> Text) -> Formatted a -> Formatted a
forall a. (Int -> Text -> Text) -> Formatted a -> Formatted a
mapTextWithPos (TabWidth -> Position -> Text -> Text
expandTextAt TabWidth
tw (Position -> Text -> Text)
-> (Int -> Position) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Position
Position) Formatted a
inputLine)


newtype TabWidth = TabWidth Int
newtype Position = Position Int

tabWidth :: MonadReader Environment m => m TabWidth
tabWidth :: m TabWidth
tabWidth = Getting TabWidth Environment TabWidth -> m TabWidth
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const TabWidth Config)
-> Environment -> Const TabWidth Environment
Lens' Environment Config
config ((Config -> Const TabWidth Config)
 -> Environment -> Const TabWidth Environment)
-> ((TabWidth -> Const TabWidth TabWidth)
    -> Config -> Const TabWidth Config)
-> Getting TabWidth Environment TabWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const TabWidth Int) -> Config -> Const TabWidth Config
Lens' Config Int
tabstop ((Int -> Const TabWidth Int) -> Config -> Const TabWidth Config)
-> ((TabWidth -> Const TabWidth TabWidth)
    -> Int -> Const TabWidth Int)
-> (TabWidth -> Const TabWidth TabWidth)
-> Config
-> Const TabWidth Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> TabWidth) -> SimpleGetter Int TabWidth
forall s a. (s -> a) -> SimpleGetter s a
to Int -> TabWidth
TabWidth)

expandText :: TabWidth -> Text -> Text
expandText :: TabWidth -> Text -> Text
expandText TabWidth
tw = TabWidth -> Position -> Text -> Text
expandTextAt TabWidth
tw (Int -> Position
Position Int
0)

expandTextAt :: TabWidth -> Position -> Text -> Text
expandTextAt :: TabWidth -> Position -> Text -> Text
expandTextAt TabWidth
tw Position
pos =
    String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
expandSpecialChars (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TabWidth -> Position -> String -> String
expandTabs TabWidth
tw Position
pos (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

expandTabs :: TabWidth -> Position -> String -> String
expandTabs :: TabWidth -> Position -> String -> String
expandTabs (TabWidth Int
tw) (Position Int
p) = Int -> String -> String
go Int
p
  where go :: Int -> String -> String
go Int
pos (Char
c:String
cs)
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = let shift :: Int
shift = Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
pos Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tw)
                          in  Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
shift Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
go (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift) String
cs
            | Bool
otherwise = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
go (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
cs
        go Int
_ [] = []

expandSpecialChars :: String -> String
expandSpecialChars :: String -> String
expandSpecialChars = \case
    Char
c:String
cs | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32  -> [Char
'^', Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64)] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
expandSpecialChars String
cs
         | Bool
otherwise   -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
expandSpecialChars String
cs
    []                 -> []