Lines.hs

{-# 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 [] = True
isBlankLine (Expression _ : _) = False
isBlankLine (Spaces _ : rest) = isBlankLine rest
isBlankLine (Tabs _ : rest) = isBlankLine rest
isBlankLine (Verbatim str:rest) = blank str && isBlankLine rest
  where
    blank :: String -> Bool
    blank = all (\c -> elem c [' ', '\t'])

-- |
-- Go the other direction, from a `Line' to the input that produced it.
displayLine :: Line -> String
displayLine = foldMap displaySegment
  where
    displaySegment :: InterpSegment -> String
    displaySegment (Expression expr) = "#{" ++ expr ++ "}"
    displaySegment (Verbatim str)    = 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 n)        = replicate n ' '
    displaySegment (Tabs n)          = replicate n '\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 =
  let mindent = mindentation lines
  in (findMixedIndents mindent lines, reduceIndents mindent lines)

data Mindent = UsesSpaces Int | UsesTabs Int

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

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

reduceIndents :: Mindent -> Lines -> Lines
reduceIndents _ [] = []
reduceIndents i@(UsesSpaces indent) ((Spaces n:line):rest) =
  (Spaces (n-indent):line) : reduceIndents i rest
reduceIndents i@(UsesTabs indent) ((Tabs n:line):rest) =
  (Tabs (n-indent):line) : reduceIndents i rest
reduceIndents i (line:rest) = line : reduceIndents i rest

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

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

    isSpaces :: InterpSegment -> Bool
    isSpaces (Spaces n) = n > 0
    isSpaces _          = False

    isTabs :: InterpSegment -> Bool
    isTabs (Tabs n) = n > 0
    isTabs _        = False