content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE FlexibleInstances #-}
  
  #ifdef LARGE_RECORDS
  {-# LANGUAGE ApplicativeDo #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  #endif
  
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  #if !(MIN_VERSION_dhall(1,27,0))
  #define FromDhall Interpret
  #define ToDhall Inject
  #endif
  
  module Proto3.Suite.DhallPB
    ( -- * Modules
      module Dhall
    )
  where
  import           Data.Functor.Contravariant  (contramap)
  import           Data.Int                    (Int32, Int64)
  import           Data.Word                   (Word32, Word64)
  import           Dhall                       (FromDhall (..), ToDhall (..))
  import           GHC.Float                   (double2Float, float2Double)
  import           Proto3.Suite.Types          (Enumerated (..), Fixed (..))
  
  #if !(MIN_VERSION_dhall(1,42,0))
  import qualified Data.ByteString
  import qualified Data.ByteString.Base64
  import qualified Data.ByteString.Base64.Lazy
  import qualified Data.ByteString.Lazy
  import qualified Data.Text.Encoding
  import qualified Data.Text.Lazy.Encoding
  #endif
  import qualified Dhall
  
  #if !(MIN_VERSION_dhall(1,27,0))
  import qualified Data.Map
  #endif
  
  #ifdef LARGE_RECORDS
  import Data.Coerce (coerce)
  import Data.Proxy (Proxy (..))
  import Data.Void (Void)
  import qualified Data.Text as Text
  import qualified Dhall.Core as Dhall
  import qualified Dhall.Map as Dhall
  import qualified Dhall.Parser as Dhall
  import Data.Record.Generic ((:.:)(Comp), I (..), K (..))
  import qualified Data.Record.Generic as LG
  import qualified Data.Record.Generic.GHC as LG
  import qualified Data.Record.Generic.Rep as LG
  #endif
  
  --------------------------------------------------------------------------------
  -- Interpret the special 'Enumerated' type
  
  instance Dhall.FromDhall a => Dhall.FromDhall (Enumerated a)
  
  instance Dhall.FromDhall a => Dhall.FromDhall (Either Int32 a)
  
  #if !(MIN_VERSION_dhall(1,42,0))
  
  --------------------------------------------------------------------------------
  -- Interpret the strict and lazy ByteString types
  --
  -- We must base-64 decode a 'ByteString' after encoding it from a Text
  -- because it may contain invalid UTF-8 data and Dhall does not have a
  -- native type for bytes.
  
  instance Dhall.FromDhall Data.ByteString.Lazy.ByteString where
    autoWith _ = fmap b64Decode Dhall.lazyText
      where
        b64Decode = Data.ByteString.Base64.Lazy.decodeLenient . Data.Text.Lazy.Encoding.encodeUtf8
  
  instance Dhall.FromDhall Data.ByteString.ByteString where
    autoWith _ = fmap b64Decode Dhall.strictText
      where
        b64Decode =  Data.ByteString.Base64.decodeLenient . Data.Text.Encoding.encodeUtf8
  
  #endif
  
  --------------------------------------------------------------------------------
  -- Interpret integer scalar types
  
  -- Lossy interpretation and integer overflow can happen with the
  -- following instances because the 'Dhall.Integer' (Dhall's only
  -- integer type) equals Haskell's Integer type. We don't expect these
  -- instances to introduce integer overflow because they should only
  -- interpret Dhall rendered from protobuf messages created with
  -- generated code.
  --
  -- TODO: we should perform run-time bounds-checking to at least hint
  -- to the user that we interpreted something bad.
  
  #if !MIN_VERSION_dhall(1,35,0)
  instance Dhall.FromDhall Int where
    autoWith _ = fmap fromInteger Dhall.integer
  
  instance Dhall.FromDhall Int32 where
    autoWith _ = fmap fromInteger Dhall.integer
  
  instance Dhall.FromDhall Int64 where
    autoWith _ = fmap fromInteger Dhall.integer
  
  instance Dhall.FromDhall Word32 where
    autoWith _ = fmap fromIntegral Dhall.integer
  
  instance Dhall.FromDhall Word64 where
    autoWith _ = fmap fromIntegral Dhall.integer
  #endif
  
  instance Dhall.FromDhall (Fixed Int32) where
    autoWith = fmap Fixed . Dhall.autoWith
  
  instance Dhall.FromDhall (Fixed Int64) where
    autoWith = fmap Fixed . Dhall.autoWith
  
  instance Dhall.FromDhall (Fixed Word32) where
    autoWith = fmap Fixed . Dhall.autoWith
  
  instance Dhall.FromDhall (Fixed Word64) where
    autoWith = fmap Fixed . Dhall.autoWith
  
  --------------------------------------------------------------------------------
  -- Interpret floating point scalar types
  --
  -- Loss of precision can happen when converting a 'Double' to a
  -- 'Float'. We don't expect this instance to introduce loss of
  -- precision because it should only interpret Dhall rendered from
  -- protobuf messages created with generated code. The Dhall rendering
  -- converts from a 'Float' to the 'Dhall.Double' type.
  
  instance Dhall.FromDhall Float where
    autoWith _ = fmap double2Float Dhall.double
  
  #if !(MIN_VERSION_dhall(1,27,0))
  --------------------------------------------------------------------------------
  -- Interpret maps
  --
  -- Dhall has no map type.  We resort to an association list,
  -- though that is not safe because keys may be repeated.
  
  instance (Dhall.Interpret k, Dhall.Interpret v, Ord k) =>
           Dhall.Interpret (Data.Map.Map k v) where
    autoWith = fmap (fmap Data.Map.fromList) Dhall.autoWith
  #endif
  
  --------------------------------------------------------------------------------
  -- Inject the special 'Enumerated' type
  
  instance Dhall.ToDhall a => Dhall.ToDhall (Enumerated a)
  
  instance Dhall.ToDhall a => Dhall.ToDhall (Either Int32 a)
  
  --------------------------------------------------------------------------------
  -- Inject integer scalar types
  
  #if !(MIN_VERSION_dhall(1,41,0))
  instance Dhall.ToDhall Int32 where
    injectWith = fmap (contramap toInteger) Dhall.injectWith
  
  instance Dhall.ToDhall Int64 where
    injectWith = fmap (contramap toInteger) Dhall.injectWith
  #endif
  
  instance Dhall.ToDhall (Fixed Int32) where
    injectWith = fmap (contramap fixed) Dhall.injectWith
  
  instance Dhall.ToDhall (Fixed Int64) where
    injectWith = fmap (contramap fixed) Dhall.injectWith
  
  instance Dhall.ToDhall (Fixed Word32) where
    injectWith = fmap (contramap fixed) Dhall.injectWith
  
  instance Dhall.ToDhall (Fixed Word64) where
    injectWith = fmap (contramap fixed) Dhall.injectWith
  
  --------------------------------------------------------------------------------
  -- Inject floating point scalar types
  
  instance Dhall.ToDhall Float where
    injectWith = fmap (contramap float2Double) Dhall.injectWith
  
  #if !(MIN_VERSION_dhall(1,42,0))
  
  --------------------------------------------------------------------------------
  -- Inject strict and lazy ByteStrings
  --
  -- We must base-64 encode a 'ByteString' before decoding it to a Text
  -- because it may contain invalid UTF-8 data and Dhall does not have a
  -- native type for bytes.
  
  instance Dhall.ToDhall Data.ByteString.Lazy.ByteString where
    injectWith = fmap (contramap b64Encode) Dhall.injectWith
      where
        -- 'decodeUtf8' will throw an error on any invalid UTF-8 data
        -- but we should never encounter that case with this usage
        -- because we Base64 encode the ByteString first
        b64Encode = Data.Text.Lazy.Encoding.decodeUtf8 . Data.ByteString.Base64.Lazy.encode
  
  instance Dhall.ToDhall Data.ByteString.ByteString where
    injectWith = fmap (contramap b64Encode) Dhall.injectWith
      where
        -- 'decodeUtf8' will throw an error on any invalid UTF-8 data
        -- but we should never encounter that case with this usage
        -- because we Base64 encode the ByteString first
        b64Encode = Data.Text.Encoding.decodeUtf8 . Data.ByteString.Base64.encode
  
  #endif
  
  #if !(MIN_VERSION_dhall(1,27,0))
  --------------------------------------------------------------------------------
  -- Inject maps
  --
  -- Dhall has no map type.  We resort to an association list,
  -- though that is not safe because keys may be repeated.
  
  instance (Dhall.Inject k, Dhall.Inject v) =>
           Dhall.Inject (Data.Map.Map k v) where
    injectWith = fmap (contramap Data.Map.toAscList) Dhall.injectWith
  #endif
  
  #ifdef LARGE_RECORDS
  
  instance (LG.Generic a, LG.Constraints a Dhall.FromDhall) => Dhall.GenericFromDhall a (LG.ThroughLRGenerics a) where
    genericAutoWithNormalizer _ normalizer _ = pure $ coerce $ Dhall.Decoder extract expected
      where
        makeCompRep :: (forall x. Dhall.FromDhall x => K String x -> f (g x)) -> LG.Rep (f :.: g) a
        makeCompRep f = LG.cmap
                          (Proxy @Dhall.FromDhall)
                          (Comp . f)
                          (LG.recordFieldNames $ LG.metadata (Proxy @a))
  
        extract :: Dhall.Expr Dhall.Src Void -> Dhall.Extractor Dhall.Src Void a
        extract expr =
          case expr of
            Dhall.RecordLit flds -> do
              let getField :: forall x. Dhall.FromDhall x => K String x -> Dhall.Extractor Dhall.Src Void x
                  getField (K fld) =
                    let decoder = Dhall.autoWith @x normalizer
                    in maybe
                         (Dhall.typeError expected expr)
                         (Dhall.extract decoder)
                         (Dhall.recordFieldValue <$> Dhall.lookup (Text.pack fld) flds)
              LG.to <$> LG.sequenceA (makeCompRep (fmap I . getField))
            _ -> Dhall.typeError expected expr
  
        expected :: Dhall.Expector (Dhall.Expr Dhall.Src Void)
        expected = do
          let getField :: forall x. Dhall.FromDhall x => K String x -> Dhall.Expector (Dhall.Text, Dhall.RecordField Dhall.Src Void)
              getField (K fld) = do
                let decoder = Dhall.autoWith @x normalizer
                f <- Dhall.makeRecordField <$> Dhall.expected decoder
                pure (Text.pack fld, f)
          Dhall.Record . Dhall.fromList . LG.collapse <$> LG.sequenceA (makeCompRep (fmap K . getField))
  
  instance (LG.Generic a, LG.Constraints a Dhall.ToDhall) => Dhall.GenericToDhall (LG.ThroughLRGenerics a) where
    genericToDhallWithNormalizer normalizer _ = pure $ coerce $ Dhall.Encoder embed declared
      where
        md = LG.metadata (Proxy @a)
        fieldNames = LG.recordFieldNames md
  
        embed :: a -> Dhall.Expr Dhall.Src Void
        embed = Dhall.RecordLit
                . Dhall.fromList
                . LG.collapse
                . LG.zipWith (LG.mapKKK $ \n x -> (Text.pack n, Dhall.makeRecordField x)) fieldNames
                . LG.cmap (Proxy @Dhall.ToDhall) (K . Dhall.embed (injectWith normalizer) . LG.unI)
                . LG.from
  
        declared :: Dhall.Expr Dhall.Src Void
        declared = Dhall.Record
                   $ Dhall.fromList
                   $ LG.collapse
                   $ LG.cmap
                       (Proxy @Dhall.ToDhall)
                       (\(K n :: K String x) ->
                           let typ = Dhall.declared (injectWith @x normalizer)
                           in K (Text.pack n, Dhall.makeRecordField typ))
                       fieldNames
  
  #endif
  