-- | Utility functions for working with text
module Data.Registry.Options.Text where

import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Text as T
import Protolude

-- | Hyphenate a camelCase Text into camel-case
camelCaseToHyphenated :: Text -> Text
camelCaseToHyphenated :: Text -> Text
camelCaseToHyphenated = Text -> [Text] -> Text
T.intercalate Text
"-" ([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 Text -> Text
T.toLower ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
splitCamelCase

-- | camelCase some hyphenated Text
hyphenatedToCamelCase :: Text -> Text
hyphenatedToCamelCase :: Text -> Text
hyphenatedToCamelCase Text
t =
  case Text -> Text -> [Text]
T.splitOn Text
"-" Text
t of
    [] -> Text
""
    Text
t1:[Text]
ts -> [Text] -> Text
T.concat (Text
t1Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text
T.toTitle (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts))

-- | Drop the leading names in a qualified name
--   dropQualifier "x.y.z" === "z"
dropQualifier :: Text -> Text
dropQualifier :: Text -> Text
dropQualifier Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"." Text
t

-- | Drop the prefix of a capitalized or uncapitalized name
--   dropPrefix Prefix = Prefix
--   dropPrefix PrefixName = Name
--   dropPrefix prefixName = Name
dropPrefix :: Text -> Text
dropPrefix :: Text -> Text
dropPrefix Text
t =
  case Text -> Text
forall a b. ConvertText a b => a -> b
toS (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
splitCamelCase Text
t of
    [] -> Text
t
    [Text
t1] -> Text
t1
    (Text
t1 : Text
t2 : [Text]
ts) ->
      [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
isCapitalized Text
t1 then Text
t2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts else Text -> Text
T.toLower Text
t2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts

-- | Split a camel cased word in several lower-cased strings
splitCamelCase :: Text -> [Text]
splitCamelCase :: Text -> [Text]
splitCamelCase = ([Char] -> Text) -> [[Char]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
forall a b. ConvertText a b => a -> b
toS ([[Char]] -> [Text]) -> (Text -> [[Char]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitCamelCaseString ([Char] -> [[Char]]) -> (Text -> [Char]) -> Text -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertText a b => a -> b
toS
  where
    splitCamelCaseString :: [Char] -> [[Char]]
splitCamelCaseString [] = []
    splitCamelCaseString (Char
c : [Char]
cs) = do
      let ([Char]
lower, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break Char -> Bool
C.isUpper [Char]
cs
      [Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
lower] [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]]
splitCamelCaseString [Char]
rest

-- | Return True if some text starts with a capital letter
isCapitalized :: Text -> Bool
isCapitalized :: Text -> Bool
isCapitalized Text
t = Text -> Bool
T.null Text
t Bool -> Bool -> Bool
|| Char -> Bool
C.isUpper (Text -> Char
T.head Text
t)

-- | Display 2 columns of text so that the texts in the second column are aligned
displayColumns :: [Text] -> [Text] -> [Text]
displayColumns :: [Text] -> [Text] -> [Text]
displayColumns [Text]
cs1 [Text]
cs2 = do
  let maxSize :: Int
maxSize = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay (Text -> Int
T.length (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
cs1)
  (\(Text
c1, Text
c2) -> Text
c1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
maxSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
c1) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c2) ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
cs1 [Text]
cs2

-- | Surround some text with brackets
bracketText :: Text -> Text
bracketText :: Text -> Text
bracketText = Bool -> Text -> Text
bracketTextWhen Bool
True

-- | Surround some text with brackets
bracketTextWhen :: Bool -> Text -> Text
bracketTextWhen :: Bool -> Text -> Text
bracketTextWhen Bool
False Text
t = Text
t
bracketTextWhen Bool
True Text
t = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Surround some text with parentheses
parenthesizeText :: Text -> Text
parenthesizeText :: Text -> Text
parenthesizeText = Bool -> Text -> Text
parenthesizeTextWhen Bool
True

-- | Surround some text with parentheses
parenthesizeTextWhen :: Bool -> Text -> Text
parenthesizeTextWhen :: Bool -> Text -> Text
parenthesizeTextWhen Bool
False Text
t = Text
t
parenthesizeTextWhen Bool
True Text
t = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Indent some text with a fixed piece of text
indent :: Text -> Text -> Text
indent :: Text -> Text -> Text
indent Text
i Text
t = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
t

-- | Remove spaces on the right
trimRight :: Text -> Text
trimRight :: Text -> Text
trimRight = [Char] -> Text
T.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Transform an underscore name to a camelcase one
underscoreToCamelCase :: Text -> Text
underscoreToCamelCase :: Text -> Text
underscoreToCamelCase Text
t =
  case Text -> Text -> [Text]
T.splitOn Text
"_" Text
t of
    [] -> Text
""
    Text
h:[Text]
ts -> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (Text -> Text
T.toTitle (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts)

-- | Transform a camelcase name to an underscore one
camelCaseToUnderscore :: Text -> Text
camelCaseToUnderscore :: Text -> Text
camelCaseToUnderscore Text
t = Text -> [Text] -> Text
T.intercalate Text
"_" (Text -> Text
T.toLower (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
splitCamelCase Text
t)

-- | Transform an underscore name to a hyphenated one
underscoreToHyphenated :: Text -> Text
underscoreToHyphenated :: Text -> Text
underscoreToHyphenated = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"_"

-- | Transform a hyphenated name to an underscore one
hyphenatedToUnderscore :: Text -> Text
hyphenatedToUnderscore :: Text -> Text
hyphenatedToUnderscore = Text -> [Text] -> Text
T.intercalate Text
"_" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"-"