    {-# 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 a. Eq a => a -> [a] -> 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 m a. Monoid m => (a -> m) -> [a] -> m
    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 a b. (a -> b) -> Maybe a -> Maybe b
    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
              { 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