{-# LANGUAGE LambdaCase #-}

module Data.String.Interpolate.Lines where

import Data.Function  ( on )
import Data.List      ( find )
import Data.Semigroup ( Min(..) )

import Data.String.Interpolate.Types

isBlankLine :: [InterpSegment] -> Bool
isBlankLine :: [InterpSegment] -> Bool
isBlankLine [] = Bool
True
isBlankLine (Expression String
_ : [InterpSegment]
_) = Bool
False
isBlankLine (Spaces Int
_ : [InterpSegment]
rest) = [InterpSegment] -> Bool
isBlankLine [InterpSegment]
rest
isBlankLine (Tabs Int
_ : [InterpSegment]
rest) = [InterpSegment] -> Bool
isBlankLine [InterpSegment]
rest
isBlankLine (Verbatim String
str:[InterpSegment]
rest) = String -> Bool
blank String
str Bool -> Bool -> Bool
&& [InterpSegment] -> Bool
isBlankLine [InterpSegment]
rest
  where
    blank :: String -> Bool
    blank :: String -> Bool
blank = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char
' ', Char
'\t'])

-- |
-- Go the other direction, from a `Line' to the input that produced it.
displayLine :: Line -> String
displayLine :: [InterpSegment] -> String
displayLine = (InterpSegment -> String) -> [InterpSegment] -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap InterpSegment -> String
displaySegment
  where
    displaySegment :: InterpSegment -> String
    displaySegment :: InterpSegment -> String
displaySegment (Expression String
expr) = String
"#{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
    displaySegment (Verbatim String
str)    = String
str
      -- Above case is technically not correct due to escaped characters,
      -- but for the purposes of pinpointing where in a user's interpolation
      -- a problem is, it's good enough.
    displaySegment (Spaces Int
n)        = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
    displaySegment (Tabs Int
n)          = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'\t'

-- |
-- Remove min indentation from given lines, using the minimum indentation
-- found within the lines. Gives back warnings for mixed indentation if
-- any are found.
handleIndents :: Lines -> ([IndentWarning], Lines)
handleIndents :: Lines -> ([IndentWarning], Lines)
handleIndents Lines
lines =
  let mindent :: Mindent
mindent = Lines -> Mindent
mindentation Lines
lines
  in (Mindent -> Lines -> [IndentWarning]
findMixedIndents Mindent
mindent Lines
lines, Mindent -> Lines -> Lines
reduceIndents Mindent
mindent Lines
lines)

data Mindent = UsesSpaces Int | UsesTabs Int

data IndentWarning = IndentWarning
  { IndentWarning -> String
indentLine :: String
  , IndentWarning -> Mindent
indentBase :: Mindent
  }

mindentation :: Lines -> Mindent
mindentation :: Lines -> Mindent
mindentation Lines
lines =
  let
    nonblank :: Lines
nonblank = ([InterpSegment] -> Bool) -> Lines -> Lines
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([InterpSegment] -> Bool) -> [InterpSegment] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InterpSegment] -> Bool
isBlankLine) Lines
lines
    withIndent :: Maybe [InterpSegment]
withIndent = ([InterpSegment] -> Bool) -> Lines -> Maybe [InterpSegment]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\case { Spaces Int
_ : [InterpSegment]
_ -> Bool
True; Tabs Int
_ : [InterpSegment]
_ -> Bool
True; [InterpSegment]
_ -> Bool
False }) Lines
nonblank
  in case Maybe [InterpSegment]
withIndent of
      Maybe [InterpSegment]
Nothing -> Int -> Mindent
UsesSpaces Int
0
      Just (Spaces Int
_ : [InterpSegment]
_) ->
        Mindent -> (Int -> Mindent) -> Maybe Int -> Mindent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Mindent
UsesSpaces Int
0) Int -> Mindent
UsesSpaces (Maybe Int -> Mindent) -> Maybe Int -> Mindent
forall a b. (a -> b) -> a -> b
$
          (InterpSegment -> Maybe Int) -> Maybe Int -> Lines -> Maybe Int
findMinIndent (\case { Spaces Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n; InterpSegment
_ -> Maybe Int
forall a. Maybe a
Nothing }) Maybe Int
forall a. Maybe a
Nothing Lines
nonblank
      Just (Tabs Int
_ : [InterpSegment]
_) ->
        Mindent -> (Int -> Mindent) -> Maybe Int -> Mindent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Mindent
UsesSpaces Int
0) Int -> Mindent
UsesTabs (Maybe Int -> Mindent) -> Maybe Int -> Mindent
forall a b. (a -> b) -> a -> b
$
          (InterpSegment -> Maybe Int) -> Maybe Int -> Lines -> Maybe Int
findMinIndent (\case { Tabs Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n; InterpSegment
_ -> Maybe Int
forall a. Maybe a
Nothing }) Maybe Int
forall a. Maybe a
Nothing Lines
nonblank
      Just [InterpSegment]
_ -> Int -> Mindent
UsesSpaces Int
0
  where
    findMinIndent :: (InterpSegment -> Maybe Int) -> Maybe Int -> [[InterpSegment]] -> Maybe Int
    findMinIndent :: (InterpSegment -> Maybe Int) -> Maybe Int -> Lines -> Maybe Int
findMinIndent InterpSegment -> Maybe Int
_ Maybe Int
found [] = Maybe Int
found
    findMinIndent InterpSegment -> Maybe Int
f Maybe Int
found ((InterpSegment
seg:[InterpSegment]
_):Lines
rest) =
      (InterpSegment -> Maybe Int) -> Maybe Int -> Lines -> Maybe Int
findMinIndent InterpSegment -> Maybe Int
f (Min Int -> Int
forall a. Min a -> a
getMin (Min Int -> Int) -> Maybe (Min Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Min Int) -> Maybe (Min Int) -> Maybe (Min Int))
-> (Maybe Int -> Maybe (Min Int))
-> Maybe Int
-> Maybe Int
-> Maybe (Min Int)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Maybe (Min Int) -> Maybe (Min Int) -> Maybe (Min Int)
forall a. Monoid a => a -> a -> a
mappend ((Int -> Min Int) -> Maybe Int -> Maybe (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Min Int
forall a. a -> Min a
Min) (InterpSegment -> Maybe Int
f InterpSegment
seg) Maybe Int
found) Lines
rest
    findMinIndent InterpSegment -> Maybe Int
f Maybe Int
found ([]:Lines
rest) = (InterpSegment -> Maybe Int) -> Maybe Int -> Lines -> Maybe Int
findMinIndent InterpSegment -> Maybe Int
f Maybe Int
found Lines
rest

reduceIndents :: Mindent -> Lines -> Lines
reduceIndents :: Mindent -> Lines -> Lines
reduceIndents Mindent
_ [] = []
reduceIndents i :: Mindent
i@(UsesSpaces Int
indent) ((Spaces Int
n:[InterpSegment]
line):Lines
rest) =
  (Int -> InterpSegment
Spaces (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indent)InterpSegment -> [InterpSegment] -> [InterpSegment]
forall a. a -> [a] -> [a]
:[InterpSegment]
line) [InterpSegment] -> Lines -> Lines
forall a. a -> [a] -> [a]
: Mindent -> Lines -> Lines
reduceIndents Mindent
i Lines
rest
reduceIndents i :: Mindent
i@(UsesTabs Int
indent) ((Tabs Int
n:[InterpSegment]
line):Lines
rest) =
  (Int -> InterpSegment
Tabs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indent)InterpSegment -> [InterpSegment] -> [InterpSegment]
forall a. a -> [a] -> [a]
:[InterpSegment]
line) [InterpSegment] -> Lines -> Lines
forall a. a -> [a] -> [a]
: Mindent -> Lines -> Lines
reduceIndents Mindent
i Lines
rest
reduceIndents Mindent
i ([InterpSegment]
line:Lines
rest) = [InterpSegment]
line [InterpSegment] -> Lines -> Lines
forall a. a -> [a] -> [a]
: Mindent -> Lines -> Lines
reduceIndents Mindent
i Lines
rest

findMixedIndents :: Mindent -> Lines -> [IndentWarning]
findMixedIndents :: Mindent -> Lines -> [IndentWarning]
findMixedIndents Mindent
mindent = Lines -> [IndentWarning]
go
  where
    go :: [[InterpSegment]] -> [IndentWarning]
    go :: Lines -> [IndentWarning]
go [] = []
    go ([InterpSegment]
line:Lines
lines) = do
      let
        ind :: [InterpSegment]
ind = [InterpSegment] -> [InterpSegment]
indentation [InterpSegment]
line
        warn :: IndentWarning
warn = IndentWarning :: String -> Mindent -> IndentWarning
IndentWarning
          { indentLine :: String
indentLine = [InterpSegment] -> String
displayLine [InterpSegment]
line, indentBase :: Mindent
indentBase = Mindent
mindent }
      case (Mindent
mindent, (InterpSegment -> Bool) -> [InterpSegment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InterpSegment -> Bool
isSpaces [InterpSegment]
ind, (InterpSegment -> Bool) -> [InterpSegment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InterpSegment -> Bool
isTabs [InterpSegment]
ind) of
        (UsesSpaces Int
_, Bool
_, Bool
True) -> IndentWarning
warn IndentWarning -> [IndentWarning] -> [IndentWarning]
forall a. a -> [a] -> [a]
: Lines -> [IndentWarning]
go Lines
lines
        (UsesTabs Int
_, Bool
True, Bool
_)   -> IndentWarning
warn IndentWarning -> [IndentWarning] -> [IndentWarning]
forall a. a -> [a] -> [a]
: Lines -> [IndentWarning]
go Lines
lines
        (Mindent, Bool, Bool)
_                       -> Lines -> [IndentWarning]
go Lines
lines

    indentation :: [InterpSegment] -> [InterpSegment]
    indentation :: [InterpSegment] -> [InterpSegment]
indentation =
      (InterpSegment -> Bool) -> [InterpSegment] -> [InterpSegment]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\case { Spaces Int
_ -> Bool
True; Tabs Int
_ -> Bool
True; InterpSegment
_ -> Bool
False })

    isSpaces :: InterpSegment -> Bool
    isSpaces :: InterpSegment -> Bool
isSpaces (Spaces Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    isSpaces InterpSegment
_          = Bool
False

    isTabs :: InterpSegment -> Bool
    isTabs :: InterpSegment -> Bool
isTabs (Tabs Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    isTabs InterpSegment
_        = Bool
False