-- | This module is inspired by @casing@ package. Instead of @String@ this
--  package uses @Data.Text.Text@
--
-- - @PascalCase@ - no spacing between words, first letter in word is
--    uppercase, all others are lowercase.
-- - @camelCase@ - like @PascalCase@, but the very first letter is lowercase.
-- - @snake_Case@ - underscores delimit words, case is unrestricted.
module Data.Text.Casing
  ( -- * Types
    GQLNameIdentifier,
    namePrefix,
    nameSuffixes,
    NameOrigin (..),

    -- * @Data.Text@ converters
    toCamelT,
    toPascalT,
    toSnakeT,

    -- * GQLName generators
    toCamelG,
    toPascalG,
    toSnakeG,

    -- * Shorthand functions for @Data.Text@
    snakeToCamel,
    snakeToPascal,

    -- * Parser for @Data.Text@
    fromSnake,

    -- * Transformers
    transformNameWith,
    transformGQLSuffixWith,
    transformGQLIdentifierWith,

    -- * Helpers
    fromTupleWith,
    fromNameWith,
    fromAutogeneratedName,
    fromCustomName,
    fromAutogeneratedTuple,
    fromCustomTuple,
    fromNonEmptyList,
    identifierToList,
    lowerFirstChar,
    transformPrefixAndSuffixAndConcat,
    upperFirstChar,
  )
where

import Data.List (intersperse)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Hasura.Prelude
import Language.GraphQL.Draft.Syntax qualified as G

type NameWithOrigin = (G.Name, NameOrigin)

type NameSuffixWithOrigin = (G.NameSuffix, NameOrigin)

-- | An opaque type, representing a parsed identifier with prefix and suffixes.
data GQLNameIdentifier = GQLNameIdentifier
  { GQLNameIdentifier -> NameWithOrigin
namePrefix :: NameWithOrigin,
    GQLNameIdentifier -> [NameSuffixWithOrigin]
nameSuffixes :: [NameSuffixWithOrigin]
    -- Using Vectors instead of list may improve memory uses
  }
  deriving (Int -> GQLNameIdentifier -> ShowS
[GQLNameIdentifier] -> ShowS
GQLNameIdentifier -> String
(Int -> GQLNameIdentifier -> ShowS)
-> (GQLNameIdentifier -> String)
-> ([GQLNameIdentifier] -> ShowS)
-> Show GQLNameIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GQLNameIdentifier] -> ShowS
$cshowList :: [GQLNameIdentifier] -> ShowS
show :: GQLNameIdentifier -> String
$cshow :: GQLNameIdentifier -> String
showsPrec :: Int -> GQLNameIdentifier -> ShowS
$cshowsPrec :: Int -> GQLNameIdentifier -> ShowS
Show)

-- | Represents the origin of a name entity.
--
--      * `CustomName` represents a custom user provided name
--      * `AutogeneratedName` represents a name which is generated by Hasura
--
--   For a custom table name @foo@, the select by pk field name elements:
--
--      * @foo@ is a `CustomName`
--      * @by@ is an `AutogeneratedName`
--      * @pk@ is an `AutogeneratedName`
--
--   However, for a table name @foo_bar@, the select by pk field name elements
--   @foo@, @bar@, @by@ and @pk@ are all `AutogeneratedName`
data NameOrigin = CustomName | AutogeneratedName
  deriving (Int -> NameOrigin -> ShowS
[NameOrigin] -> ShowS
NameOrigin -> String
(Int -> NameOrigin -> ShowS)
-> (NameOrigin -> String)
-> ([NameOrigin] -> ShowS)
-> Show NameOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameOrigin] -> ShowS
$cshowList :: [NameOrigin] -> ShowS
show :: NameOrigin -> String
$cshow :: NameOrigin -> String
showsPrec :: Int -> NameOrigin -> ShowS
$cshowsPrec :: Int -> NameOrigin -> ShowS
Show)

instance (Semigroup GQLNameIdentifier) where
  GQLNameIdentifier NameWithOrigin
pref1 [NameSuffixWithOrigin]
suffs1 <> :: GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
<> GQLNameIdentifier NameWithOrigin
pref2 [NameSuffixWithOrigin]
suffs2 = NameWithOrigin -> [NameSuffixWithOrigin] -> GQLNameIdentifier
GQLNameIdentifier NameWithOrigin
pref1 ([NameSuffixWithOrigin]
suffs1 [NameSuffixWithOrigin]
-> [NameSuffixWithOrigin] -> [NameSuffixWithOrigin]
forall a. [a] -> [a] -> [a]
++ (Name -> NameSuffix) -> NameWithOrigin -> NameSuffixWithOrigin
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> NameSuffix
G.convertNameToSuffix NameWithOrigin
pref2 NameSuffixWithOrigin
-> [NameSuffixWithOrigin] -> [NameSuffixWithOrigin]
forall a. a -> [a] -> [a]
: [NameSuffixWithOrigin]
suffs2)

