-- | Adapter framework for literal types and terms

module Hydra.LiteralAdapters (
  literalAdapter,
  floatAdapter,
  integerAdapter,
) where

import Hydra.Printing
import Hydra.AdapterUtils
import Hydra.Basics
import Hydra.Coders
import Hydra.Compute
import Hydra.Core
import Hydra.Graph
import Hydra.Lexical
import Hydra.Mantle
import Hydra.Tier1
import Hydra.Tier2

import qualified Data.List as L
import qualified Data.Set as S


literalAdapter :: LiteralType -> Flow (AdapterContext) (SymmetricAdapter s LiteralType Literal)
literalAdapter :: forall s.
LiteralType
-> Flow AdapterContext (SymmetricAdapter s LiteralType Literal)
literalAdapter LiteralType
lt = do
    AdapterContext
cx <- Flow AdapterContext AdapterContext
forall s. Flow s s
getState
    (LiteralType
 -> [Flow AdapterContext (SymmetricAdapter s LiteralType Literal)])
-> (LiteralType -> Bool)
-> (LiteralType -> String)
-> LiteralType
-> Flow AdapterContext (SymmetricAdapter s LiteralType Literal)
forall t so si v.
(Eq t, Ord t, Show t) =>
(t -> [Flow so (SymmetricAdapter si t v)])
-> (t -> Bool)
-> (t -> String)
-> t
-> Flow so (SymmetricAdapter si t v)
chooseAdapter (AdapterContext
-> LiteralType
-> [Flow AdapterContext (SymmetricAdapter s LiteralType Literal)]
forall {f :: * -> *} {s2}.
Applicative f =>
AdapterContext
-> LiteralType
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
alts AdapterContext
cx) (AdapterContext -> LiteralType -> Bool
supported AdapterContext
cx) LiteralType -> String
describeLiteralType LiteralType
lt
  where
    supported :: AdapterContext -> LiteralType -> Bool
supported AdapterContext
cx = LanguageConstraints -> LiteralType -> Bool
literalTypeIsSupported (AdapterContext -> LanguageConstraints
constraints AdapterContext
cx)
    constraints :: AdapterContext -> LanguageConstraints
constraints AdapterContext
cx = Language -> LanguageConstraints
languageConstraints (Language -> LanguageConstraints)
-> Language -> LanguageConstraints
forall a b. (a -> b) -> a -> b
$ AdapterContext -> Language
adapterContextLanguage AdapterContext
cx

    alts :: AdapterContext
-> LiteralType
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
alts AdapterContext
cx LiteralType
t = case LiteralType
t of
        LiteralType
LiteralTypeBinary -> Flow
  AdapterContext
  (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow
   AdapterContext
   (Adapter s2 s2 LiteralType LiteralType Literal Literal)
 -> f (Flow
         AdapterContext
         (Adapter s2 s2 LiteralType LiteralType Literal Literal)))
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a b. (a -> b) -> a -> b
$ LiteralType
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall {s} {s1} {s2}.
LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t
        LiteralType
LiteralTypeBoolean -> Flow
  AdapterContext
  (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow
   AdapterContext
   (Adapter s2 s2 LiteralType LiteralType Literal Literal)
 -> f (Flow
         AdapterContext
         (Adapter s2 s2 LiteralType LiteralType Literal Literal)))
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a b. (a -> b) -> a -> b
$ if Bool
noIntegerVars
            then LiteralType
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall {s} {s1} {s2}.
LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t
            else do
              SymmetricAdapter s2 IntegerType IntegerValue
adapter <- IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s2 IntegerType IntegerValue)
forall s.
IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s IntegerType IntegerValue)
integerAdapter IntegerType
IntegerTypeUint8
              let step' :: Coder s2 s2 IntegerValue IntegerValue
step' = SymmetricAdapter s2 IntegerType IntegerValue
-> Coder s2 s2 IntegerValue IntegerValue
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder SymmetricAdapter s2 IntegerType IntegerValue
adapter
              let step :: Coder s2 s2 Literal Literal
step = (Literal -> Flow s2 Literal)
-> (Literal -> Flow s2 Literal) -> Coder s2 s2 Literal Literal
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Literal -> Flow s2 Literal
encode Literal -> Flow s2 Literal
decode
                    where
                      encode :: Literal -> Flow s2 Literal
