module Hydra.Adapters.Literal (
  literalAdapter,
  floatAdapter,
  integerAdapter,
) where

import Hydra.All
import Hydra.Adapters.UtilsEtc

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


literalAdapter :: LiteralType -> Flow (AdapterContext m) (SymmetricAdapter (Context m) LiteralType Literal)
literalAdapter :: forall m.
LiteralType
-> Flow
     (AdapterContext m)
     (SymmetricAdapter (Context m) LiteralType Literal)
literalAdapter LiteralType
lt = do
    AdapterContext m
acx <- forall s. Flow s s
getState
    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 (forall {f :: * -> *} {m} {m}.
Applicative f =>
AdapterContext m
-> LiteralType
-> f (Flow
        (AdapterContext m)
        (Adapter
           (Context m) (Context m) LiteralType LiteralType Literal Literal))
alts AdapterContext m
acx) (forall {m}. AdapterContext m -> LiteralType -> Bool
supported AdapterContext m
acx) LiteralType -> String
describeLiteralType LiteralType
lt
  where
    supported :: AdapterContext m -> LiteralType -> Bool
supported AdapterContext m
acx = forall m. LanguageConstraints m -> LiteralType -> Bool
literalTypeIsSupported (forall {m}. AdapterContext m -> LanguageConstraints m
constraints AdapterContext m
acx)
    constraints :: AdapterContext m -> LanguageConstraints m
constraints AdapterContext m
acx = forall m. Language m -> LanguageConstraints m
languageConstraints forall a b. (a -> b) -> a -> b
$ forall m. AdapterContext m -> Language m
adapterContextTarget AdapterContext m
acx

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

        fallbackAdapter :: LiteralType
-> Flow s (Adapter s1 s2 LiteralType LiteralType Literal Literal)
fallbackAdapter LiteralType
t = if Bool
noStrings
            then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot serialize unsupported type; strings are unsupported"
            else forall a s. String -> a -> Flow s a
withWarning String
msg forall a b. (a -> b) -> a -> b
$ 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 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 = forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {f :: * -> *}. Applicative f => Literal -> f Literal
encode forall {f :: * -> *}. Applicative f => Literal -> f Literal
decode
              where
                -- TODO: this format is tied to Haskell
                encode :: Literal -> f Literal
encode Literal
av = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Literal
LiteralString 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
_ -> forall a. Show a => a -> String
show Literal
av
                decode :: Literal -> f Literal
decode (LiteralString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case LiteralType
t of
                  LiteralType
LiteralTypeBinary -> String -> Literal
LiteralBinary String
s
                  LiteralType
LiteralTypeBoolean -> Bool -> Literal
LiteralBoolean forall a b. (a -> b) -> a -> b
$ String
s forall a. Eq a => a -> a -> Bool
== String
"true"
                  LiteralType
_ -> 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 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) -> 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 " forall a. [a] -> [a] -> [a]
++ String
source forall a. [a] -> [a] -> [a]
++ String
" with " forall a. [a] -> [a] -> [a]
++ String
target
  forall a. [a] -> [a] -> [a]
++ if Bool
lossy then String
" (lossy)" else String
""

floatAdapter :: FloatType -> Flow (AdapterContext m) (SymmetricAdapter (Context m) FloatType FloatValue)
floatAdapter :: forall m.
FloatType
-> Flow
     (AdapterContext m)
     (SymmetricAdapter (Context m) FloatType FloatValue)
floatAdapter FloatType
ft = do
    AdapterContext m
acx <- forall s. Flow s s
getState
    let supported :: FloatType -> Bool
supported = forall m. LanguageConstraints m -> FloatType -> Bool
floatTypeIsSupported forall a b. (a -> b) -> a -> b
$ forall m. Language m -> LanguageConstraints m
languageConstraints forall a b. (a -> b) -> a -> b
$ forall m. AdapterContext m -> Language m
adapterContextTarget AdapterContext m
acx
    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 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 = forall {s} {s1} {s2}.
