dhall-haskell/src/Dhall.hs

{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}

{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining
    how to use the language, the compiler, and this library
-}

module Dhall
    (
    -- * Input
      input
    , detailed

    -- * Types
    , Type(..)
    , InputType(..)
    , Interpret(..)
    , InvalidType(..)
    , R2(..)
    , auto
    , InterpretOptions(..)
    , defaultInterpretOptions
    , bool
    , natural
    , integer
    , double
    , lazyText
    , strictText
    , maybe
    , vector
    , GenericInterpret(..)

    , Inject(..)
    , inject

    -- * Miscellaneous
    , rawInput

    -- * Re-exports
    , Natural
    , Text
    , Vector
    , Generic
    ) where

import Control.Applicative (empty, liftA2, (<|>), Alternative)
import Control.Exception (Exception)
import Data.Functor.Contravariant (Contravariant(..))
import Data.Monoid ((<>))
import Data.Text.Buildable (Buildable(..))
import Data.Text.Lazy (Text)
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import Dhall.Core (Expr(..))
import Dhall.Import (Imported(..))
import Dhall.Parser (Src(..))
import Dhall.TypeCheck (DetailedTypeError(..), TypeError, X)
import GHC.Generics
import Numeric.Natural (Natural)
import Prelude hiding (maybe)
import Text.Trifecta.Delta (Delta(..))

import qualified Control.Exception
import qualified Data.ByteString.Lazy
import qualified Data.Map
import qualified Data.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified Data.Text.Lazy.Encoding
import qualified Data.Vector
import qualified Dhall.Core
import qualified Dhall.Import
import qualified Dhall.Parser
import qualified Dhall.TypeCheck

throws :: Exception e => Either e a -> IO a
throws (Left  e) = Control.Exception.throwIO e
throws (Right r) = return r

{-| Every `Type` must obey the contract that if an expression's type matches the
    the `expected` type then the `extract` function must succeed.  If not, then
    this exception is thrown

    This exception indicates that an invalid `Type` was provided to the `input`
    function
-}
data InvalidType = InvalidType deriving (Typeable)

_ERROR :: String
_ERROR = "\ESC[1;31mError\ESC[0m"

instance Show InvalidType where
    show InvalidType =
        _ERROR <> ": Invalid Dhall.Type                                                  \n\
        \                                                                                \n\
        \Every Type must provide an extract function that succeeds if an expression      \n\
        \matches the expected type.  You provided a Type that disobeys this contract     \n"

instance Exception InvalidType

-- | Dhall uses this type to represent (a, b) tuple.
data R2 a b = R2 { _1 :: a, _2 :: b } deriving (Generic, Inject, Interpret, Show)

{-| Type-check and evaluate a Dhall program, decoding the result into Haskell

    The first argument determines the type of value that you decode:

>>> input integer "2"
2
>>> input (vector double) "[1.0, 2.0]"
[1.0,2.0]

    Use `auto` to automatically select which type to decode based on the
    inferred return type:

>>> input auto "True" :: IO Bool
True
-}
input
    :: Type a
    -- ^ The type of value to decode from Dhall to Haskell
    -> Text
    -- ^ The Dhall program
    -> IO a
    -- ^ The decoded value in Haskell