encode (LiteralBoolean Bool
bv) = IntegerValue -> Literal
LiteralInteger (IntegerValue -> Literal)
-> Flow s2 IntegerValue -> Flow s2 Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coder s2 s2 IntegerValue IntegerValue
-> IntegerValue -> Flow s2 IntegerValue
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder s2 s2 IntegerValue IntegerValue
step' (Bool -> IntegerValue
toInt Bool
bv)
                        where
                          toInt :: Bool -> IntegerValue
toInt Bool
bv = Int16 -> IntegerValue
IntegerValueUint8 (Int16 -> IntegerValue) -> Int16 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ if Bool
bv then Int16
1 else Int16
0
                      decode :: Literal -> Flow s2 Literal
decode (LiteralInteger IntegerValue
iv) = Bool -> Literal
LiteralBoolean (Bool -> Literal) -> Flow s2 Bool -> Flow s2 Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
                        (IntegerValueUint8 Int16
v) <- Coder s2 s2 IntegerValue IntegerValue
-> IntegerValue -> Flow s2 IntegerValue
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder s2 s2 IntegerValue IntegerValue
step' IntegerValue
iv
                        Bool -> Flow s2 Bool
forall a. a -> Flow s2 a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Flow s2 Bool) -> Bool -> Flow s2 Bool
forall a b. (a -> b) -> a -> b
$ Int16
v Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
1
              Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a. a -> Flow AdapterContext a
forall (m :: * -> *) a. Monad m => a -> m a
return (Adapter s2 s2 LiteralType LiteralType Literal Literal
 -> Flow
      AdapterContext
      (Adapter s2 s2 LiteralType LiteralType Literal Literal))
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a b. (a -> b) -> a -> b
$ Bool
-> LiteralType
-> LiteralType
-> Coder s2 s2 Literal Literal
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
False LiteralType
t (IntegerType -> LiteralType
LiteralTypeInteger (IntegerType -> LiteralType) -> IntegerType -> LiteralType
forall a b. (a -> b) -> a -> b
$ SymmetricAdapter s2 IntegerType IntegerValue -> IntegerType
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget SymmetricAdapter s2 IntegerType IntegerValue
adapter) Coder s2 s2 Literal Literal
step
        LiteralTypeFloat FloatType
ft -> Flow
  AdapterContext
  (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow
   AdapterContext
   (Adapter s2 s2 LiteralType LiteralType Literal Literal)
 -> f (Flow
         AdapterContext
         (Adapter s2 s2 LiteralType LiteralType Literal Literal)))
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a b. (a -> b) -> a -> b
$ if Bool
noFloatVars
          then LiteralType
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall {s} {s1} {s2}.
LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t
          else do
            SymmetricAdapter s2 FloatType FloatValue
adapter <- FloatType
-> Flow AdapterContext (SymmetricAdapter s2 FloatType FloatValue)
forall s.
FloatType
-> Flow AdapterContext (SymmetricAdapter s FloatType FloatValue)
floatAdapter FloatType
ft
            let step :: Coder s2 s2 Literal Literal
step = (CoderDirection -> Literal -> Flow s2 Literal)
-> Coder s2 s2 Literal Literal
forall b s. (CoderDirection -> b -> Flow s b) -> Coder s s b b
bidirectional
                  ((CoderDirection -> Literal -> Flow s2 Literal)
 -> Coder s2 s2 Literal Literal)
-> (CoderDirection -> Literal -> Flow s2 Literal)
-> Coder s2 s2 Literal Literal
forall a b. (a -> b) -> a -> b
$ \CoderDirection
dir Literal
l -> case Literal
l of
                    LiteralFloat FloatValue
fv -> FloatValue -> Literal
LiteralFloat (FloatValue -> Literal) -> Flow s2 FloatValue -> Flow s2 Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoderDirection
-> Coder s2 s2 FloatValue FloatValue
-> FloatValue
-> Flow s2 FloatValue
forall s x. CoderDirection -> Coder s s x x -> x -> Flow s x
encodeDecode CoderDirection
dir (SymmetricAdapter s2 FloatType FloatValue
-> Coder s2 s2 FloatValue FloatValue
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder SymmetricAdapter s2 FloatType FloatValue
adapter) FloatValue
fv
                    Literal