FloatType
-> FloatType
-> Flow s (Adapter s1 s2 FloatType FloatType FloatValue FloatValue)
makeAdapter FloatType
t 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 = forall a s. String -> a -> Flow s a
withWarning String
msg forall a b. (a -> b) -> a -> b
$ 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 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) forall a. Eq a => a -> a -> Bool
== Ordering
GT
            step :: Coder s1 s2 FloatValue FloatValue
step = forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> FloatValue -> FloatValue
convertFloatValue FloatType
target) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 m) (SymmetricAdapter (Context m) IntegerType IntegerValue)
integerAdapter :: forall m.
IntegerType
-> Flow
     (AdapterContext m)
     (SymmetricAdapter (Context m) IntegerType IntegerValue)
integerAdapter IntegerType
it = do
    AdapterContext m
acx <- forall s. Flow s s
getState
    let supported :: IntegerType -> Bool
supported = forall m. LanguageConstraints m -> IntegerType -> Bool
integerTypeIsSupported forall a b. (a -> b) -> a -> b
$ forall m. Language m -> LanguageConstraints m
languageConstraints forall a b. (a -> b) -> a -> b
$ forall m. AdapterContext m -> Language m
adapterContextTarget AdapterContext m
acx
    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 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 = forall {s} {s1} {s2}.
IntegerType
-> IntegerType
-> Flow
     s (Adapter s1 s2 IntegerType IntegerType IntegerValue IntegerValue)
makeAdapter IntegerType
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case IntegerType
t of
        IntegerType
IntegerTypeBigint -> 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 = forall a. Int -> [a] -> [a]
L.drop (Int
iforall a. Num a => a -> a -> a
*Int
2) [IntegerType]
signedPref forall a. [a] -> [a] -> [a]
++ [IntegerType
IntegerTypeBigint] forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
L.drop (Int
8forall a. Num a => a -> a -> a
-(Int
iforall a. Num a => a -> a -> a
*Int
2)forall a. Num a => a -> a -> a
+Int
1) [IntegerType]
signedNonPref
        unsigned :: Int -> [IntegerType]
unsigned Int
i = forall a. Int -> [a] -> [a]
L.drop (Int
iforall a. Num a => a -> a -> a
*Int
2) [IntegerType]
unsignedPref forall a. [a] -> [a] -> [a]
++ [IntegerType
IntegerTypeBigint] forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
L.drop (Int
8forall a. Num a => a -> a -> a
-(Int
iforall a. Num a => a -> a -> a
*Int
2)forall a. Num a => a -> a -> a
+Int
1) [IntegerType]
unsignedNonPref
        signedPref :: [IntegerType]
signedPref = forall a. [a] -> [a] -> [a]
interleave [IntegerType]
signedOrdered [IntegerType]
unsignedOrdered
        unsignedPref :: [IntegerType]
unsignedPref = forall a. [a] -> [a] -> [a]
interleave [IntegerType]
unsignedOrdered [IntegerType]
signedOrdered
        signedNonPref :: [IntegerType]
signedNonPref = forall a. [a] -> [a]
L.reverse [IntegerType]
unsignedPref
        unsignedNonPref :: [IntegerType]
unsignedNonPref = forall a. [a] -> [a]
L.reverse [IntegerType]
signedPref

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

        signedOrdered :: [IntegerType]
signedOrdered = forall a. (a -> Bool) -> [a] -> [a]
L.filter
          (\IntegerType
v -> IntegerType -> Bool
integerTypeIsSigned IntegerType
v Bool -> Bool -> Bool
&& IntegerType -> Precision
integerTypePrecision IntegerType
v forall a. Eq a => a -> a -> Bool
/= Precision
PrecisionArbitrary) [IntegerType]
integerTypes
        unsignedOrdered :: [IntegerType]
unsignedOrdered = 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 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 = forall a s. String -> a -> Flow s a
withWarning String
msg forall a b. (a -> b) -> a -> b
$ 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 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) forall a. Eq a => a -> a -> Bool
/= Ordering
LT
            step :: Coder s1 s2 IntegerValue IntegerValue
step = forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerType -> IntegerValue -> IntegerValue
convertIntegerValue IntegerType
target) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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)