input (Type {..}) txt = do
    let delta = Directed "(input)" 0 0 0 0
    expr  <- throws (Dhall.Parser.exprFromText delta txt)
    expr' <- Dhall.Import.load expr
    let suffix =
            ( Data.ByteString.Lazy.toStrict
            . Data.Text.Lazy.Encoding.encodeUtf8
            . Data.Text.Lazy.Builder.toLazyText
            . build
            ) expected
    let annot = case expr' of
            Note (Src begin end bytes) _ ->
                Note (Src begin end bytes') (Annot expr' expected)
              where
                bytes' = bytes <> " : " <> suffix
            _ ->
                Annot expr' expected
    _ <- throws (Dhall.TypeCheck.typeOf annot)
    case extract (Dhall.Core.normalize expr') of
        Just x  -> return x
        Nothing -> Control.Exception.throwIO InvalidType

-- | Use this function to extract Haskell values directly from Dhall AST.
--   The intended use case is to allow easy extraction of Dhall values for
--   making the function `Dhall.Core.normalizeWith` easier to use.
--
--   For other use cases, use `input` from `Dhall` module. It will give you
--   a much better user experience.
rawInput
    :: Alternative f 
    => Type a
    -- ^ The type of value to decode from Dhall to Haskell
    -> Expr s X
    -- ^ a closed form Dhall program, which evaluates to the expected type
    -> f a
    -- ^ The decoded value in Haskell
rawInput (Type {..}) expr = do
    case extract (Dhall.Core.normalize expr) of
        Just x  -> pure x
        Nothing -> empty



{-| Use this to provide more detailed error messages

>> input auto "True" :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
> 
> True : Integer
> 
> (input):1:1

>> detailed (input auto "True") :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
> 
> Explanation: You can annotate an expression with its type or kind using the
> ❰:❱ symbol, like this:
> 
> 
>     ┌───────┐
>     │ x : t │  ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱
>     └───────┘
> 
> The type checker verifies that the expression's type or kind matches the
> provided annotation
> 
> For example, all of the following are valid annotations that the type checker
> accepts:
> 
> 
>     ┌─────────────┐
>     │ 1 : Integer │  ❰1❱ is an expression that has type ❰Integer❱, so the type
>     └─────────────┘  checker accepts the annotation
> 
> 
>     ┌────────────────────────┐
>     │ Natural/even +2 : Bool │  ❰Natural/even +2❱ has type ❰Bool❱, so the type
>     └────────────────────────┘  checker accepts the annotation
> 
> 
>     ┌────────────────────┐
>     │ List : Type → Type │  ❰List❱ is an expression that has kind ❰Type → Type❱,
>     └────────────────────┘  so the type checker accepts the annotation
> 
> 
>     ┌──────────────────┐
>     │ List Text : Type │  ❰List Text❱ is an expression that has kind ❰Type❱, so
>     └──────────────────┘  the type checker accepts the annotation
> 
> 
> However, the following annotations are not valid and the type checker will
> reject them:
> 
> 
>     ┌──────────┐
>     │ 1 : Text │  The type checker rejects this because ❰1❱ does not have type
>     └──────────┘  ❰Text❱
> 
> 
>     ┌─────────────┐
>     │ List : Type │  ❰List❱ does not have kind ❰Type❱
>     └─────────────┘
> 
> 
> You or the interpreter annotated this expression:
> 
> ↳ True
> 
> ... with this type or kind:
> 
> ↳ Integer
> 
> ... but the inferred type or kind of the expression is actually:
> 
> ↳ Bool
> 
> Some common reasons why you might get this error:
> 
> ● The Haskell Dhall interpreter implicitly inserts a top-level annotation
>   matching the expected type
> 
>   For example, if you run the following Haskell code:
> 
> 
>     ┌───────────────────────────────┐
>     │ >>> input auto "1" :: IO Text │
>     └───────────────────────────────┘
> 
> 
>   ... then the interpreter will actually type check the following annotated
>   expression:
> 
> 
>     ┌──────────┐
>     │ 1 : Text │
>     └──────────┘
> 
> 
>   ... and then type-checking will fail
> 
> ────────────────────────────────────────────────────────────────────────────────
> 
> True : Integer
> 
> (input):1:1

-}
detailed :: IO a -> IO a
detailed =
    Control.Exception.handle handler1 . Control.Exception.handle handler0
  where
    handler0 :: Imported (TypeError Src) -> IO a
    handler0 (Imported ps e) =
        Control.Exception.throwIO (Imported ps (DetailedTypeError e))

    handler1 :: TypeError Src -> IO a
    handler1 e = Control.Exception.throwIO (DetailedTypeError e)

{-| A @(Type a)@ represents a way to marshal a value of type @\'a\'@ from Dhall
    into Haskell

    You can produce `Type`s either explicitly:

> example :: Type (Vector Text)
> example = vector text

    ... or implicitly using `auto`:

> example :: Type (Vector Text)
> example = auto

    You can consume `Type`s using the `input` function:

> input :: Type a -> Text -> IO a
-}
data Type a = Type
    { extract  :: Expr Src X -> Maybe a
    -- ^ Extracts Haskell value from the Dhall expression
    , expected :: Expr Src X
    -- ^ Dhall type of the Haskell value
    }
    deriving (Functor)

{-| Decode a `Bool`

>>> input bool "True"
True
-}
bool :: Type Bool
bool = Type {..}
  where
    extract (BoolLit b) = pure b
    extract  _          = Nothing

    expected = Bool

{-| Decode a `Natural`

>>> input natural "+42"
42
-}
natural :: Type Natural
natural = Type {..}
  where
    extract (NaturalLit n) = pure n
    extract  _             = empty

    expected = Natural

{-| Decode an `Integer`

>>> input integer "42"
42
-}
integer :: Type Integer
integer = Type {..}
  where
    extract (IntegerLit n) = pure n
    extract  _             = empty

    expected = Integer

{-| Decode a `Double`

>>> input double "42.0"
42.0
-}
double :: Type Double
double = Type {..}
  where
    extract (DoubleLit n) = pure n
    extract  _            = empty

    expected = Double

{-| Decode lazy `Text`

>>> input lazyText "\"Test\""
"Test"
-}
lazyText :: Type Text
lazyText = Type {..}
  where
    extract (TextLit t) = pure (Data.Text.Lazy.Builder.toLazyText t)
    extract  _          = empty

    expected = Text

{-| Decode strict `Text`

>>> input strictText "\"Test\""
"Test"
-}
strictText :: Type Data.Text.Text
strictText = fmap Data.Text.Lazy.toStrict lazyText

{-| Decode a `Maybe`

>>> input (maybe integer) "[1] : Optional Integer"
Just 1
-}
maybe :: Type a -> Type (Maybe a)
maybe (Type extractIn expectedIn) = Type extractOut expectedOut
  where
    extractOut (OptionalLit _ es) = traverse extractIn es'
      where
        es' = if Data.Vector.null es then Nothing else Just (Data.Vector.head es)
    extractOut _ = Nothing

    expectedOut = App Optional expectedIn

{-| Decode a `Vector`

>>> input (vector integer) "[1, 2, 3]"
[1,2,3]
-}
vector :: Type a -> Type (Vector a)
vector (Type extractIn expectedIn) = Type extractOut expectedOut
  where
    extractOut (ListLit _ es) = traverse extractIn es
    extractOut  _             = Nothing

    expectedOut = App List expectedIn

{-| Any value that implements `Interpret` can be automatically decoded based on
    the inferred return type of `input`

>>> input auto "[1, 2, 3]" :: IO (Vector Integer)
[1,2,3]

    This class auto-generates a default implementation for records that
    implement `Generic`.  This does not auto-generate an instance for recursive
    types.
-}
class Interpret a where
    autoWith:: InterpretOptions -> Type a
    default autoWith
        :: (Generic a, GenericInterpret (Rep a)) => InterpretOptions -> Type a
    autoWith options = fmap GHC.Generics.to (genericAutoWith options)

instance Interpret Bool where
    autoWith _ = bool

instance Interpret Natural where
    autoWith _ = natural

instance Interpret Integer where
    autoWith _ = integer

instance Interpret Double where
    autoWith _ = double

instance Interpret Text where
    autoWith _ = lazyText

instance Interpret Data.Text.Text where
    autoWith _ = strictText

instance Interpret a => Interpret (Maybe a) where
    autoWith opts = maybe (autoWith opts)

instance Interpret a => Interpret (Vector a) where
    autoWith opts = vector (autoWith opts)

instance (Interpret a, Interpret b) => Interpret (a, b) where
    autoWith = fmap (\R2{..} -> (_1, _2)) . autoWith

instance (Inject a, Interpret b) => Interpret (a -> b) where
    autoWith opts = Type extractOut expectedOut
      where
        extractOut e = Just (\i -> case extractIn (Dhall.Core.normalize (App e (embed i))) of
            Just o  -> o
            Nothing -> error "Interpret: You cannot decode a function if it does not have the correct type" )

        expectedOut = Pi "_" declared expectedIn

        InputType {..} = inject

        Type extractIn expectedIn = autoWith opts

{-| Use the default options for interpreting a configuration file

> auto = autoWith defaultInterpretOptions
-}
auto :: Interpret a => Type a
auto = autoWith defaultInterpretOptions

{-| Use these options to tweak how Dhall derives a generic implementation of
    `Interpret`
-}
data InterpretOptions = InterpretOptions
    { fieldModifier       :: Text -> Text
    -- ^ Function used to transform Haskell field names into their corresponding
    --   Dhall field names
    , constructorModifier :: Text -> Text
    -- ^ Function used to transform Haskell constructor names into their
    --   corresponding Dhall alternative names
    }

{-| Default interpret options, which you can tweak or override, like this:

> autoWith
>     (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') })
-}
defaultInterpretOptions :: InterpretOptions
defaultInterpretOptions = InterpretOptions
    { fieldModifier       = id
    , constructorModifier = id
    }

{-| This is the underlying class that powers the `Interpret` class's support
    for automatically deriving a generic implementation
-}
class GenericInterpret f where
    genericAutoWith :: InterpretOptions -> Type (f a)

instance GenericInterpret f => GenericInterpret (M1 D d f) where
    genericAutoWith = fmap (fmap M1) genericAutoWith

instance GenericInterpret V1 where
    genericAutoWith _ = Type {..}
      where
        extract _ = Nothing

        expected = Union Data.Map.empty

instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where
    genericAutoWith options@(InterpretOptions {..}) = Type {..}
      where
        nL :: M1 i c1 f1 a
        nL = undefined

        nR :: M1 i c2 f2 a
        nR = undefined

        nameL = constructorModifier (Data.Text.Lazy.pack (conName nL))
        nameR = constructorModifier (Data.Text.Lazy.pack (conName nR))

        extract (UnionLit name e _)
            | name == nameL = fmap (L1 . M1) (extractL e)
            | name == nameR = fmap (R1 . M1) (extractR e)
            | otherwise     = Nothing
        extract _ = Nothing

        expected =
            Union (Data.Map.fromList [(nameL, expectedL), (nameR, expectedR)])

        Type extractL expectedL = genericAutoWith options
        Type extractR expectedR = genericAutoWith options

instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => GenericInterpret ((f :+: g) :+: M1 C c h) where
    genericAutoWith options@(InterpretOptions {..}) = Type {..}
      where
        n :: M1 i c h a
        n = undefined

        name = constructorModifier (Data.Text.Lazy.pack (conName n))

        extract u@(UnionLit name' e _)
            | name == name' = fmap (R1 . M1) (extractR e)
            | otherwise     = fmap  L1       (extractL u)
        extract _ = Nothing

        expected = Union (Data.Map.insert name expectedR expectedL)

        Type extractL (Union expectedL) = genericAutoWith options
        Type extractR        expectedR  = genericAutoWith options

instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => GenericInterpret (M1 C c f :+: (g :+: h)) where
    genericAutoWith options@(InterpretOptions {..}) = Type {..}
      where
        n :: M1 i c f a
        n = undefined

        name = constructorModifier (Data.Text.Lazy.pack (conName n))

        extract u@(UnionLit name' e _)
            | name == name' = fmap (L1 . M1) (extractL e)
            | otherwise     = fmap  R1       (extractR u)
        extract _ = Nothing

        expected = Union (Data.Map.insert name expectedL expectedR)

        Type extractL        expectedL  = genericAutoWith options
        Type extractR (Union expectedR) = genericAutoWith options

instance (GenericInterpret (f :+: g), GenericInterpret (h :+: i)) => GenericInterpret ((f :+: g) :+: (h :+: i)) where
    genericAutoWith options = Type {..}
      where
        extract e = fmap L1 (extractL e) <|> fmap R1 (extractR e)

        expected = Union (Data.Map.union expectedL expectedR)

        Type extractL (Union expectedL) = genericAutoWith options
        Type extractR (Union expectedR) = genericAutoWith options

instance GenericInterpret f => GenericInterpret (M1 C c f) where
    genericAutoWith = fmap (fmap M1) genericAutoWith

instance GenericInterpret U1 where
    genericAutoWith _ = Type {..}
      where
        extract _ = Just U1

        expected = Record (Data.Map.fromList [])

instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where
    genericAutoWith options = Type {..}
      where
        extract = liftA2 (liftA2 (:*:)) extractL extractR

        expected = Record (Data.Map.union ktsL ktsR)
          where
            Record ktsL = expectedL
            Record ktsR = expectedR
        Type extractL expectedL = genericAutoWith options
        Type extractR expectedR = genericAutoWith options

instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where
    genericAutoWith opts@(InterpretOptions {..}) = Type {..}
      where
        n :: M1 i s f a
        n = undefined

        extract (RecordLit m) = do
            case selName n of
                ""   -> Nothing
                name -> do
                    let name' = fieldModifier (Data.Text.Lazy.pack name)
                    e <- Data.Map.lookup name' m
                    fmap (M1 . K1) (extract' e)
        extract  _            = Nothing

        expected = Record (Data.Map.fromList [(key, expected')])
          where
            key = fieldModifier (Data.Text.Lazy.pack (selName n))

        Type extract' expected' = autoWith opts

{-| An @(InputType a)@ represents a way to marshal a value of type @\'a\'@ from
    Haskell into Dhall
-}
data InputType a = InputType
    { embed    :: a -> Expr Src X
    -- ^ Embeds a Haskell value as a Dhall expression
    , declared :: Expr Src X
    -- ^ Dhall type of the Haskell value
    }

instance Contravariant InputType where
    contramap f (InputType embed declared) = InputType embed' declared
      where
        embed' x = embed (f x)

{-| This class is used by `Interpret` instance for functions:

> instance (Inject a, Interpret b) => Interpret (a -> b)

    You can convert Dhall functions with "simple" inputs (i.e. instances of this
    class) into Haskell functions.  This works by:

    * Marshaling the input to the Haskell function into a Dhall expression (i.e.
      @x :: Expr Src X@)
    * Applying the Dhall function (i.e. @f :: Expr Src X@) to the Dhall input
      (i.e. @App f x@)
    * Normalizing the syntax tree (i.e. @normalize (App f x)@)
    * Marshaling the resulting Dhall expression back into a Haskell value
-}
class Inject a where
    injectWith :: InterpretOptions -> InputType a
    default injectWith
        :: (Generic a, GenericInject (Rep a)) => InterpretOptions -> InputType a
    injectWith options = contramap GHC.Generics.from (genericInjectWith options)

{-| Use the default options for injecting a value

> inject = inject defaultInterpretOptions
-}
inject :: Inject a => InputType a
inject = injectWith defaultInterpretOptions

instance Inject Bool where
    injectWith _ = InputType {..}
      where
        embed = BoolLit

        declared = Bool

instance Inject Text where
    injectWith _ = InputType {..}
      where
        embed text = TextLit (Data.Text.Lazy.Builder.fromLazyText text)

        declared = Text

instance Inject Data.Text.Text where
    injectWith _ = InputType {..}
      where
        embed text = TextLit (Data.Text.Lazy.Builder.fromText text)

        declared = Text

instance Inject Natural where
    injectWith _ = InputType {..}
      where
        embed = NaturalLit

        declared = Natural

instance Inject Integer where
    injectWith _ = InputType {..}
      where
        embed = IntegerLit

        declared = Integer

instance Inject Int where
    injectWith _ = InputType {..}
      where
        embed = IntegerLit . toInteger

        declared = Integer


instance Inject Double where
    injectWith _ = InputType {..}
      where
        embed = DoubleLit

        declared = Double

instance Inject a => Inject (Maybe a) where
    injectWith options = InputType embedOut declaredOut
      where
        embedOut (Just x) =
            OptionalLit declaredIn (Data.Vector.singleton (embedIn x))
        embedOut Nothing =
            OptionalLit declaredIn  Data.Vector.empty

        InputType embedIn declaredIn = injectWith options

        declaredOut = App Optional declaredIn

instance Inject a => Inject (Vector a) where
    injectWith options = InputType embedOut declaredOut
      where
        embedOut xs = ListLit (Just declaredIn) (fmap embedIn xs)

        declaredOut = App List declaredIn

        InputType embedIn declaredIn = injectWith options

-- | (a, b) is mapped to { _1 = a, _2 = b }
instance (Inject a, Inject b) => Inject (a, b) where
    injectWith = fmap (contramap adapt) injectWith
        where adapt (_1, _2) = R2 {..}

{-| This is the underlying class that powers the `Interpret` class's support
    for automatically deriving a generic implementation
-}
class GenericInject f where
    genericInjectWith :: InterpretOptions -> InputType (f a)

instance GenericInject f => GenericInject (M1 D d f) where
    genericInjectWith = fmap (contramap unM1) genericInjectWith

instance GenericInject f => GenericInject (M1 C c f) where
    genericInjectWith = fmap (contramap unM1) genericInjectWith

instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) => GenericInject (M1 C c1 f1 :+: M1 C c2 f2) where
    genericInjectWith options@(InterpretOptions {..}) = InputType {..}
      where
        embed (L1 (M1 l)) = UnionLit keyL (embedL l) Data.Map.empty
        embed (R1 (M1 r)) = UnionLit keyR (embedR r) Data.Map.empty

        declared =
            Union (Data.Map.fromList [(keyL, declaredL), (keyR, declaredR)])

        nL :: M1 i c1 f1 a
        nL = undefined

        nR :: M1 i c2 f2 a
        nR = undefined

        keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))
        keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))

        InputType embedL declaredL = genericInjectWith options
        InputType embedR declaredR = genericInjectWith options

instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInject ((f :+: g) :+: M1 C c h) where
    genericInjectWith options@(InterpretOptions {..}) = InputType {..}
      where
        embed (L1 l) = UnionLit keyL valL (Data.Map.insert keyR declaredR ktsL')
          where
            UnionLit keyL valL ktsL' = embedL l
        embed (R1 (M1 r)) = UnionLit keyR (embedR r) ktsL

        nR :: M1 i c h a
        nR = undefined

        keyR = constructorModifier (Data.Text.Lazy.pack (conName nR))

        declared = Union (Data.Map.insert keyR declaredR ktsL)

        InputType embedL (Union ktsL) = genericInjectWith options
        InputType embedR  declaredR   = genericInjectWith options

instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInject (M1 C c f :+: (g :+: h)) where
    genericInjectWith options@(InterpretOptions {..}) = InputType {..}
      where
        embed (L1 (M1 l)) = UnionLit keyL (embedL l) ktsR
        embed (R1 r) = UnionLit keyR valR (Data.Map.insert keyL declaredL ktsR')
          where
            UnionLit keyR valR ktsR' = embedR r

        nL :: M1 i c f a
        nL = undefined

        keyL = constructorModifier (Data.Text.Lazy.pack (conName nL))

        declared = Union (Data.Map.insert keyL declaredL ktsR)

        InputType embedL  declaredL   = genericInjectWith options
        InputType embedR (Union ktsR) = genericInjectWith options

instance (GenericInject (f :+: g), GenericInject (h :+: i)) => GenericInject ((f :+: g) :+: (h :+: i)) where
    genericInjectWith options = InputType {..}
      where
        embed (L1 l) = UnionLit keyL valR (Data.Map.union ktsL' ktsR)
          where
            UnionLit keyL valR ktsL' = embedL l
        embed (R1 r) = UnionLit keyR valR (Data.Map.union ktsL ktsR')
          where
            UnionLit keyR valR ktsR' = embedR r

        declared = Union (Data.Map.union ktsL ktsR)

        InputType embedL (Union ktsL) = genericInjectWith options
        InputType embedR (Union ktsR) = genericInjectWith options

instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where
    genericInjectWith options = InputType embedOut declaredOut
      where
        embedOut (l :*: r) = RecordLit (Data.Map.union mapL mapR)
          where
            RecordLit mapL = embedInL l
            RecordLit mapR = embedInR r

        declaredOut = Record (Data.Map.union mapL mapR)
          where
            Record mapL = declaredInL
            Record mapR = declaredInR

        InputType embedInL declaredInL = genericInjectWith options

        InputType embedInR declaredInR = genericInjectWith options

instance GenericInject U1 where
    genericInjectWith _ = InputType {..}
      where
        embed _ = RecordLit Data.Map.empty

        declared = Record Data.Map.empty

instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where
    genericInjectWith opts@(InterpretOptions {..}) =
        InputType embedOut declaredOut
      where
        n :: M1 i s f a
        n = undefined

        name = fieldModifier (Data.Text.Lazy.pack (selName n))

        embedOut (M1 (K1 x)) = RecordLit (Data.Map.singleton name (embedIn x))

        declaredOut = Record (Data.Map.singleton name declaredIn)

        InputType embedIn declaredIn = injectWith opts