{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Generic conversion of Haskell data types to Elm types.
-}

module Elm.Generic
       ( -- * Main data type for the user
         Elm (..)
       , elmRef

         -- * Smart constructors
       , elmNewtype

         -- * Generic utilities
       , GenericElmDefinition (..)
       , GenericElmConstructors (..)
       , GenericElmFields (..)

       , GenericConstructor (..)
       , toElmConstructor
         -- * Customizing generated elm code and JSON instances
       , CodeGenOptions (..)
       , defaultCodeGenOptions

         -- * Type families for compile-time checks
       , HasNoTypeVars
       , TypeVarsError

       , HasLessThanEightUnnamedFields
       , FieldsError
       , CheckFields
       , Max

       , HasNoNamedSum
       , NamedSumError
       , CheckNamedSum
       , CheckConst
       , ElmStreetGenericConstraints

         -- * Internals
       , stripTypeNamePrefix
       ) where

import Data.Aeson (Value)
import Data.Char (isLower, toLower)
import Data.Int (Int16, Int32, Int8)
import Data.Kind (Constraint, Type)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Type.Reflection (Typeable, typeRep)
import Data.Time.Clock (UTCTime)
import Data.Type.Bool (If, type (||))
import Data.Void (Void)
import Data.Word (Word16, Word32, Word8)
import GHC.Generics (C1, Constructor (..), D1, Datatype (..), Generic (..), M1 (..), Meta (..),
                     Rec0, S1, Selector (..), U1, (:*:), (:+:))
import GHC.TypeLits (ErrorMessage (..), Nat, TypeError)
import GHC.TypeNats (type (+), type (<=?))

import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..),
                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), definitionToRef)

import qualified Data.Text as T
import qualified Data.Text.Lazy as LT (Text)
import qualified GHC.Generics as Generic (from)


{- | Typeclass that describes how Haskell data types are converted to Elm ones.
-}
class Elm a where
    toElmDefinition :: Proxy a -> ElmDefinition

    default toElmDefinition
        :: (ElmStreetGenericConstraints a, Typeable a)
        => Proxy a
        -> ElmDefinition
    toElmDefinition Proxy a
_ = forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
CodeGenOptions -> f a -> ElmDefinition
genericToElmDefinition (forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions @a)
        forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => a -> Rep a x
Generic.from (forall a. HasCallStack => [Char] -> a
error [Char]
"Proxy for generic elm was evaluated" :: a)

{- | Returns 'TypeRef' for the existing type. This function always returns the
name of the type without any type variables added.
-}
elmRef :: forall a . Elm a => TypeRef
elmRef :: forall a. Elm a => TypeRef
elmRef = ElmDefinition -> TypeRef
definitionToRef forall a b. (a -> b) -> a -> b
$ forall a. Elm a => Proxy a -> ElmDefinition
toElmDefinition forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a

----------------------------------------------------------------------------
-- Primitive instances
----------------------------------------------------------------------------

instance Elm ()   where toElmDefinition :: Proxy () -> ElmDefinition
toElmDefinition Proxy ()
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmUnit
instance Elm Void where toElmDefinition :: Proxy Void -> ElmDefinition
toElmDefinition Proxy Void
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmNever
instance Elm Bool where toElmDefinition :: Proxy Bool -> ElmDefinition
toElmDefinition Proxy Bool
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmBool
instance Elm Char where toElmDefinition :: Proxy Char -> ElmDefinition
toElmDefinition Proxy Char
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmChar

instance Elm Int    where toElmDefinition :: Proxy Int -> ElmDefinition
toElmDefinition Proxy Int
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Int8   where toElmDefinition :: Proxy Int8 -> ElmDefinition
toElmDefinition Proxy Int8
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Int16  where toElmDefinition :: Proxy Int16 -> ElmDefinition
toElmDefinition Proxy Int16
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Int32  where toElmDefinition :: Proxy Int32 -> ElmDefinition
toElmDefinition Proxy Int32
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Word   where toElmDefinition :: Proxy Word -> ElmDefinition
toElmDefinition Proxy Word
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Word8  where toElmDefinition :: Proxy Word8 -> ElmDefinition
toElmDefinition Proxy Word8
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Word16 where toElmDefinition :: Proxy Word16 -> ElmDefinition
toElmDefinition Proxy Word16
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt
instance Elm Word32 where toElmDefinition :: Proxy Word32 -> ElmDefinition
toElmDefinition Proxy Word32
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmInt

instance Elm Float  where toElmDefinition :: Proxy Float -> ElmDefinition
toElmDefinition Proxy Float
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmFloat
instance Elm Double where toElmDefinition :: Proxy Double -> ElmDefinition
toElmDefinition Proxy Double
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmFloat

instance Elm Text    where toElmDefinition :: Proxy Text -> ElmDefinition
toElmDefinition Proxy Text
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmString
instance Elm LT.Text where toElmDefinition :: Proxy Text -> ElmDefinition
toElmDefinition Proxy Text
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmString

instance Elm Value where toElmDefinition :: Proxy Value -> ElmDefinition
toElmDefinition Proxy Value
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmValue

-- TODO: should it be 'Bytes' from @bytes@ package?
-- https://package.elm-lang.org/packages/elm/bytes/latest/Bytes
-- instance Elm B.ByteString  where toElmDefinition _ = DefPrim ElmString
-- instance Elm LB.ByteString where toElmDefinition _ = DefPrim ElmString

instance Elm UTCTime where toElmDefinition :: Proxy UTCTime -> ElmDefinition
toElmDefinition Proxy UTCTime
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmTime

instance Elm a => Elm (Maybe a) where
    toElmDefinition :: Proxy (Maybe a) -> ElmDefinition
toElmDefinition Proxy (Maybe a)
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> ElmPrim
ElmMaybe forall a b. (a -> b) -> a -> b
$ forall a. Elm a => TypeRef
elmRef @a

instance (Elm a, Elm b) => Elm (Either a b) where
    toElmDefinition :: Proxy (Either a b) -> ElmDefinition
toElmDefinition Proxy (Either a b)
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeRef -> ElmPrim
ElmResult (forall a. Elm a => TypeRef
elmRef @a) (forall a. Elm a => TypeRef
elmRef @b)

instance (Elm a, Elm b) => Elm (a, b) where
    toElmDefinition :: Proxy (a, b) -> ElmDefinition
toElmDefinition Proxy (a, b)
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeRef -> ElmPrim
ElmPair (forall a. Elm a => TypeRef
elmRef @a) (forall a. Elm a => TypeRef
elmRef @b)

instance (Elm a, Elm b, Elm c) => Elm (a, b, c) where
    toElmDefinition :: Proxy (a, b, c) -> ElmDefinition
toElmDefinition Proxy (a, b, c)
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> TypeRef -> TypeRef -> ElmPrim
ElmTriple (forall a. Elm a => TypeRef
elmRef @a) (forall a. Elm a => TypeRef
elmRef @b) (forall a. Elm a => TypeRef
elmRef @c)

instance Elm a => Elm [a] where
    toElmDefinition :: Proxy [a] -> ElmDefinition
toElmDefinition Proxy [a]
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> ElmPrim
ElmList (forall a. Elm a => TypeRef
elmRef @a)