_ -> String -> String -> Flow s2 Literal
forall s x. String -> String -> Flow s x
unexpected String
"floating-point literal" (Literal -> String
forall a. Show a => a -> String
show Literal
l)
            Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a. a -> Flow AdapterContext a
forall (m :: * -> *) a. Monad m => a -> m a
return (Adapter s2 s2 LiteralType LiteralType Literal Literal
 -> Flow
      AdapterContext
      (Adapter s2 s2 LiteralType LiteralType Literal Literal))
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a b. (a -> b) -> a -> b
$ Bool
-> LiteralType
-> LiteralType
-> Coder s2 s2 Literal Literal
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (SymmetricAdapter s2 FloatType FloatValue -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy SymmetricAdapter s2 FloatType FloatValue
adapter) LiteralType
t (FloatType -> LiteralType
LiteralTypeFloat (FloatType -> LiteralType) -> FloatType -> LiteralType
forall a b. (a -> b) -> a -> b
$ SymmetricAdapter s2 FloatType FloatValue -> FloatType
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget SymmetricAdapter s2 FloatType FloatValue
adapter) Coder s2 s2 Literal Literal
step
        LiteralTypeInteger IntegerType
it -> Flow
  AdapterContext
  (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow
   AdapterContext
   (Adapter s2 s2 LiteralType LiteralType Literal Literal)
 -> f (Flow
         AdapterContext
         (Adapter s2 s2 LiteralType LiteralType Literal Literal)))
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a b. (a -> b) -> a -> b
$ if Bool
noIntegerVars
          then LiteralType
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall {s} {s1} {s2}.
LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t
          else do
            SymmetricAdapter s2 IntegerType IntegerValue
adapter <- IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s2 IntegerType IntegerValue)
forall s.
IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s IntegerType IntegerValue)
integerAdapter IntegerType
it
            let step :: Coder s2 s2 Literal Literal
step = (CoderDirection -> Literal -> Flow s2 Literal)
-> Coder s2 s2 Literal Literal
forall b s. (CoderDirection -> b -> Flow s b) -> Coder s s b b
bidirectional
                  ((CoderDirection -> Literal -> Flow s2 Literal)
 -> Coder s2 s2 Literal Literal)
-> (CoderDirection -> Literal -> Flow s2 Literal)
-> Coder s2 s2 Literal Literal
forall a b. (a -> b) -> a -> b
$ \CoderDirection
dir (LiteralInteger IntegerValue
iv) -> IntegerValue -> Literal
LiteralInteger
                    (IntegerValue -> Literal)
-> Flow s2 IntegerValue -> Flow s2 Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoderDirection
-> Coder s2 s2 IntegerValue IntegerValue
-> IntegerValue
-> Flow s2 IntegerValue
forall s x. CoderDirection -> Coder s s x x -> x -> Flow s x
encodeDecode CoderDirection
dir (SymmetricAdapter s2 IntegerType IntegerValue
-> Coder s2 s2 IntegerValue IntegerValue
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder SymmetricAdapter s2 IntegerType IntegerValue
adapter) IntegerValue
iv
            Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a. a -> Flow AdapterContext a
forall (m :: * -> *) a. Monad m => a -> m a
return (Adapter s2 s2 LiteralType LiteralType Literal Literal
 -> Flow
      AdapterContext
      (Adapter s2 s2 LiteralType LiteralType Literal Literal))
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a b. (a -> b) -> a -> b
$ Bool
-> LiteralType
-> LiteralType
-> Coder s2 s2 Literal Literal
-> Adapter s2 s2 LiteralType LiteralType Literal Literal
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (SymmetricAdapter s2 IntegerType IntegerValue -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy SymmetricAdapter s2 IntegerType IntegerValue
adapter) LiteralType
t (IntegerType -> LiteralType
LiteralTypeInteger (IntegerType -> LiteralType) -> IntegerType -> LiteralType
forall a b. (a -> b) -> a -> b
$ SymmetricAdapter s2 IntegerType IntegerValue -> IntegerType
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget SymmetricAdapter s2 IntegerType IntegerValue
adapter) Coder s2 s2 Literal Literal
step
        LiteralType
LiteralTypeString -> Flow
  AdapterContext
  (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow
   AdapterContext
   (Adapter s2 s2 LiteralType LiteralType Literal Literal)
 -> f (Flow
         AdapterContext
         (Adapter s2 s2 LiteralType LiteralType Literal Literal)))
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
-> f (Flow
        AdapterContext
        (Adapter s2 s2 LiteralType LiteralType Literal Literal))
