{-# LANGUAGE OverloadedStrings #-}

module Data.Text.FixWhitespace
  ( CheckResult(..)
  , checkFile
  , LineError(..)
  , displayLineError
  , transform
  , transformWithLog
  , TabSize
  , Verbose
  , defaultTabSize
  )
  where

import           Control.Monad                     ( (<=<) )
import           Control.Monad.Trans.Writer.Strict ( Writer, runWriter, tell )
import           Control.Exception                 ( IOException, handle )

import           Data.Char                         ( GeneralCategory(Space, Format), generalCategory )
import           Data.Text                         ( Text )
import qualified Data.Text                         as Text
import qualified Data.Text.IO                      as Text  {- Strict IO -}

import           System.IO                         ( IOMode(ReadMode), hSetEncoding, utf8, withFile )

import           Data.List.Extra.Drop              ( dropWhileEnd1, dropWhile1 )

type Verbose = Bool
type TabSize = Int

-- | Default tab size.
--
defaultTabSize :: TabSize
defaultTabSize :: Int
defaultTabSize = Int
8

-- | Result of checking a file against the whitespace policy.
--
data CheckResult
  = CheckOK
      -- ^ The file satifies the policy.
  | CheckViolation Text [LineError]
      -- ^ The file violates the policy, a fix and a list of
      --   violating lines are returned.
  | CheckIOError IOException
      -- ^ An I/O error occurred while accessing the file.
      --   (E.g., the file is not UTF8 encoded.)

-- | Represents a line of input violating whitespace rules.
--   Stores the index of the line and the line itself.
data LineError = LineError Int Text

-- | Check a file against the whitespace policy,
--   returning a fix if violations occurred.
--
checkFile :: TabSize -> Verbose -> FilePath -> IO CheckResult
checkFile :: Int -> Verbose -> FilePath -> IO CheckResult
checkFile Int
tabSize Verbose
verbose FilePath
f =
  (IOException -> IO CheckResult) -> IO CheckResult -> IO CheckResult
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\ (IOException
e :: IOException) -> CheckResult -> IO CheckResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckResult -> IO CheckResult) -> CheckResult -> IO CheckResult
forall a b. (a -> b) -> a -> b
$ IOException -> CheckResult
CheckIOError IOException
e) (IO CheckResult -> IO CheckResult)
-> IO CheckResult -> IO CheckResult
forall a b. (a -> b) -> a -> b
$
    FilePath -> IOMode -> (Handle -> IO CheckResult) -> IO CheckResult
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
f IOMode
ReadMode ((Handle -> IO CheckResult) -> IO CheckResult)
-> (Handle -> IO CheckResult) -> IO CheckResult
forall a b. (a -> b) -> a -> b
$ \ Handle
h -> do
      Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
      Text
s <- Handle -> IO Text
Text.hGetContents Handle
h
      let (Text
s', [LineError]
lvs)
            | Verbose
verbose   = Int -> Text -> (Text, [LineError])
transformWithLog Int
tabSize Text
s
            | Verbose
otherwise = (Int -> Text -> Text
transform Int
tabSize Text
s, [])
      CheckResult -> IO CheckResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckResult -> IO CheckResult) -> CheckResult -> IO CheckResult
forall a b. (a -> b) -> a -> b
$ if Text
s' Text -> Text -> Verbose
forall a. Eq a => a -> a -> Verbose
== Text
s then CheckResult
CheckOK else Text -> [LineError] -> CheckResult
CheckViolation Text
s' [LineError]
lvs

transform
  :: TabSize   -- ^ Expand tab characters to so many spaces.  Keep tabs if @<= 0@.
  -> Text      -- ^ Text before transformation.
  -> Text      -- ^ Text after transformation.
transform :: Int -> Text -> Text
transform Int
tabSize =
  [Text] -> Text
Text.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Text] -> [Text]
removeFinalEmptyLinesExceptOne ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
removeTrailingWhitespace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Int -> Text -> Text
convertTabs Int
tabSize) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> [Text]
Text.lines
  where
  removeFinalEmptyLinesExceptOne :: [Text] -> [Text]
