{-# LANGUAGE CPP, OverloadedStrings #-}
module Frames.Utils (capitalize1, sanitizeTypeName) where
import Control.Arrow (first)
import Data.Char (isAlpha, isAlphaNum, toUpper)
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
capitalize1 :: T.Text -> T.Text
capitalize1 :: Text -> Text
capitalize1 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Char) -> Text -> Text
onHead Char -> Char
toUpper) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum)
where onHead :: (Char -> Char) -> Text -> Text
onHead Char -> Char
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Char -> Char
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons
sanitizeTypeName :: T.Text -> T.Text
sanitizeTypeName :: Text -> Text
sanitizeTypeName = forall {a}. (Eq a, IsString a, Semigroup a) => a -> a
unreserved forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fixupStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
valid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
capitalize1
where valid :: Char -> Bool
valid Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
unreserved :: a -> a
unreserved a
t
| a
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"Type", a
"Class"] = a
"Col" forall a. Semigroup a => a -> a -> a
<> a
t
| Bool
otherwise = a
t
fixupStart :: Text -> Text
fixupStart Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Text
"Col"
Just (Char
c,Text
_) | Char -> Bool
isAlpha Char
c -> Text
t
| Bool
otherwise -> Text
"Col" forall a. Semigroup a => a -> a -> a
<> Text
t