-- Overlapping instance to ensure that Haskell @String@ is represented as Elm @String@
-- and not as @List Char@ based based on @Elm a => Elm [a]@ instance
instance {-# OVERLAPPING #-} Elm String where
    toElmDefinition :: Proxy [Char] -> ElmDefinition
toElmDefinition Proxy [Char]
_ = ElmPrim -> ElmDefinition
DefPrim ElmPrim
ElmString

instance Elm a => Elm (NonEmpty a) where
    toElmDefinition :: Proxy (NonEmpty a) -> ElmDefinition
toElmDefinition Proxy (NonEmpty a)
_ = ElmPrim -> ElmDefinition
DefPrim forall a b. (a -> b) -> a -> b
$ TypeRef -> ElmPrim
ElmNonEmptyPair (forall a. Elm a => TypeRef
elmRef @a)

----------------------------------------------------------------------------
-- Smart constructors
----------------------------------------------------------------------------

{- | This function can be used to create manual 'Elm' instances easily for
@newtypes@ where 'Generic' deriving doesn't work. This function can be used like
this:

@
__newtype__ Id a = Id { unId :: Text }

__instance__ Elm (Id a) __where__
    toElmDefinition _ = elmNewtype @Text "Id" "unId"
@
-}
elmNewtype :: forall a . Elm a => Text -> Text -> ElmDefinition
elmNewtype :: forall a. Elm a => Text -> Text -> ElmDefinition
elmNewtype Text
typeName Text
fieldName = ElmRecord -> ElmDefinition
DefRecord forall a b. (a -> b) -> a -> b
$ ElmRecord
    { elmRecordName :: Text
elmRecordName      = Text
typeName
    , elmRecordFields :: NonEmpty ElmRecordField
elmRecordFields    = TypeRef -> Text -> ElmRecordField
ElmRecordField (forall a. Elm a => TypeRef
elmRef @a) Text
fieldName forall a. a -> [a] -> NonEmpty a
:| []
    , elmRecordIsNewtype :: Bool
elmRecordIsNewtype = Bool
True
    }

----------------------------------------------------------------------------
-- Generic instances
----------------------------------------------------------------------------

{- | Generic typeclass to generate whole 'ElmDefinition'. It has only one
instance: for the first top-level metadata that contains metainformation about
data type like @data type name@. Then it collects all constructors of the data
type and decides what to generate.
-}
class GenericElmDefinition (f :: k -> Type) where
    genericToElmDefinition :: CodeGenOptions -> f a -> ElmDefinition

instance (Datatype d, GenericElmConstructors f) => GenericElmDefinition (D1 d f) where
    genericToElmDefinition :: forall (a :: k). CodeGenOptions -> D1 d f a -> ElmDefinition
genericToElmDefinition CodeGenOptions
options D1 d f a
datatype = case forall k (f :: k -> *) (a :: k).
GenericElmConstructors f =>
CodeGenOptions -> f a -> NonEmpty GenericConstructor
genericToElmConstructors CodeGenOptions
options (forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 D1 d f a
datatype) of
        GenericConstructor
c :| [] -> case GenericConstructor
-> Either (NonEmpty ElmRecordField) ElmConstructor
toElmConstructor GenericConstructor
c of
            Left NonEmpty ElmRecordField
fields -> ElmRecord -> ElmDefinition
DefRecord forall a b. (a -> b) -> a -> b
$ Text -> NonEmpty ElmRecordField -> Bool -> ElmRecord
ElmRecord Text
typeName NonEmpty ElmRecordField
fields Bool
elmIsNewtype
            Right ElmConstructor
ctor  -> ElmType -> ElmDefinition
DefType forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Bool -> NonEmpty ElmConstructor -> ElmType
ElmType Text
typeName [] Bool
elmIsNewtype (ElmConstructor
ctor forall a. a -> [a] -> NonEmpty a
:| [])
        GenericConstructor
c :| [GenericConstructor]
cs -> case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall l r. Either l r -> Maybe r
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericConstructor
-> Either (NonEmpty ElmRecordField) ElmConstructor
toElmConstructor) (GenericConstructor
c forall a. a -> [a] -> NonEmpty a
:| [GenericConstructor]
cs) of
            -- TODO: this should be error but dunno what to do here
            Maybe (NonEmpty ElmConstructor)
Nothing    -> ElmType -> ElmDefinition
DefType forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Bool -> NonEmpty ElmConstructor -> ElmType
ElmType (Text
"ERROR_" forall a. Semigroup a => a -> a -> a
<> Text
typeName) [] Bool
False (Text -> [TypeRef] -> ElmConstructor
ElmConstructor Text
"ERROR" [] forall a. a -> [a] -> NonEmpty a
:| [])
            Just NonEmpty ElmConstructor
ctors -> ElmType -> ElmDefinition
DefType forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Bool -> NonEmpty ElmConstructor -> ElmType
ElmType Text
typeName [] Bool
elmIsNewtype NonEmpty ElmConstructor
ctors
      where
        typeName :: Text
        typeName :: Text
