{-# LANGUAGE OverloadedStrings #-}

-- | A module providing functions for text alignment and padding.
module Data.Text.AlignEqual where

import           Data.Text (Text)
import qualified Data.Text as T
import           Safe

-- | Calculates the number of characters preceding the first '=' sign in a text line.
--
-- >>> prefixLength "key=value"
-- 3
-- >>> prefixLength "a=b"
-- 1
-- >>> prefixLength "noequals"
-- 8
prefixLength
  :: Text
  -- ^ The input text line
  -> Int
  -- ^ The number of characters before the first '=' sign
prefixLength :: Text -> Int
prefixLength Text
line = Text -> Int
T.length Text
prefix
  where
    (Text
prefix, Text
_) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"=" Text
line

-- | Adjusts the prefix of a text line to a desired length by adding padding.
--
-- >>> adjustLine 5 "key=value"
-- "key  =value"
-- >>> adjustLine 3 "a=b"
-- "a  =b"
adjustLine
  :: Int
  -- ^ The desired prefix length
  -> Text
  -- ^ The text line to pad
  -> Text
  -- ^ The padded text line
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 ]

-- | Processes multi-line text to align all '=' signs across lines.
--   Adjusts the prefix length of each line to match the maximum prefix length.
--
-- >>> adjustText "key=value\na=b"
-- "key=value\na  =b"
-- >>> adjustText "x=y\nlong=var"
-- "x   =y\nlong=var"
adjustText
  :: Text
  -- ^ The input text (possibly multi-line)
  -> Text
  -- ^ The aligned text
adjustText :: Text -> Text
adjustText Text
oldText = Text
newText
  where
    oldLines :: [Text]
oldLines = Text -> [Text]
T.lines Text
oldText

    prefixLengths :: [Int]
prefixLengths = (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
prefixLength [Text]
oldLines

    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