fromTupleWith :: NameOrigin -> (G.Name, [G.NameSuffix]) -> GQLNameIdentifier
fromTupleWith :: NameOrigin -> (Name, [NameSuffix]) -> GQLNameIdentifier
fromTupleWith NameOrigin
o (Name
pref, [NameSuffix]
suffs) = NameWithOrigin -> [NameSuffixWithOrigin] -> GQLNameIdentifier
GQLNameIdentifier (Name
pref, NameOrigin
o) ((NameSuffix -> NameSuffixWithOrigin)
-> [NameSuffix] -> [NameSuffixWithOrigin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,NameOrigin
o) [NameSuffix]
suffs)

fromNameWith :: NameOrigin -> G.Name -> GQLNameIdentifier
fromNameWith :: NameOrigin -> Name -> GQLNameIdentifier
fromNameWith NameOrigin
o Name
n = NameWithOrigin -> [NameSuffixWithOrigin] -> GQLNameIdentifier
GQLNameIdentifier (Name
n, NameOrigin
o) []

fromAutogeneratedName :: G.Name -> GQLNameIdentifier
fromAutogeneratedName :: Name -> GQLNameIdentifier
fromAutogeneratedName = NameOrigin -> Name -> GQLNameIdentifier
fromNameWith NameOrigin
AutogeneratedName

fromCustomName :: G.Name -> GQLNameIdentifier
fromCustomName :: Name -> GQLNameIdentifier
fromCustomName = NameOrigin -> Name -> GQLNameIdentifier
fromNameWith NameOrigin
CustomName

fromAutogeneratedTuple :: (G.Name, [G.NameSuffix]) -> GQLNameIdentifier
fromAutogeneratedTuple :: (Name, [NameSuffix]) -> GQLNameIdentifier
fromAutogeneratedTuple = NameOrigin -> (Name, [NameSuffix]) -> GQLNameIdentifier
fromTupleWith NameOrigin
AutogeneratedName

fromCustomTuple :: (G.Name, [G.NameSuffix]) -> GQLNameIdentifier
fromCustomTuple :: (Name, [NameSuffix]) -> GQLNameIdentifier
fromCustomTuple = NameOrigin -> (Name, [NameSuffix]) -> GQLNameIdentifier
fromTupleWith NameOrigin
CustomName

fromNonEmptyList :: NonEmpty NameWithOrigin -> GQLNameIdentifier
fromNonEmptyList :: NonEmpty NameWithOrigin -> GQLNameIdentifier
fromNonEmptyList NonEmpty NameWithOrigin
neList = NameWithOrigin -> [NameSuffixWithOrigin] -> GQLNameIdentifier
GQLNameIdentifier (NonEmpty NameWithOrigin -> NameWithOrigin
forall a. NonEmpty a -> a
NE.head NonEmpty NameWithOrigin
neList) ((NameWithOrigin -> NameSuffixWithOrigin)
-> [NameWithOrigin] -> [NameSuffixWithOrigin]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> NameSuffix) -> NameWithOrigin -> NameSuffixWithOrigin
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Name -> NameSuffix
G.convertNameToSuffix) (NonEmpty NameWithOrigin -> [NameWithOrigin]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty NameWithOrigin
neList))

-- | transforms a graphql name with a transforming function
--
-- Note: This will return the graphql name without transformation if the
-- transformed name is not a valid GraphQL identifier
transformNameWith :: (Text -> Text) -> G.Name -> G.Name
transformNameWith :: (Text -> Text) -> Name -> Name
transformNameWith Text -> Text
f Name
name = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
name (Text -> Maybe Name
G.mkName (Text -> Text
f (Name -> Text
G.unName Name
name)))

-- | same as `transformNameWith` but will not transform if the name is a custom name
transformNameAndOriginWith :: (Text -> Text) -> NameWithOrigin -> NameWithOrigin
transformNameAndOriginWith :: (Text -> Text) -> NameWithOrigin -> NameWithOrigin
transformNameAndOriginWith Text -> Text
_ n :: NameWithOrigin
n@(Name
_, NameOrigin
CustomName) = NameWithOrigin
n
transformNameAndOriginWith Text -> Text
f (Name
name, NameOrigin
AutogeneratedName) = ((Text -> Text) -> Name -> Name
transformNameWith Text -> Text
f Name
name, NameOrigin
AutogeneratedName)