typeName = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
datatypeName D1 d f a
datatype

        elmIsNewtype :: Bool
        elmIsNewtype :: Bool
elmIsNewtype = forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> Bool
isNewtype D1 d f a
datatype

rightToMaybe :: Either l r -> Maybe r
rightToMaybe :: forall l r. Either l r -> Maybe r
rightToMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

{- | Intermediate data type to help with the conversion from Haskell
constructors to Elm AST. In Haskell constructor fields may have names but may
not have.
-}
data GenericConstructor = GenericConstructor
    { GenericConstructor -> Text
genericConstructorName   :: !Text
    , GenericConstructor -> [(TypeRef, Maybe Text)]
genericConstructorFields :: ![(TypeRef, Maybe Text)]
    }

{- | Generic constructor can be in one of the three states:

1. No fields: enum constructor.
2. All fields have names: record constructor.
3. Not all fields have names: plain constructor.
-}
toElmConstructor :: GenericConstructor -> Either (NonEmpty ElmRecordField) ElmConstructor
toElmConstructor :: GenericConstructor
-> Either (NonEmpty ElmRecordField) ElmConstructor
toElmConstructor GenericConstructor{[(TypeRef, Maybe Text)]
Text
genericConstructorFields :: [(TypeRef, Maybe Text)]
genericConstructorName :: Text
genericConstructorFields :: GenericConstructor -> [(TypeRef, Maybe Text)]
genericConstructorName :: GenericConstructor -> Text
..} = case [(TypeRef, Maybe Text)]
genericConstructorFields of
    []   -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> [TypeRef] -> ElmConstructor
ElmConstructor Text
genericConstructorName []
    (TypeRef, Maybe Text)
f:[(TypeRef, Maybe Text)]
fs -> case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TypeRef, Maybe Text) -> Maybe ElmRecordField
toRecordField ((TypeRef, Maybe Text)
f forall a. a -> [a] -> NonEmpty a
:| [(TypeRef, Maybe Text)]
fs) of
        Maybe (NonEmpty ElmRecordField)
Nothing     -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> [TypeRef] -> ElmConstructor
ElmConstructor Text
genericConstructorName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TypeRef, Maybe Text)]
genericConstructorFields
        Just NonEmpty ElmRecordField
fields -> forall a b. a -> Either a b
Left NonEmpty ElmRecordField
fields
  where
    toRecordField :: (TypeRef, Maybe Text) -> Maybe ElmRecordField
    toRecordField :: (TypeRef, Maybe Text) -> Maybe ElmRecordField
toRecordField (TypeRef
typeRef, Maybe Text
maybeFieldName) = TypeRef -> Text -> ElmRecordField
ElmRecordField TypeRef
typeRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
maybeFieldName


{- | Typeclass to collect all constructors of the Haskell data type generically. -}
class GenericElmConstructors (f :: k -> Type) where
    genericToElmConstructors
        :: CodeGenOptions 
        -> f a  -- ^ Generic value
        -> NonEmpty GenericConstructor  -- ^ List of the data type constructors

-- | If it's a sum type then just combine constructors
instance (GenericElmConstructors f, GenericElmConstructors g) => GenericElmConstructors (f :+: g) where
    genericToElmConstructors :: forall (a :: k).
CodeGenOptions -> (:+:) f g a -> NonEmpty GenericConstructor
genericToElmConstructors CodeGenOptions
options (:+:) f g a
_ =
        forall k (f :: k -> *) (a :: k).
GenericElmConstructors f =>
CodeGenOptions -> f a -> NonEmpty GenericConstructor
genericToElmConstructors CodeGenOptions
options (forall a. HasCallStack => [Char] -> a
error [Char]
"'f :+:' is evaluated" :: f p)
     forall a. Semigroup a => a -> a -> a
<> forall k (f :: k -> *) (a :: k).
GenericElmConstructors f =>
CodeGenOptions -> f a -> NonEmpty GenericConstructor
genericToElmConstructors CodeGenOptions
options (forall a. HasCallStack => [Char] -> a
error [Char]
"':+: g' is evaluated" :: g p)