forall a b. (a -> b) -> a -> b
$ String
-> Flow
     AdapterContext
     (Adapter s2 s2 LiteralType LiteralType Literal Literal)
forall a. String -> Flow AdapterContext a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no substitute for the literal string type"
      where
        noFloatVars :: Bool
noFloatVars = Bool -> Bool
not (LiteralVariant -> Set LiteralVariant -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member LiteralVariant
LiteralVariantFloat (Set LiteralVariant -> Bool) -> Set LiteralVariant -> Bool
forall a b. (a -> b) -> a -> b
$ LanguageConstraints -> Set LiteralVariant
languageConstraintsLiteralVariants (LanguageConstraints -> Set LiteralVariant)
-> LanguageConstraints -> Set LiteralVariant
forall a b. (a -> b) -> a -> b
$ AdapterContext -> LanguageConstraints
constraints AdapterContext
cx)
          Bool -> Bool -> Bool
|| Set FloatType -> Bool
forall a. Set a -> Bool
S.null (LanguageConstraints -> Set FloatType
languageConstraintsFloatTypes (LanguageConstraints -> Set FloatType)
-> LanguageConstraints -> Set FloatType
forall a b. (a -> b) -> a -> b
$ AdapterContext -> LanguageConstraints
constraints AdapterContext
cx)
        noIntegerVars :: Bool
noIntegerVars = Bool -> Bool
not (LiteralVariant -> Set LiteralVariant -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member LiteralVariant
LiteralVariantInteger (Set LiteralVariant -> Bool) -> Set LiteralVariant -> Bool
forall a b. (a -> b) -> a -> b
$ LanguageConstraints -> Set LiteralVariant
languageConstraintsLiteralVariants (LanguageConstraints -> Set LiteralVariant)
-> LanguageConstraints -> Set LiteralVariant
forall a b. (a -> b) -> a -> b
$ AdapterContext -> LanguageConstraints
constraints AdapterContext
cx)
          Bool -> Bool -> Bool
|| Set IntegerType -> Bool
forall a. Set a -> Bool
S.null (LanguageConstraints -> Set IntegerType
languageConstraintsIntegerTypes (LanguageConstraints -> Set IntegerType)
-> LanguageConstraints -> Set IntegerType
forall a b. (a -> b) -> a -> b
$ AdapterContext -> LanguageConstraints
constraints AdapterContext
cx)
        noStrings :: Bool
noStrings = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AdapterContext -> LiteralType -> Bool
supported AdapterContext
cx LiteralType
LiteralTypeString

        fallbackAdapter :: LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t = if Bool
noStrings
            then String
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot serialize unsupported type; strings are unsupported"
            else String
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
forall s a. String -> Flow s a -> Flow s a
warn String
msg (Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
 -> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal))
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
forall a b. (a -> b) -> a -> b
$ Adapter s1 s2 LiteralType LiteralType Literal Literal
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Adapter s1 s2 LiteralType LiteralType Literal Literal
 -> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal))
-> Adapter s1 s2 LiteralType LiteralType Literal Literal
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
forall a b. (a -> b) -> a -> b
$ Bool
-> LiteralType
-> LiteralType
-> Coder s1 s2 Literal Literal
-> Adapter s1 s2 LiteralType LiteralType Literal Literal
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
False LiteralType
t LiteralType
LiteralTypeString Coder s1 s2 Literal Literal
forall {s1} {s2}. Coder s1 s2 Literal Literal
step
          where
            msg :: String
msg = Bool -> String -> String -> String
disclaimer Bool
False (LiteralType -> String
describeLiteralType LiteralType
t) (LiteralType -> String
describeLiteralType LiteralType
LiteralTypeString)
            step :: Coder s1 s2 Literal Literal
step = (Literal -> Flow s1 Literal)
-> (Literal -> Flow s2 Literal) -> Coder s1 s2 Literal Literal
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Literal -> Flow s1 Literal
forall {f :: * -> *}. Applicative f => Literal -> f Literal
encode Literal -> Flow s2 Literal
forall {f :: * -> *}. Applicative f => Literal -> f Literal
decode
              where
                -- TODO: this format is tied to Haskell
                encode :: Literal -> f Literal