-- | similar to @transformNameWith@ but transforms @NameSuffix@ instead of
--  @Name@
transformGQLSuffixWith :: (Text -> Text) -> G.NameSuffix -> G.NameSuffix
transformGQLSuffixWith :: (Text -> Text) -> NameSuffix -> NameSuffix
transformGQLSuffixWith Text -> Text
f NameSuffix
suffix = NameSuffix -> Maybe NameSuffix -> NameSuffix
forall a. a -> Maybe a -> a
fromMaybe NameSuffix
suffix (Text -> Maybe NameSuffix
G.mkNameSuffix (Text -> Text
f (NameSuffix -> Text
G.unNameSuffix NameSuffix
suffix)))

-- | This is essentially same as @second transformGQLSuffixWith@
transformGQLSuffixAndOriginWith :: (Text -> Text) -> NameSuffixWithOrigin -> NameSuffixWithOrigin
transformGQLSuffixAndOriginWith :: (Text -> Text) -> NameSuffixWithOrigin -> NameSuffixWithOrigin
transformGQLSuffixAndOriginWith Text -> Text
f (NameSuffix
suffix, NameOrigin
orig) = ((Text -> Text) -> NameSuffix -> NameSuffix
transformGQLSuffixWith Text -> Text
f NameSuffix
suffix, NameOrigin
orig)

-- | transforms a `GQLNameIdentifier`; this will apply the transformations on prefix as well as suffixes
transformGQLIdentifierWith :: (Text -> Text) -> GQLNameIdentifier -> GQLNameIdentifier
transformGQLIdentifierWith :: (Text -> Text) -> GQLNameIdentifier -> GQLNameIdentifier
transformGQLIdentifierWith Text -> Text
f (GQLNameIdentifier NameWithOrigin
pref [NameSuffixWithOrigin]
suffs) = NameWithOrigin -> [NameSuffixWithOrigin] -> GQLNameIdentifier
GQLNameIdentifier ((Text -> Text) -> NameWithOrigin -> NameWithOrigin
transformNameAndOriginWith Text -> Text
f NameWithOrigin
pref) ((NameSuffixWithOrigin -> NameSuffixWithOrigin)
-> [NameSuffixWithOrigin] -> [NameSuffixWithOrigin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> NameSuffixWithOrigin -> NameSuffixWithOrigin
transformGQLSuffixAndOriginWith Text -> Text
f) [NameSuffixWithOrigin]
suffs)

-- | converts identifiers to @Text@ (i.e. @unName@s and @unNameSuffix@s
--  identifiers)
identifierToList :: GQLNameIdentifier -> [Text]
identifierToList :: GQLNameIdentifier -> [Text]
identifierToList (GQLNameIdentifier (Name
pref, NameOrigin
_) ([NameSuffixWithOrigin]
suffs)) = (Name -> Text
G.unName Name
pref) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((NameSuffixWithOrigin -> Text) -> [NameSuffixWithOrigin] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (NameSuffix -> Text
G.unNameSuffix (NameSuffix -> Text)
-> (NameSuffixWithOrigin -> NameSuffix)
-> NameSuffixWithOrigin
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSuffixWithOrigin -> NameSuffix
forall a b. (a, b) -> a
fst) [NameSuffixWithOrigin]
suffs)