-- | Create singleton list for case of a one constructor.
instance (Constructor c, GenericElmFields f) => GenericElmConstructors (C1 c f) where
    genericToElmConstructors :: forall (a :: k).
CodeGenOptions -> C1 c f a -> NonEmpty GenericConstructor
genericToElmConstructors CodeGenOptions
options C1 c f a
constructor = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [(TypeRef, Maybe Text)] -> GenericConstructor
GenericConstructor
        ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName C1 c f a
constructor)
        (forall k (f :: k -> *) (a :: k).
GenericElmFields f =>
CodeGenOptions -> f a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
options forall a b. (a -> b) -> a -> b
$ forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 C1 c f a
constructor)

-- | Collect all fields when inside constructor.
class GenericElmFields (f :: k -> Type) where
    genericToElmFields
        :: CodeGenOptions
        -> f a  -- ^ Generic value
        -> [(TypeRef, Maybe Text)]

-- | If multiple fields then just combine all results.
instance (GenericElmFields f, GenericElmFields g) => GenericElmFields (f :*: g) where
    genericToElmFields :: forall (a :: k).
CodeGenOptions -> (:*:) f g a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
options (:*:) f g a
_ =
        forall k (f :: k -> *) (a :: k).
GenericElmFields f =>
CodeGenOptions -> f a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
options (forall a. HasCallStack => [Char] -> a
error [Char]
"'f :*:' is evaluated" :: f p)
     forall a. Semigroup a => a -> a -> a
<> forall k (f :: k -> *) (a :: k).
GenericElmFields f =>
CodeGenOptions -> f a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
options (forall a. HasCallStack => [Char] -> a
error [Char]
"':*: g' is evaluated" :: g p)

-- | Constructor without fields.
instance GenericElmFields U1 where
    genericToElmFields :: forall (a :: k). CodeGenOptions -> U1 a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
_ U1 a
_ = []

-- | Single constructor field.
instance (Selector s, Elm a) => GenericElmFields (S1 s (Rec0 a)) where
    genericToElmFields :: forall (a :: k).
CodeGenOptions -> S1 s (Rec0 a) a -> [(TypeRef, Maybe Text)]
genericToElmFields CodeGenOptions
options S1 s (Rec0 a) a
selector = case forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName S1 s (Rec0 a) a
selector of
        [Char]
""   -> [(forall a. Elm a => TypeRef
elmRef @a, forall a. Maybe a
Nothing)]
        [Char]
name -> [(forall a. Elm a => TypeRef
elmRef @a, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CodeGenOptions -> Text -> Text
cgoFieldLabelModifier CodeGenOptions
options forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
name)]

{- | Strips name of the type name from field name prefix.

>>> stripTypeNamePrefix (TypeName "User") "userName"
"name"

>>> stripTypeNamePrefix (TypeName "HealthReading") "healthReadingId"
"id"

>>> stripTypeNamePrefix (TypeName "RecordUpdate") "ruRows"
"rows"

>>> stripTypeNamePrefix (TypeName "Foo") "foo"
"foo"

>>> stripTypeNamePrefix (TypeName "Foo") "abc"
"abc"
-}
stripTypeNamePrefix :: TypeName -> Text -> Text
stripTypeNamePrefix :: TypeName -> Text -> Text
stripTypeNamePrefix (TypeName Text
typeName) Text
fieldName =
    case Text -> Text -> Maybe Text
T.stripPrefix (Text -> Text
headToLower Text
typeName) Text
fieldName of
        Just Text
rest -> Text -> Text
leaveIfEmpty Text
rest
        Maybe Text
Nothing   -> Text -> Text
leaveIfEmpty ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isLower Text
fieldName)
  where
    headToLower :: Text -> Text
    headToLower :: Text -> Text
headToLower Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
        Maybe (Char, Text)
Nothing      -> forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot use 'headToLower' on empty Text"
        Just (Char
x, Text
xs) -> Char -> Text -> Text
T.cons (Char -> Char
toLower Char
x) Text
xs

    -- if all lower case then leave field as it is
    leaveIfEmpty :: Text -> Text
    leaveIfEmpty :: Text -> Text