encode Literal
av = Literal -> f Literal
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> f Literal) -> Literal -> f Literal
forall a b. (a -> b) -> a -> b
$ String -> Literal
LiteralString (String -> Literal) -> String -> Literal
forall a b. (a -> b) -> a -> b
$ case Literal
av of
                  LiteralBinary String
s -> String
s
                  LiteralBoolean Bool
b -> if Bool
b then String
"true" else String
"false"
                  Literal
_ -> Literal -> String
forall a. Show a => a -> String
show Literal
av
                decode :: Literal -> f Literal
decode (LiteralString String
s) = Literal -> f Literal
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> f Literal) -> Literal -> f Literal
forall a b. (a -> b) -> a -> b
$ case LiteralType
t of
                  LiteralType
LiteralTypeBinary -> String -> Literal
LiteralBinary String
s
                  LiteralType
LiteralTypeBoolean -> Bool -> Literal
LiteralBoolean (Bool -> Literal) -> Bool -> Literal
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true"
                  LiteralType
_ -> String -> Literal
forall a. Read a => String -> a
read String
s

comparePrecision :: Precision -> Precision -> Ordering
comparePrecision :: Precision -> Precision -> Ordering
comparePrecision Precision
p1 Precision
p2 = if Precision
p1 Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
== Precision
p2 then Ordering
EQ else case (Precision
p1, Precision
p2) of
  (Precision
PrecisionArbitrary, Precision
_) -> Ordering
GT
  (Precision
_, Precision
PrecisionArbitrary) -> Ordering
LT
  (PrecisionBits Int
b1, PrecisionBits Int
b2) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
b1 Int
b2

disclaimer :: Bool -> String -> String -> String
disclaimer :: Bool -> String -> String -> String
disclaimer Bool
lossy String
source String
target = String
"replace " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
target
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
lossy then String
" (lossy)" else String
""

floatAdapter :: FloatType -> Flow (AdapterContext) (SymmetricAdapter s FloatType FloatValue)
floatAdapter :: forall s.
FloatType
-> Flow AdapterContext (SymmetricAdapter s FloatType FloatValue)
floatAdapter FloatType
ft = do
    AdapterContext
cx <- Flow AdapterContext AdapterContext
forall s. Flow s s
getState
    let supported :: FloatType -> Bool
supported = LanguageConstraints -> FloatType -> Bool
floatTypeIsSupported (LanguageConstraints -> FloatType -> Bool)
-> LanguageConstraints -> FloatType -> Bool
forall a b. (a -> b) -> a -> b
$ Language -> LanguageConstraints
languageConstraints (Language -> LanguageConstraints)
-> Language -> LanguageConstraints
forall a b. (a -> b) -> a -> b
$ AdapterContext -> Language
adapterContextLanguage AdapterContext
cx
    (FloatType
 -> [Flow AdapterContext (SymmetricAdapter s FloatType FloatValue)])
-> (FloatType -> Bool)
-> (FloatType -> String)
-> FloatType
-> Flow AdapterContext (SymmetricAdapter s FloatType FloatValue)
forall t so si v.
(Eq t, Ord t, Show t) =>
(t -> [Flow so (SymmetricAdapter si t v)])
-> (t -> Bool)
-> (t -> String)
-> t
-> Flow so (SymmetricAdapter si t v)
chooseAdapter FloatType
-> [Flow AdapterContext (SymmetricAdapter s FloatType FloatValue)]
forall {s} {s1} {s2}.
FloatType
-> [Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)]
alts FloatType -> Bool
supported FloatType -> String
describeFloatType FloatType
ft
  where
    alts :: FloatType
-> [Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)]
alts FloatType
t = FloatType
-> FloatType
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
forall {s} {s1} {s2}.
FloatType
-> FloatType
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
makeAdapter FloatType
t (FloatType
 -> Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue))
-> [FloatType]
-> [Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case FloatType
t of
        FloatType
FloatTypeBigfloat -> [FloatType
FloatTypeFloat64, FloatType
FloatTypeFloat32]
        FloatType
FloatTypeFloat32 -> [FloatType
FloatTypeFloat64, FloatType
FloatTypeBigfloat]
        FloatType
FloatTypeFloat64 -> [FloatType
FloatTypeBigfloat, FloatType
FloatTypeFloat32]
      where
        makeAdapter :: FloatType
-> FloatType
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
makeAdapter FloatType
source FloatType
target = String
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
forall s a. String -> Flow s a -> Flow s a
warn String
msg (Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
 -> Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue))
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
forall a b. (a -> b) -> a -> b
$ Adapter s1 s2 FloatType FloatType FloatValue FloatValue
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Adapter s1 s2 FloatType FloatType FloatValue FloatValue
 -> Flow
      s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue))
