{-# 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 inputLines = do
    tw <- tabWidth
    pure (fmap (expandText tw) inputLines)

-- | Expand a single line
expandLineForDisplay :: MonadReader Environment m => Text -> m Text
expandLineForDisplay inputLine = do
    tw <- tabWidth
    pure (expandText tw inputLine)

-- | Expand an ANSI formatted line
expandFormattedLine :: MonadReader Environment m => Formatted a -> m (Formatted a)
expandFormattedLine inputLine = do
    tw <- tabWidth
    pure (mapTextWithPos (expandTextAt tw . Position) inputLine)


newtype TabWidth = TabWidth Int
newtype Position = Position Int

tabWidth :: MonadReader Environment m => m TabWidth
tabWidth = view (config . tabstop . to TabWidth)

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

expandTextAt :: TabWidth -> Position -> Text -> Text
expandTextAt tw pos =
    T.pack . expandSpecialChars . expandTabs tw pos . T.unpack

expandTabs :: TabWidth -> Position -> String -> String
expandTabs (TabWidth tw) (Position p) = go p
  where go pos (c:cs)
            | c == '\t' = let shift = tw - (pos `mod` tw)
                          in  replicate shift ' ' ++ go (pos + shift) cs
            | otherwise = c : go (pos + 1) cs
        go _ [] = []

expandSpecialChars :: String -> String
expandSpecialChars = \case
    c:cs | ord c < 32  -> ['^', chr (ord c + 64)] ++ expandSpecialChars cs
         | otherwise   -> c : expandSpecialChars cs
    []                 -> []