leaveIfEmpty Text
rest = if Text -> Bool
T.null Text
rest then Text
fieldName else Text -> Text
headToLower Text
rest

{- | CodeGenOptions allow for customizing some aspects of generated Elm code as well as
 ToJSON and FromJSON instances derived generically.

They can be passed to 'elmStreetParseJsonWith', 'elmStreetToJsonWith' and 'genericToElmDefinition'
to influence the behavior of FromJSON \/ ToJSON and Elm instances respectively.

Note that for Generated Elm encoders \/ decoders to be compatible
with ToJSON \/ FromJSON instances for given type,
__the same CodeGenOptions must be used in Elm \/ ToJSON \/ FromJSON instance declarations__.

Example: Say you don't like the default behavior (stripping type name prefix from all record fields)
and you would like to keep all record field names unmodified instead.
You can achieve that by declaring custom options:

@
myCodeGenOptions :: CodeGenOptions
myCodeGenOptions = CodeGenOptions { cgoFieldLabelModifier = id }
@

And then pass these options when defining Elm \/ ToJSON \/ FromJSON instances.
It is recommended to use DerivingVia to reduce the amount of boilerplate needed.
First declare a newtype whose Elm \/ ToJSON \/ FromJSON instances use your custom CodeGenOptions:

@
newtype CustomElm a = CustomElm {unCustomElm :: a}

instance ElmStreetGenericConstraints a => Elm (CustomElm a) where
    toElmDefinition _ = genericToElmDefinition myCodeGenOptions $
        GHC.Generics.from (error "Proxy for generic elm was evaluated" :: a)

instance (Generic a, GToJSON Zero (Rep a)) => ToJSON (CustomElm a) where
    toJSON = elmStreetToJsonWith myCodeGenOptions . unCustomElm

instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomElm a) where
    parseJSON = fmap CustomElm . elmStreetParseJsonWith myCodeGenOptions
@

Then derive Elm \/ ToJSON \/ FromJSON instance via that newtype:

@
data MyType = MyType
    { myTypeFieldOne :: String
    , myTypeFieldTwo :: Int
    } deriving stock (Show, Generic)
      deriving (Elm, ToJSON, FromJSON) via CustomElm MyType
@

We can check that type name prefix is no longer stripped from record field names:

>>> encode (MyType "Hello" 10)
"{\"myTypeFieldOne\":\"Hello\",\"myTypeFieldTwo\":10,\"tag\":\"MyType\"}"
-}
newtype CodeGenOptions = CodeGenOptions
    { CodeGenOptions -> Text -> Text
cgoFieldLabelModifier :: Text -> Text -- ^ Function that modifies record field names (e.g. by dropping type name prefix)
    }

{- | Options to strip type name from the field names.

+----------------+----------------+---------------------+
| Data type name | Field name     | Stripped field name |
+================+================+=====================+
| @User@         | @userName@     | @name@              |
+----------------+----------------+---------------------+
| @AaaBbbCcc@    | @abcFieldName@ | @fieldName@         |
+----------------+----------------+---------------------+
| @Foo@          | @field@        | @field@             |
+----------------+----------------+---------------------+
| @Field@        | @field@        | @field@             |
+----------------+----------------+---------------------+

-}
defaultCodeGenOptions :: forall a. Typeable a => CodeGenOptions
defaultCodeGenOptions :: forall {k} (a :: k). Typeable a => CodeGenOptions
defaultCodeGenOptions = (Text -> Text) -> CodeGenOptions
CodeGenOptions (TypeName -> Text -> Text
stripTypeNamePrefix TypeName
typeName)
  where
    typeName :: TypeName
    typeName :: TypeName
typeName = Text -> TypeName
TypeName forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a

----------------------------------------------------------------------------
-- ~Magic~
----------------------------------------------------------------------------

