{-# 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

-- | Capitalize the first letter of a 'T.Text'.
capitalize1 :: T.Text -> T.Text
capitalize1 :: Text -> Text
capitalize1 = (Text -> Text) -> [Text] -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Char) -> Text -> Text
onHead Char -> Char
toUpper) ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum)
  where onHead :: (Char -> Char) -> Text -> Text
onHead Char -> Char
f = Text -> ((Char, Text) -> Text) -> Maybe (Char, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons ((Char, Text) -> Text)
-> ((Char, Text) -> (Char, Text)) -> (Char, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> (Char, Text) -> (Char, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Char -> Char
f) (Maybe (Char, Text) -> Text)
-> (Text -> Maybe (Char, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

-- | Massage a column name from a CSV file into a valid Haskell type
-- identifier.
sanitizeTypeName :: T.Text -> T.Text
sanitizeTypeName :: Text -> Text
sanitizeTypeName = Text -> Text
forall p. (Eq p, IsString p, Semigroup p) => p -> p
unreserved (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fixupStart
                 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
valid) (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
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 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
'_'
        unreserved :: p -> p
unreserved p
t
          | p
t p -> [p] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [p
"Type", p
"Class"] = p
"Col" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
t
          | Bool
otherwise = p
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t