{-# LANGUAGE FlexibleContexts #-}
module Vgrep.Text (
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
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)
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)
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
[] -> []