-> Adapter s1 s2 FloatType FloatType FloatValue FloatValue
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
forall a b. (a -> b) -> a -> b
$ Bool
-> FloatType
-> FloatType
-> Coder s1 s2 FloatValue FloatValue
-> Adapter s1 s2 FloatType FloatType FloatValue FloatValue
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
lossy FloatType
source FloatType
target Coder s1 s2 FloatValue FloatValue
forall {s1} {s2}. Coder s1 s2 FloatValue FloatValue
step
          where
            lossy :: Bool
lossy = Precision -> Precision -> Ordering
comparePrecision (FloatType -> Precision
floatTypePrecision FloatType
source) (FloatType -> Precision
floatTypePrecision FloatType
target) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
            step :: Coder s1 s2 FloatValue FloatValue
step = (FloatValue -> Flow s1 FloatValue)
-> (FloatValue -> Flow s2 FloatValue)
-> Coder s1 s2 FloatValue FloatValue
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (FloatValue -> Flow s1 FloatValue
forall a. a -> Flow s1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FloatValue -> Flow s1 FloatValue)
-> (FloatValue -> FloatValue) -> FloatValue -> Flow s1 FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> FloatValue -> FloatValue
convertFloatValue FloatType
target) (FloatValue -> Flow s2 FloatValue
forall a. a -> Flow s2 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FloatValue -> Flow s2 FloatValue)
-> (FloatValue -> FloatValue) -> FloatValue -> Flow s2 FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> FloatValue -> FloatValue
convertFloatValue FloatType
source)
            msg :: String
msg = Bool -> String -> String -> String
disclaimer Bool
lossy (FloatType -> String
describeFloatType FloatType
source) (FloatType -> String
describeFloatType FloatType
target)

integerAdapter :: IntegerType -> Flow (AdapterContext) (SymmetricAdapter s IntegerType IntegerValue)
integerAdapter :: forall s.
IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s IntegerType IntegerValue)
integerAdapter IntegerType
it = do
    AdapterContext
cx <- Flow AdapterContext AdapterContext
forall s. Flow s s
getState
    let supported :: IntegerType -> Bool
supported = LanguageConstraints -> IntegerType -> Bool
integerTypeIsSupported (LanguageConstraints -> IntegerType -> Bool)
-> LanguageConstraints -> IntegerType -> Bool
forall a b. (a -> b) -> a -> b
$ Language -> LanguageConstraints
languageConstraints (Language -> LanguageConstraints)
-> Language -> LanguageConstraints
forall a b. (a -> b) -> a -> b
$ AdapterContext -> Language
adapterContextLanguage AdapterContext
cx
    (IntegerType
 -> [Flow
       AdapterContext (SymmetricAdapter s IntegerType IntegerValue)])
-> (IntegerType -> Bool)
-> (IntegerType -> String)
-> IntegerType
-> Flow
     AdapterContext (SymmetricAdapter s IntegerType IntegerValue)
forall t so si v.
(Eq t, Ord t, Show t) =>
(t -> [Flow so (SymmetricAdapter si t v)])
-> (t -> Bool)
-> (t -> String)
-> t
-> Flow so (SymmetricAdapter si t v)
chooseAdapter IntegerType
-> [Flow
      AdapterContext (SymmetricAdapter s IntegerType IntegerValue)]
forall {s} {s1} {s2}.
IntegerType
-> [Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)]
alts IntegerType -> Bool
supported IntegerType -> String
describeIntegerType IntegerType
it
  where
    alts :: IntegerType
-> [Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)]
alts IntegerType
t = IntegerType
-> IntegerType
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
forall {s} {s1} {s2}.
IntegerType
-> IntegerType
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
makeAdapter IntegerType
t (IntegerType
 -> Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue))
-> [IntegerType]
-> [Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case IntegerType
t of
        IntegerType
IntegerTypeBigint -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a]
L.reverse [IntegerType]
unsignedPref
        IntegerType
