-- | String formatting utilities

module Hydra.Tools.Formatting where

import Hydra.Basics
import qualified Hydra.Lib.Strings as Strings

import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


data CaseConvention = CaseConventionCamel | CaseConventionPascal | CaseConventionLowerSnake | CaseConventionUpperSnake

convertCase :: CaseConvention -> CaseConvention -> String -> String
convertCase :: CaseConvention -> CaseConvention -> String -> String
convertCase CaseConvention
from CaseConvention
to String
original = case CaseConvention
to of
    CaseConvention
CaseConventionCamel -> String -> String
decapitalize (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (String -> String
capitalize (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Strings.toLower (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts)
    CaseConvention
CaseConventionPascal -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (String -> String
capitalize (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Strings.toLower (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts)
    CaseConvention
CaseConventionLowerSnake -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"_" (String -> String
Strings.toLower (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts)
    CaseConvention
CaseConventionUpperSnake -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"_" (String -> String
Strings.toUpper (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts)
  where
    parts :: [String]
parts = case CaseConvention
from of
      CaseConvention
CaseConventionCamel -> [String]
byCaps
      CaseConvention
CaseConventionPascal -> [String]
byCaps
      CaseConvention
CaseConventionLowerSnake -> [String]
byUnderscores
      CaseConvention
CaseConventionUpperSnake -> [String]
byUnderscores
    byUnderscores :: [String]
byUnderscores = String -> String -> [String]
Strings.splitOn String
"_" String
original
    byCaps :: [String]
byCaps = ([String] -> Char -> [String]) -> [String] -> String -> [String]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl [String] -> Char -> [String]
helper [String
""] (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
L.reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
decapitalize String
original
      where
        helper :: [String] -> Char -> [String]
helper (String
h:[String]
r) Char
c = [String
"" | Char -> Bool
C.isUpper Char
c] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
h)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
r)

convertCaseCamelToLowerSnake :: String -> String
convertCaseCamelToLowerSnake :: String -> String
convertCaseCamelToLowerSnake = CaseConvention -> CaseConvention -> String -> String
convertCase CaseConvention
CaseConventionCamel CaseConvention
CaseConventionLowerSnake

convertCaseCamelToUpperSnake :: String -> String
convertCaseCamelToUpperSnake :: String -> String
convertCaseCamelToUpperSnake = CaseConvention -> CaseConvention -> String -> String
convertCase CaseConvention
CaseConventionCamel CaseConvention
CaseConventionUpperSnake

convertCasePascalToUpperSnake :: String -> String
convertCasePascalToUpperSnake :: String -> String
convertCasePascalToUpperSnake = CaseConvention -> CaseConvention -> String -> String
convertCase CaseConvention
CaseConventionPascal CaseConvention
CaseConventionUpperSnake

escapeWithUnderscore :: S.Set String -> String -> String
escapeWithUnderscore :: Set String -> String -> String
escapeWithUnderscore Set String
reserved String
s = if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
s Set String
reserved then String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" else String
s

indentLines :: String -> String
indentLines :: String -> String
indentLines String
s = [String] -> String
unlines (String -> String
indent (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
s)
  where
    indent :: String -> String
indent String
l = String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

javaStyleComment :: String -> String
javaStyleComment :: String -> String
javaStyleComment String
s = String
"/**\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n */"

nonAlnumToUnderscores :: String -> String
nonAlnumToUnderscores :: String -> String
nonAlnumToUnderscores = String -> String
forall a. [a] -> [a]
L.reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> String
forall a b. (a, b) -> a
fst ((String, Bool) -> String)
-> (String -> (String, Bool)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Char -> (String, Bool))
-> (String, Bool) -> String -> (String, Bool)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (String, Bool) -> Char -> (String, Bool)
replace ([], Bool
False)
  where
    replace :: (String, Bool) -> Char -> (String, Bool)
replace (String
s, Bool
b) Char
c = if Char -> Bool
isAlnum Char
c
      then (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
s, Bool
False)
      else if Bool
b
        then (String
s, Bool
True)
        else (Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s, Bool
True)
    isAlnum :: Char -> Bool
isAlnum Char
c = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
      Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')
      Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')

sanitizeWithUnderscores :: S.Set String -> String -> String
sanitizeWithUnderscores :: Set String -> String -> String
sanitizeWithUnderscores Set String
reserved = Set String -> String -> String
escapeWithUnderscore Set String
reserved (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
nonAlnumToUnderscores

withCharacterAliases :: String -> String
withCharacterAliases :: String -> String
withCharacterAliases String
original = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.filter Char -> Bool
C.isAlphaNum (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
alias (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
original
  where
    alias :: Char -> String
alias Char
c = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe [Char
c] String -> String
capitalize (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Int -> Map Int String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Char -> Int
C.ord Char
c) Map Int String
aliases

    -- Taken from: https://cs.stanford.edu/people/miles/iso8859.html
    aliases :: Map Int String
aliases = [(Int, String)] -> Map Int String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
      (Int
32, String
"sp"),
      (Int
33, String
"excl"),
      (Int
34, String
"quot"),
      (Int
35, String
"num"),
      (Int
36, String
"dollar"),
      (Int
37, String
"percnt"),
      (Int
38, String
"amp"),
      (Int
39, String
"apos"),
      (Int
40, String
"lpar"),
      (Int
41, String
"rpar"),
      (Int
42, String
"ast"),
      (Int
43, String
"plus"),
      (Int
44, String
"comma"),
      (Int
45, String
"minus"),
      (Int
46, String
"period"),
      (Int
47, String
"sol"),
      (Int
58, String
"colon"),
      (Int
59, String
"semi"),
      (Int
60, String
"lt"),
      (Int
61, String
"equals"),
      (Int
62, String
"gt"),
      (Int
63, String
"quest"),
      (Int
64, String
"commat"),
      (Int
91, String
"lsqb"),
      (Int
92, String
"bsol"),
      (Int
93, String
"rsqb"),
      (Int
94, String
"circ"),
      (Int
95, String
"lowbar"),
      (Int
96, String
"grave"),
      (Int
123, String
"lcub"),
      (Int
124, String
"verbar"),
      (Int
125, String
"rcub"),
      (Int
126, String
"tilde")]

-- A simple soft line wrap which is suitable for code comments
wrapLine :: Int -> String -> String
wrapLine :: Int -> String -> String
wrapLine Int
maxlen = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String -> [String]
helper []
  where
    helper :: [String] -> String -> [String]
helper [String]
prev String
rem = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
rem Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxlen
        then [String] -> [String]
forall a. [a] -> [a]
L.reverse (String
remString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
prev)
        else if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
prefix
        then [String] -> String -> [String]
helper (String
truncString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
prev) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
L.drop Int
maxlen String
rem
        else [String] -> String -> [String]
helper ((String -> String
forall a. HasCallStack => [a] -> [a]
init String
prefix)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
prev) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
L.drop Int
maxlen String
rem
      where
        trunc :: String
trunc = Int -> String -> String
forall a. Int -> [a] -> [a]
L.take Int
maxlen String
rem
        (String
prefix, String
suffix) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t') (String -> String
forall a. [a] -> [a]
reverse String
trunc) of
                                      (String
restRev, String
firstRev) -> (String -> String
forall a. [a] -> [a]
reverse String
firstRev, String -> String
forall a. [a] -> [a]
reverse String
restRev)