{- | This type family checks whether data type has type variables and throws
custom compiler error if it has. Since there's no generic way to get all type
variables, current implementation is limited only to 6 variables. This looks
like a reasonable number.
-}
type family HasNoTypeVars (f :: k) :: Constraint where
    HasNoTypeVars (t a b c d e f) = TypeError (TypeVarsError t 6)
    HasNoTypeVars (t a b c d e)   = TypeError (TypeVarsError t 5)
    HasNoTypeVars (t a b c d)     = TypeError (TypeVarsError t 4)
    HasNoTypeVars (t a b c)       = TypeError (TypeVarsError t 3)
    HasNoTypeVars (t a b)         = TypeError (TypeVarsError t 2)
    HasNoTypeVars (t a)           = TypeError (TypeVarsError t 1)
    HasNoTypeVars t               = ()

type family TypeVarsError (t :: k) (n :: Nat) :: ErrorMessage where
    TypeVarsError t n =
             'Text "'elm-street' currently doesn't support Generic deriving of the 'Elm' typeclass"
        ':$$: 'Text "for data types with type variables. But '"
              ':<>: 'ShowType t ':<>: 'Text "' has " ':<>: 'ShowType n ':<>: 'Text " variables."
        ':$$: 'Text ""
        ':$$: 'Text "See the following issue for more details:"
        ':$$: 'Text "    * https://github.com/Holmusk/elm-street/issues/45"
        ':$$: 'Text ""

{- | This type family checks whether each constructor of the sum data type has
less than eight unnamed fields and throws custom compiler error if it has.
-}
type family HasLessThanEightUnnamedFields (f :: k) :: Constraint where
    HasLessThanEightUnnamedFields t =
        If (CheckFields (Rep t) <=? 8)
            (() :: Constraint)
            (TypeError (FieldsError t))

type family CheckFields (f :: k -> Type) :: Nat where
    CheckFields (D1 _ f) = CheckFields f
    CheckFields (f :+: g) = Max (CheckFields f) (CheckFields g)
    CheckFields (C1 _ f) = CheckFields f
    CheckFields (f :*: g) = CheckFields f + CheckFields g
    CheckFields (S1 ('MetaSel ('Just _ ) _ _ _) _) = 0
    CheckFields (S1 _ _) = 1
    CheckFields _ = 0

type family Max (x :: Nat) (y :: Nat) :: Nat where
    Max x y = If (x <=? y) y x

type family FieldsError (t :: k) :: ErrorMessage where
    FieldsError t =
             'Text "'elm-street' doesn't support Constructors with more than 8 unnamed fields."
        ':$$: 'Text "But '" ':<>: 'ShowType t ':<>: 'Text "' has more."

{- | This type family checks whether each constructor of the sum data type has
less than eight unnamed fields and throws custom compiler error if it has.
-}
type family HasNoNamedSum (f :: k) :: Constraint where
    HasNoNamedSum t =
        If (CheckNamedSum (Rep t))
            (TypeError (NamedSumError t))
            (() :: Constraint)

-- | Is the data type id Sum type with named fields?
type family CheckNamedSum (f :: k -> Type) :: Bool where
    CheckNamedSum (D1 _ f) = CheckNamedSum f
    CheckNamedSum (f :+: g) = CheckConst f || CheckConst g
    CheckNamedSum _ = 'False

-- | Check if Sum type has named fields at least for one of the Constructors.
type family CheckConst (f :: k -> Type) :: Bool where
    CheckConst (f :+: g) = CheckConst f || CheckConst g
    CheckConst (C1 _ f) = CheckConst f
    CheckConst (S1 ('MetaSel ('Just _ ) _ _ _) _) = 'True
    CheckConst (f :*: g) = CheckConst f || CheckConst g
    CheckConst _ = 'False

type family NamedSumError (t :: k) :: ErrorMessage where
    NamedSumError t =
             'Text "'elm-street' doesn't support Sum types with records."
        ':$$: 'Text "But '" ':<>: 'ShowType t ':<>: 'Text "' has records."

-- | Convenience grouping of constraints that type has to satisfy
-- in order to be eligible for automatic derivation of Elm instance via generics
type ElmStreetGenericConstraints a =
    ( HasNoTypeVars a
    , HasLessThanEightUnnamedFields a
    , HasNoNamedSum a
    , Generic a
    , GenericElmDefinition (Rep a)
    )