{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- | Common definitions for pre- and post- processing.
module Ormolu.Processing.Common
  ( removeIndentation,
    reindent,
    linesInRegion,
    regionInbetween,
    intSetToRegions,
  )
where

import Data.Char (isSpace)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Text (Text)
import qualified Data.Text as T
import Ormolu.Config

-- | Remove indentation from a given 'String'. Return the input with
-- indentation removed and the detected indentation level.
removeIndentation :: String -> (String, Int)
removeIndentation :: String -> (String, Int)
removeIndentation (String -> [String]
lines -> [String]
xs) = ([String] -> String
unlines (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
n (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs), Int
n)
  where
    n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (String -> Int
getIndent (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs)
    getIndent :: String -> Int
getIndent String
y =
      if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
y
        then Int
0
        else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace String
y)

-- | Add indentation to a 'Text'.
reindent :: Int -> Text -> Text
reindent :: Int -> Text -> Text
reindent Int
i = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.replicate Int
i Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- | All lines in the region specified by 'RegionDeltas'.
linesInRegion :: RegionDeltas -> String -> String
linesInRegion :: RegionDeltas -> String -> String
linesInRegion RegionDeltas {Int
regionSuffixLength :: RegionDeltas -> Int
regionPrefixLength :: RegionDeltas -> Int
regionSuffixLength :: Int
regionPrefixLength :: Int
..} (String -> [String]
lines -> [String]
ls) = [String] -> String
unlines [String]
middle
  where
    ([String]
_, [String]
nonPrefix) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
regionPrefixLength [String]
ls
    middle :: [String]
middle = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
nonPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
regionSuffixLength) [String]
nonPrefix

-- | Get the region after the end of the first and till the end of
-- the second region.
regionInbetween ::
  -- | Total number of lines
  Int ->
  RegionDeltas ->
  RegionDeltas ->
  RegionDeltas
regionInbetween :: Int -> RegionDeltas -> RegionDeltas -> RegionDeltas
regionInbetween Int
total RegionDeltas
r RegionDeltas
r' =
  RegionDeltas :: Int -> Int -> RegionDeltas
RegionDeltas
    { regionPrefixLength :: Int
regionPrefixLength = Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- RegionDeltas -> Int
regionSuffixLength RegionDeltas
r,
      regionSuffixLength :: Int
regionSuffixLength = Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- RegionDeltas -> Int
regionPrefixLength RegionDeltas
r'
    }

-- | Convert a set of line indices into disjoint 'RegionDelta's
intSetToRegions ::
  -- | Total number of lines
  Int ->
  IntSet ->
  [RegionDeltas]
intSetToRegions :: Int -> IntSet -> [RegionDeltas]
intSetToRegions Int
total (IntSet -> [Int]
IntSet.toAscList -> [Int]
indices) =
  Int -> RegionIndices -> RegionDeltas
regionIndicesToDeltas Int
total (RegionIndices -> RegionDeltas)
-> [RegionIndices] -> [RegionDeltas]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Int, Int) -> [Int] -> [RegionIndices]
go Maybe (Int, Int)
forall a. Maybe a
Nothing [Int]
indices
  where
    go :: Maybe (Int, Int) -> [Int] -> [RegionIndices]
go Maybe (Int, Int)
Nothing [] = []
    go (Just (Int
a, Int
b)) [] = [Maybe Int -> Maybe Int -> RegionIndices
RegionIndices (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
b)]
    go Maybe (Int, Int)
Nothing (Int
i : [Int]
is) = Maybe (Int, Int) -> [Int] -> [RegionIndices]
go ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
i, Int
i)) [Int]
is
    go (Just (Int
a, Int
b)) (Int
i : [Int]
is)
      | Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Maybe (Int, Int) -> [Int] -> [RegionIndices]
go ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
a, Int
i)) [Int]
is
      | Bool
otherwise = Maybe Int -> Maybe Int -> RegionIndices
RegionIndices (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
b) RegionIndices -> [RegionIndices] -> [RegionIndices]
forall a. a -> [a] -> [a]
: Maybe (Int, Int) -> [Int] -> [RegionIndices]
go ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
i, Int
i)) [Int]
is