removeFinalEmptyLinesExceptOne =
    [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Verbose) -> [Text] -> [Text]
forall a. (a -> Verbose) -> [a] -> [a]
dropWhile1 Text -> Verbose
Text.null ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse

-- | The transformation monad: maintains info about lines that
--   violate the rules. Used in the verbose mode to build a log.
--
type TransformM = Writer [LineError]

-- | Transforms the contents of a file.
--
transformWithLog
  :: TabSize             -- ^ Expand tab characters to so many spaces.  Keep tabs if @<= 0@.
  -> Text                -- ^ Text before transformation.
  -> (Text, [LineError]) -- ^ Text after transformation and violating lines if any.
transformWithLog :: Int -> Text -> (Text, [LineError])
transformWithLog Int
tabSize =
  Writer [LineError] Text -> (Text, [LineError])
forall w a. Writer w a -> (a, w)
runWriter (Writer [LineError] Text -> (Text, [LineError]))
-> (Text -> Writer [LineError] Text) -> Text -> (Text, [LineError])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ([Text] -> Text)
-> WriterT [LineError] Identity [Text] -> Writer [LineError] Text
forall a b.
(a -> b)
-> WriterT [LineError] Identity a -> WriterT [LineError] Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.unlines (WriterT [LineError] Identity [Text] -> Writer [LineError] Text)
-> (Text -> WriterT [LineError] Identity [Text])
-> Text
-> Writer [LineError] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [(Int, Text)] -> WriterT [LineError] Identity [Text]
fixAllViolations ([(Int, Text)] -> WriterT [LineError] Identity [Text])
-> (Text -> [(Int, Text)])
-> Text
-> WriterT [LineError] Identity [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([Text] -> [(Int, Text)])
-> (Text -> [Text]) -> Text -> [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> [Text]
Text.lines
  where
  fixAllViolations :: [(Int,Text)] -> TransformM [Text]
  fixAllViolations :: [(Int, Text)] -> WriterT [LineError] Identity [Text]
fixAllViolations =
    [Text] -> WriterT [LineError] Identity [Text]
removeFinalEmptyLinesExceptOne
    ([Text] -> WriterT [LineError] Identity [Text])
-> ([(Int, Text)] -> WriterT [LineError] Identity [Text])
-> [(Int, Text)]
-> WriterT [LineError] Identity [Text]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
    ((Int, Text) -> Writer [LineError] Text)
-> [(Int, Text)] -> WriterT [LineError] Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Text -> Text) -> (Int, Text) -> Writer [LineError] Text
fixLineWith ((Text -> Text) -> (Int, Text) -> Writer [LineError] Text)
-> (Text -> Text) -> (Int, Text) -> Writer [LineError] Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeTrailingWhitespace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
convertTabs Int
tabSize)

  removeFinalEmptyLinesExceptOne :: [Text] -> TransformM [Text]
  removeFinalEmptyLinesExceptOne :: [Text] -> WriterT [LineError] Identity [Text]
removeFinalEmptyLinesExceptOne [Text]
ls
    | Int
lenLs Int -> Int -> Verbose
forall a. Eq a => a -> a -> Verbose
== Int
lenLs' = [Text] -> WriterT [LineError] Identity [Text]
forall a. a -> WriterT [LineError] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ls
    | Verbose
otherwise       = do
        [LineError] -> WriterT [LineError] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([LineError] -> WriterT [LineError] Identity ())