-- | To @snake_case@ for @Data.Text@
--
-- >>> toSnakeT ["my","random","text","list"]
-- "my_random_text_list"
toSnakeT :: [Text] -> Text
toSnakeT :: [Text] -> Text
toSnakeT = [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"_"

-- | To @PascalCase@ for @Data.Text@
--
-- >>> toPascalT ["my","random","text","list"]
-- "MyRandomTextList"
toPascalT :: [Text] -> Text
toPascalT :: [Text] -> Text
toPascalT = [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
upperFirstChar

-- | To @camelCase@ for @Data.Text@
--
-- >>> toCamelT ["my","random","text","list"]
-- "myRandomTextList"
toCamelT :: [Text] -> Text
toCamelT :: [Text] -> Text
toCamelT ([]) = Text
""
toCamelT ((Text
x : [Text]
xs)) = (Text -> Text
lowerFirstChar Text
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
upperFirstChar [Text]
xs)

-- | To @snake_case@ for @GQLNameIdentifier@
toSnakeG :: GQLNameIdentifier -> G.Name
toSnakeG :: GQLNameIdentifier -> Name
toSnakeG (GQLNameIdentifier (Name
pref, NameOrigin
_) [NameSuffixWithOrigin]
suff) = Name -> [NameSuffix] -> Name
G.addSuffixes Name
pref ((NameSuffixWithOrigin -> NameSuffix)
-> [NameSuffixWithOrigin] -> [NameSuffix]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> NameSuffix -> NameSuffix
transformGQLSuffixWith (Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (NameSuffix -> NameSuffix)
-> (NameSuffixWithOrigin -> NameSuffix)
-> NameSuffixWithOrigin
-> NameSuffix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSuffixWithOrigin -> NameSuffix
forall a b. (a, b) -> a
fst) [NameSuffixWithOrigin]
suff)

-- | To @PascalCase@ for @GQLNameIdentifier@
toPascalG :: GQLNameIdentifier -> G.Name
toPascalG :: GQLNameIdentifier -> Name
toPascalG GQLNameIdentifier
gqlIdentifier = GQLNameIdentifier -> (Text -> Text) -> (Text -> Text) -> Name
transformPrefixAndSuffixAndConcat GQLNameIdentifier
gqlIdentifier Text -> Text
upperFirstChar Text -> Text
upperFirstChar

-- | To @camelCase@ for @GQLNameIdentifier@
toCamelG :: GQLNameIdentifier -> G.Name
toCamelG :: GQLNameIdentifier -> Name
toCamelG GQLNameIdentifier
gqlIdentifier = GQLNameIdentifier -> (Text -> Text) -> (Text -> Text) -> Name
transformPrefixAndSuffixAndConcat GQLNameIdentifier
gqlIdentifier Text -> Text
lowerFirstChar Text -> Text
upperFirstChar

-- | Transforms @GQLNameIdentifier@ and returns a @G.Name@
transformPrefixAndSuffixAndConcat :: GQLNameIdentifier -> (T.Text -> T.Text) -> (T.Text -> T.Text) -> G.Name
transformPrefixAndSuffixAndConcat :: GQLNameIdentifier -> (Text -> Text) -> (Text -> Text) -> Name
transformPrefixAndSuffixAndConcat (GQLNameIdentifier NameWithOrigin
pref [NameSuffixWithOrigin]
suff) Text -> Text
prefixTransformer Text -> Text
suffixTransformer =
  Name -> [NameSuffix] -> Name
G.addSuffixes (NameWithOrigin -> Name
forall a b. (a, b) -> a
fst ((Text -> Text) -> NameWithOrigin -> NameWithOrigin
transformNameAndOriginWith Text -> Text
prefixTransformer NameWithOrigin
pref)) ((NameSuffixWithOrigin -> NameSuffix)
-> [NameSuffixWithOrigin] -> [NameSuffix]
forall a b. (a -> b) -> [a] -> [b]
map (NameSuffixWithOrigin -> NameSuffix
forall a b. (a, b) -> a
fst (NameSuffixWithOrigin -> NameSuffix)
-> (NameSuffixWithOrigin -> NameSuffixWithOrigin)
-> NameSuffixWithOrigin
-> NameSuffix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> NameSuffixWithOrigin -> NameSuffixWithOrigin
transformGQLSuffixAndOriginWith Text -> Text
suffixTransformer) [NameSuffixWithOrigin]
suff)

-- @fromSnake@ is used in splitting the schema/table names separated by @_@
-- For global naming conventions:
-- We do not want to capture the underscore in the begining as a delimiter
-- and want to store it as it is. A user might have a schema that starts with
-- an underscore (we want to treat it as a part of the schema name rather
-- than a delimiter)
--

-- | Convert from @snake_cased@
--
-- >>> fromSnake "_hello_world_foo"
-- ["_hello","world","foo"]
fromSnake :: Text -> [Text]
fromSnake :: Text -> [Text]
fromSnake Text
t = case Text -> Text -> [Text]
T.splitOn Text
"_" Text
t of
  (Text
"" : Text
x : [Text]
xs) -> (Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs
  [Text]
bs -> [Text]
bs

-- | Directly convert to @PascalCase@ through 'fromSnake'
snakeToPascal :: Text -> Text
snakeToPascal :: Text -> Text
snakeToPascal = [Text] -> Text
toPascalT ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
fromSnake

-- | Directly convert to @camelCase@ through 'fromSnake'
snakeToCamel :: Text -> Text
snakeToCamel :: Text -> Text
snakeToCamel = [Text] -> Text
toCamelT ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
fromSnake

-- Internal helpers

-- | An internal helper function to lowercase the first character
lowerFirstChar :: Text -> Text
lowerFirstChar :: Text -> Text
lowerFirstChar Text
t = Text -> Text
T.toLower (Int -> Text -> Text
T.take Int
1 Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
t

-- | An internal helper function to uppercase the first character
upperFirstChar :: Text -> Text
upperFirstChar :: Text -> Text
upperFirstChar Text
t = Text -> Text
T.toUpper (Int -> Text -> Text
T.take Int
1 Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
t