IntegerTypeInt8 -> Int -> [IntegerType]
signed Int
1
        IntegerType
IntegerTypeInt16 -> Int -> [IntegerType]
signed Int
2
        IntegerType
IntegerTypeInt32 -> Int -> [IntegerType]
signed Int
3
        IntegerType
IntegerTypeInt64 -> Int -> [IntegerType]
signed Int
4
        IntegerType
IntegerTypeUint8 -> Int -> [IntegerType]
unsigned Int
1
        IntegerType
IntegerTypeUint16 -> Int -> [IntegerType]
unsigned Int
2
        IntegerType
IntegerTypeUint32 -> Int -> [IntegerType]
unsigned Int
3
        IntegerType
IntegerTypeUint64 -> Int -> [IntegerType]
unsigned Int
4
      where
        signed :: Int -> [IntegerType]
signed Int
i = Int -> [IntegerType] -> [IntegerType]
forall a. Int -> [a] -> [a]
L.drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) [IntegerType]
signedPref [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
++ [IntegerType
IntegerTypeBigint] [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
++ Int -> [IntegerType] -> [IntegerType]
forall a. Int -> [a] -> [a]
L.drop (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [IntegerType]
signedNonPref
        unsigned :: Int -> [IntegerType]
unsigned Int
i = Int -> [IntegerType] -> [IntegerType]
forall a. Int -> [a] -> [a]
L.drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) [IntegerType]
unsignedPref [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
++ [IntegerType
IntegerTypeBigint] [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
++ Int -> [IntegerType] -> [IntegerType]
forall a. Int -> [a] -> [a]
L.drop (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
-(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [IntegerType]
unsignedNonPref
        signedPref :: [IntegerType]
signedPref = [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
interleave [IntegerType]
signedOrdered [IntegerType]
unsignedOrdered
        unsignedPref :: [IntegerType]
unsignedPref = [IntegerType] -> [IntegerType] -> [IntegerType]
forall a. [a] -> [a] -> [a]
interleave [IntegerType]
unsignedOrdered [IntegerType]
signedOrdered
        signedNonPref :: [IntegerType]
signedNonPref = [IntegerType] -> [IntegerType]
forall a. [a] -> [a]
L.reverse [IntegerType]
unsignedPref
        unsignedNonPref :: [IntegerType]
unsignedNonPref = [IntegerType] -> [IntegerType]
forall a. [a] -> [a]
L.reverse [IntegerType]
signedPref

        interleave :: [a] -> [a] -> [a]
interleave [a]
xs [a]
ys = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
L.transpose [[a]
xs, [a]
ys])

        signedOrdered :: [IntegerType]
signedOrdered = (IntegerType -> Bool) -> [IntegerType] -> [IntegerType]
forall a. (a -> Bool) -> [a] -> [a]
L.filter
          (\IntegerType
v -> IntegerType -> Bool
integerTypeIsSigned IntegerType
v Bool -> Bool -> Bool
&& IntegerType -> Precision
integerTypePrecision IntegerType
v Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
/= Precision
PrecisionArbitrary) [IntegerType]
integerTypes
        unsignedOrdered :: [IntegerType]
unsignedOrdered = (IntegerType -> Bool) -> [IntegerType] -> [IntegerType]
forall a. (a -> Bool) -> [a] -> [a]
L.filter
          (\IntegerType
v -> Bool -> Bool
not (IntegerType -> Bool
integerTypeIsSigned IntegerType
v) Bool -> Bool -> Bool
&& IntegerType -> Precision
integerTypePrecision IntegerType
v Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
/= Precision
PrecisionArbitrary) [IntegerType]
integerTypes

        makeAdapter :: IntegerType
-> IntegerType
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
makeAdapter IntegerType
source IntegerType
target = String
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
forall s a. String -> Flow s a -> Flow s a
warn String
msg (Flow
   s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
 -> Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue))
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
forall a b. (a -> b) -> a -> b
$ Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue
 -> Flow
      s
      (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue))
-> Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
forall a b. (a -> b) -> a -> b
$ Bool
-> IntegerType
-> IntegerType
-> Coder s1 s2 IntegerValue IntegerValue
-> Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
lossy IntegerType
source IntegerType
target Coder s1 s2 IntegerValue IntegerValue
forall {s1} {s2}. Coder s1 s2 IntegerValue IntegerValue
step
          where
            lossy :: Bool
lossy = Precision -> Precision -> Ordering
comparePrecision (IntegerType -> Precision
integerTypePrecision IntegerType
source) (IntegerType -> Precision
integerTypePrecision IntegerType
target) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
            step :: Coder s1 s2 IntegerValue IntegerValue
step = (IntegerValue -> Flow s1 IntegerValue)
-> (IntegerValue -> Flow s2 IntegerValue)
-> Coder s1 s2 IntegerValue IntegerValue
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (IntegerValue -> Flow s1 IntegerValue
forall a. a -> Flow s1 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntegerValue -> Flow s1 IntegerValue)
-> (IntegerValue -> IntegerValue)
-> IntegerValue
-> Flow s1 IntegerValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue IntegerType
target) (IntegerValue -> Flow s2 IntegerValue
forall a. a -> Flow s2 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntegerValue -> Flow s2 IntegerValue)
-> (IntegerValue -> IntegerValue)
-> IntegerValue
-> Flow s2 IntegerValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue IntegerType
source)
            msg :: String
msg = Bool -> String -> String -> String
disclaimer Bool
lossy (IntegerType -> String
describeIntegerType IntegerType
source) (IntegerType -> String
describeIntegerType IntegerType
target)

convertFloatValue :: FloatType -> FloatValue -> FloatValue
convertFloatValue :: FloatType -> FloatValue -> FloatValue
convertFloatValue FloatType
target = Double -> FloatValue
encoder (Double -> FloatValue)
-> (FloatValue -> Double) -> FloatValue -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Double
decoder
  where
    decoder :: FloatValue -> Double
decoder FloatValue
fv = case FloatValue
fv of
      FloatValueBigfloat Double
d -> Double
d
      FloatValueFloat32 Float
f -> Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f
      FloatValueFloat64 Double
d -> Double
d
    encoder :: Double -> FloatValue
encoder Double
d = case FloatType
target of
      FloatType
FloatTypeBigfloat -> Double -> FloatValue
FloatValueBigfloat Double
d
      FloatType
FloatTypeFloat32 -> Float -> FloatValue
FloatValueFloat32 (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
      FloatType
FloatTypeFloat64 -> Double -> FloatValue
FloatValueFloat64 Double
d

convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue IntegerType
target = Integer -> IntegerValue
encoder (Integer -> IntegerValue)
-> (IntegerValue -> Integer) -> IntegerValue -> IntegerValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerValue -> Integer
decoder
  where
    decoder :: IntegerValue -> Integer
decoder IntegerValue
iv = case IntegerValue
iv of
      IntegerValueBigint Integer
v -> Integer
v
      IntegerValueInt8 Int8
v -> Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v
      IntegerValueInt16 Int16
v -> Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v
      IntegerValueInt32 Int
v -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueInt64 Int64
v -> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
      IntegerValueUint8 Int16
v -> Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v
      IntegerValueUint16 Int
v -> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
      IntegerValueUint32 Int64
v -> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v
      IntegerValueUint64 Integer
v -> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
    encoder :: Integer -> IntegerValue
encoder Integer
d = case IntegerType
target of
      IntegerType
IntegerTypeBigint -> Integer -> IntegerValue
IntegerValueBigint Integer
d
      IntegerType
IntegerTypeInt8 -> Int8 -> IntegerValue
IntegerValueInt8 (Int8 -> IntegerValue) -> Int8 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt16 -> Int16 -> IntegerValue
IntegerValueInt16 (Int16 -> IntegerValue) -> Int16 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt32 -> Int -> IntegerValue
IntegerValueInt32 (Int -> IntegerValue) -> Int -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeInt64 -> Int64 -> IntegerValue
IntegerValueInt64 (Int64 -> IntegerValue) -> Int64 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint8 -> Int16 -> IntegerValue
IntegerValueUint8 (Int16 -> IntegerValue) -> Int16 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint16 -> Int -> IntegerValue
IntegerValueUint16 (Int -> IntegerValue) -> Int -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint32 -> Int64 -> IntegerValue
IntegerValueUint32 (Int64 -> IntegerValue) -> Int64 -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      IntegerType
IntegerTypeUint64 -> Integer -> IntegerValue
IntegerValueUint64 (Integer -> IntegerValue) -> Integer -> IntegerValue
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d