-> [LineError] -> WriterT [LineError] Identity ()
forall a b. (a -> b) -> a -> b
$ (Int -> Text -> LineError) -> [Int] -> [Text] -> [LineError]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> LineError
LineError [Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenLs' ..] [Text]
els
        [Text] -> WriterT [LineError] Identity [Text]
forall a. a -> WriterT [LineError] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ls'
    where
    ls' :: [Text]
ls'    = (Text -> Verbose) -> [Text] -> [Text]
forall a. (a -> Verbose) -> [a] -> [a]
dropWhileEnd1 Text -> Verbose
Text.null [Text]
ls
    lenLs :: Int
lenLs  = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls
    lenLs' :: Int
lenLs' = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls'
    els :: [Text]
els    = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate (Int
lenLs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenLs') Text
""

  fixLineWith :: (Text -> Text) -> (Int, Text) -> TransformM Text
  fixLineWith :: (Text -> Text) -> (Int, Text) -> Writer [LineError] Text
fixLineWith Text -> Text
fixer (Int
i, Text
l)
    | Text
l Text -> Text -> Verbose
forall a. Eq a => a -> a -> Verbose
== Text
l'   = Text -> Writer [LineError] Text
forall a. a -> WriterT [LineError] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
l
    | Verbose
otherwise = do
        [LineError] -> WriterT [LineError] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Int -> Text -> LineError
LineError Int
i Text
l]
        Text -> Writer [LineError] Text
forall a. a -> WriterT [LineError] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
l'
    where
    l' :: Text
l' = Text -> Text
fixer Text
l

removeTrailingWhitespace :: Text -> Text
removeTrailingWhitespace :: Text -> Text
removeTrailingWhitespace =
  (Char -> Verbose) -> Text -> Text
Text.dropWhileEnd ((Char -> Verbose) -> Text -> Text)
-> (Char -> Verbose) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \ Char
c -> Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Verbose
forall a. Eq a => a -> [a] -> Verbose
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Verbose
`elem` [GeneralCategory
Space,GeneralCategory
Format] Verbose -> Verbose -> Verbose
|| Char
c Char -> Char -> Verbose
forall a. Eq a => a -> a -> Verbose
== Char
'\t'

convertTabs :: TabSize -> Text -> Text
convertTabs :: Int -> Text -> Text
convertTabs Int
tabSize = if Int
tabSize Int -> Int -> Verbose
forall a. Ord a => a -> a -> Verbose
<= Int
0 then Text -> Text
forall a. a -> a
id else
  FilePath -> Text
Text.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Int) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Int) -> FilePath)
-> (Text -> (FilePath, Int)) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Int) -> Char -> (FilePath, Int))
-> (FilePath, Int) -> FilePath -> (FilePath, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int -> (FilePath, Int) -> Char -> (FilePath, Int)
convertOne Int
tabSize) ([], Int
0) (FilePath -> (FilePath, Int))
-> (Text -> FilePath) -> Text -> (FilePath, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack

convertOne :: TabSize -> (String, Int) -> Char -> (String, Int)
convertOne :: Int -> (FilePath, Int) -> Char -> (FilePath, Int)
convertOne Int
tabSize (FilePath
a, Int
p) Char
'\t' = (Int -> FilePath -> FilePath
addSpaces Int
n FilePath
a, Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
  where
  n :: Int
n = Int
tabSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabSize  -- Here, tabSize > 0 is guaranteed
convertOne Int
_tabSize (FilePath
a, Int
p) Char
c = (Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
a, Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

addSpaces :: Int -> String -> String
addSpaces :: Int -> FilePath -> FilePath
addSpaces Int
n = (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
n Char
' ' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)

-- | Print a erroneous line with 'visibleSpaces'.
--
displayLineError :: FilePath -> LineError -> Text
displayLineError :: FilePath -> LineError -> Text
displayLineError FilePath
fname (LineError Int
i Text
l) = [Text] -> Text
Text.concat
  [ FilePath -> Text
Text.pack FilePath
fname
  , Text
":"
  , FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i
  , Text
": "
  , Text -> Text
visibleSpaces Text
l
  ]

-- | Replace spaces and tabs with visible characters for presentation purposes.
--   Space turns into '·' and tab into '<TAB>'.
--
visibleSpaces :: Text -> Text
visibleSpaces :: Text -> Text
visibleSpaces Text
s
  | Text -> Verbose
Text.null Text
s = Text
"<NEWLINE>"
  | Verbose
otherwise = ((Char -> Text) -> Text -> Text) -> Text -> (Char -> Text) -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char -> Text) -> Text -> Text
Text.concatMap Text
s ((Char -> Text) -> Text) -> (Char -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \case
      Char
'\t' -> Text
"<TAB>"
      Char
' '  -> Text
"·"
      Char
c    -> FilePath -> Text
Text.pack [Char
c]