{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Composite.Dhall () where

import Composite.Record
import Composite.TH
import Control.Applicative
import qualified Control.Lens as L
import Data.Functor.Contravariant
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void
import qualified Dhall as D
import Dhall.Core hiding (File, Text, field)
import Dhall.Map
import Dhall.Src
import GHC.TypeLits

unsafeExpectRecordLit ::
  Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)
unsafeExpectRecordLit _ (RecordLit kvs) =
  kvs
unsafeExpectRecordLit name expression =
  Dhall.Core.internalError
    (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression)

unsafeExpectRecord ::
  Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)
unsafeExpectRecord _ (Record kts) =
  kts
unsafeExpectRecord name expression =
  Dhall.Core.internalError
    (name <> ": Unexpected constructor: " <> Dhall.Core.pretty expression)

instance D.ToDhall (Record '[]) where
  injectWith = pure (D.Encoder {..})
    where
      embed _ = RecordLit mempty
      declared = Record mempty

instance (KnownSymbol s, D.ToDhall (Record xs), D.ToDhall x) => D.ToDhall (Record (s :-> x ': xs)) where
  injectWith = do
    let f :: s :-> x
        f = undefined
    let name = valName f
    let D.Encoder embedL declaredL = D.inject
    let D.Encoder embedR declaredR = D.inject
    let embed (s :*: xs) = RecordLit (Dhall.Map.insert name (Dhall.Core.makeRecordField (embedL $ s)) mapR)
          where
            mapR = unsafeExpectRecordLit "Composite Record" $ embedR xs
    let declared = Record (Dhall.Map.insert name (Dhall.Core.makeRecordField (declaredL)) mapR)
          where
            mapR = unsafeExpectRecord "Composite Record" declaredR
    pure $ D.Encoder {..}

instance D.FromDhall (Record '[]) where
  autoWith _ = D.Decoder {..}
    where
      extract _ = pure RNil
      expected = pure $ Record (Dhall.Map.fromList [])

instance (KnownSymbol s, D.FromDhall (Record xs), D.FromDhall x) => D.FromDhall (Record (s :-> x ': xs)) where
  autoWith = do
    let nL :: s :-> x
        nL = undefined

    let nameL = valName nL

    D.Decoder extractL expectedL <- D.autoWith @x

    D.Decoder extractR expectedR <- D.autoWith @(Record xs)

    let ktsR = unsafeExpectRecord "Composite Record" <$> expectedR

    let expected = Record <$> (Dhall.Map.insert nameL . Dhall.Core.makeRecordField <$> expectedL <*> ktsR)
    let extract expression = do
          let die = D.typeError expected expression

          case expression of
            RecordLit kvs ->
              case Dhall.Core.recordFieldValue <$> Dhall.Map.lookup nameL kvs of
                Just expressionL ->
                  liftA2
                    (:*:)
                    (extractL expressionL)
                    (extractR expression)
                _ -> die
            _ -> die
    pure (D.Decoder extract expected)