{-# LANGUAGE OverloadedStrings #-}
module Data.Text.AlignEqual where
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Safe (maximumMay)
prefixLength
:: Text
-> Maybe Int
prefixLength :: Text -> Maybe Int
prefixLength Text
line =
if Text -> Bool
T.null Text
suffix
then Maybe Int
forall a. Maybe a
Nothing
else Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int
T.length Text
prefix)
where
(Text
prefix, Text
suffix) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"=" Text
line
adjustLine
:: Int
-> Text
-> Text
adjustLine :: Int -> Text -> Text
adjustLine Int
desiredPrefixLength Text
oldLine = Text
newLine
where
(Text
prefix, Text
suffix) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"=" Text
oldLine
actualPrefixLength :: Int
actualPrefixLength = Text -> Int
T.length Text
prefix
additionalSpaces :: Int
additionalSpaces = Int
desiredPrefixLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actualPrefixLength
spaces :: Text
spaces = Int -> Text -> Text
T.replicate Int
additionalSpaces Text
" "
newLine :: Text
newLine = [Text] -> Text
T.concat [ Text
prefix, Text
spaces, Text
suffix ]
adjustText
:: Text
-> Text
adjustText :: Text -> Text
adjustText Text
oldText = Text
newText
where
oldLines :: [Text]
oldLines = Text -> [Text]
T.lines Text
oldText
prefixLengths :: [Maybe Int]
prefixLengths = (Text -> Maybe Int) -> [Text] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Int
prefixLength [Text]
oldLines
prefixLengths' :: [Int]
prefixLengths' = [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int]
prefixLengths
newLines :: [Text]
newLines =
case [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay [Int]
prefixLengths' of
Maybe Int
Nothing ->
[]
Just Int
desiredPrefixLength ->
(Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
adjustLine Int
desiredPrefixLength) [Text]
oldLines
newText :: Text
newText = [Text] -> Text
T.unlines [Text]
newLines