haskus-utils 0.8.0.0 → 1.0

raw patch · 15 files changed

+109/−4463 lines, 15 filesdep +haskus-utils-datadep +haskus-utils-typesdep +haskus-utils-variantdep ~basedep ~tastydep ~tasty-quickcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: haskus-utils-data, haskus-utils-types, haskus-utils-variant, recursion-schemes

Dependency ranges changed: base, tasty, tasty-quickcheck, template-haskell

API changes (from Hackage documentation)

Files

• CHANGES +8/−0
• haskus-utils.cabal +32/−22
• src/lib/Haskus/Utils/ContFlow.hs +0/−159
• src/lib/Haskus/Utils/Flow.hs +69/−1780
• src/lib/Haskus/Utils/HList.hs +0/−252
• src/lib/Haskus/Utils/List.hs +0/−16
• src/lib/Haskus/Utils/Map.hs +0/−6
• src/lib/Haskus/Utils/Map/Strict.hs +0/−7
• src/lib/Haskus/Utils/Maybe.hs +0/−32
• src/lib/Haskus/Utils/Monad.hs +0/−43
• src/lib/Haskus/Utils/Tuple.hs +0/−502
• src/lib/Haskus/Utils/Types.hs +0/−93
• src/lib/Haskus/Utils/Types/Generics.hs +0/−75
• src/lib/Haskus/Utils/Types/List.hs +0/−314
• src/lib/Haskus/Utils/Variant.hs +0/−1162

@@ -0,0 +1,8 @@+0.9.0.0 - TBA+=============+++0.8.0.0 - 2018-02-21+====================++* Enhanced Variant API

@@ -1,6 +1,6 @@ name: haskus-utils-version: 0.8.0.0-cabal-version: >=1.20+version: 1.0+cabal-version: >=1.21 build-type: Simple license: BSD3 license-file: LICENSE@@ -9,9 +9,11 @@ homepage: http://www.haskus.org/system synopsis: Haskus utility modules description:-    Various utility modules used by Haskus packages.+    Haskus utility modules. Reexport all other utility modules category: System author: Sylvain Henry+extra-source-files:+    CHANGES  source-repository head     type: git@@ -20,22 +22,11 @@ library     exposed-modules:         Haskus.Utils.Solver-        Haskus.Utils.ContFlow-        Haskus.Utils.Variant-        Haskus.Utils.Monad         Haskus.Utils.Parser         Haskus.Utils.HArray-        Haskus.Utils.Flow         Haskus.Utils.MultiState-        Haskus.Utils.HList         Haskus.Utils.Embed-        Haskus.Utils.List-        Haskus.Utils.Map-        Haskus.Utils.Map.Strict-        Haskus.Utils.Maybe-        Haskus.Utils.Types-        Haskus.Utils.Types.List-        Haskus.Utils.Types.Generics+        Haskus.Utils.Flow         Haskus.Utils.STM         Haskus.Utils.STM.TEq         Haskus.Utils.STM.TMap@@ -44,9 +35,27 @@         Haskus.Utils.STM.TTree         Haskus.Utils.STM.Future         Haskus.Utils.STM.TGraph-        Haskus.Utils.Tuple+    reexported-modules: Haskus.Utils.Types,+                        Haskus.Utils.Types.Generics,+                        Haskus.Utils.Types.List,+                        Haskus.Utils.Monad,+                        Haskus.Utils.HList,+                        Haskus.Utils.Functor,+                        Haskus.Utils.List,+                        Haskus.Utils.Map,+                        Haskus.Utils.Map.Strict,+                        Haskus.Utils.Maybe,+                        Haskus.Utils.Tuple,+                        Haskus.Utils.ContFlow,+                        Haskus.Utils.Variant,+                        Haskus.Utils.Variant.Flow,+                        Haskus.Utils.Variant.Cont,+                        Haskus.Utils.EADT     build-depends:-        base >=4.9 && <4.11,+        base >=4.9 && <4.12,+        haskus-utils-types ==1.0.*,+        haskus-utils-data ==1.0.*,+        haskus-utils-variant ==1.0.*,         containers ==0.5.*,         list-t >=0.4 && <1.1,         stm ==2.4.*,@@ -54,9 +63,10 @@         vector >=0.11 && <0.13,         transformers >=0.4 && <0.6,         mtl ==2.2.*,-        template-haskell >=2.10 && <2.13,+        template-haskell >=2.10 && <2.14,         file-embed >=0.0.10 && <0.1,-        extra >=1.4 && <1.7+        extra >=1.4 && <1.7,+        recursion-schemes ==5.0.*     default-language: Haskell2010     hs-source-dirs: src/lib     ghc-options: -Wall@@ -65,10 +75,10 @@     type: exitcode-stdio-1.0     main-is: Main.hs     build-depends:-        base >=4.10.1.0 && <4.11,+        base >=4.11.1.0 && <4.12,         haskus-utils -any,-        tasty ==0.11.*,-        tasty-quickcheck >=0.8 && <0.10+        tasty >=0.11 && <1.2,+        tasty-quickcheck >=0.8 && <0.11     default-language: Haskell2010     hs-source-dirs: src/tests     other-modules:

@@ -1,159 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE BangPatterns #-}---- | Continuation based control-flow-module Haskus.Utils.ContFlow-   ( ContFlow (..)-   , (>::>)-   , (>:-:>)-   , (>:%:>)-   , fret-   , fretN-   , freturn-   , freturnN-   , frec-   , ContListToTuple-   , ContTupleToList-   , StripR-   , AddR-   -- * Control-flow-   , fIf-   , Then (..)-   , Else (..)-   )-where--import Haskus.Utils.Tuple-import Haskus.Utils.Types-import Haskus.Utils.Types.List---- this define has to be defined in each module using ContFlow for now-#define fdo ContFlow $ \__cs -> let ?__cs = __cs in do---- | A continuation based control-flow-newtype ContFlow (xs :: [*]) r = ContFlow (ContListToTuple xs r -> r)---- | Convert a list of types into the actual data type representing the--- continuations.-type family ContListToTuple (xs :: [*]) r where-   ContListToTuple xs r = ListToTuple (AddR xs r)---- | Convert a tuple of continuations into a list of types-type family ContTupleToList t r :: [*] where-   ContTupleToList t r = StripR (TupleToList t) r--type family AddR f r where-   AddR '[] r       = '[]-   AddR (x ': xs) r = (x -> r) ': AddR xs r--type family StripR f r where-   StripR '[] r              = '[]-   StripR ((x -> r) ': xs) r = x ': StripR xs r-   StripR ((x -> w) ': xs) r =-      TypeError ( 'Text "Invalid continuation return type `"-                  ':<>: 'ShowType w ':<>: 'Text "', expecting `"-                  ':<>: 'ShowType r ':<>: 'Text "'")---- | Bind a flow to a tuple of continuations-(>::>) :: ContFlow xs r -> ContListToTuple xs r -> r-{-# INLINE (>::>) #-}-(>::>) (ContFlow f) !cs = f cs--infixl 0 >::>---- | Bind a flow to a 1-tuple of continuations-(>:-:>) :: ContFlow '[a] r -> (a -> r) -> r-{-# INLINE (>:-:>) #-}-(>:-:>) (ContFlow f) c = f (Single c)--infixl 0 >:-:>---- | Bind a flow to a tuple of continuations and--- reorder fields if necessary-(>:%:>) :: forall ts xs r.-   ( ReorderTuple ts (ContListToTuple xs r)-   ) => ContFlow xs r -> ts -> r-{-# INLINE (>:%:>) #-}-(>:%:>) (ContFlow f) !cs = f (tupleReorder cs)--infixl 0 >:%:>---- | Call the type-indexed continuation from the tuple passed as first parameter-fret :: forall x r t n xs.-   ( ExtractTuple n t (x -> r)-   , xs ~ ContTupleToList t r-   , Member x xs-   , n ~ IndexOf x xs-   , KnownNat n-   , CheckNub xs-   ) => t -> (x -> r)-{-# INLINE fret #-}-fret = tupleN @n @t @(x -> r)---- | Implicitly call the type-indexed continuation in the context-freturn :: forall x r t n xs.-   ( ExtractTuple n t (x -> r)-   , xs ~ ContTupleToList t r-   , Member x xs-   , n ~ IndexOf x xs-   , KnownNat n-   , CheckNub xs-   , ?__cs :: t-   ) => x -> r-{-# INLINE freturn #-}-freturn = fret ?__cs---- | Call the indexed continuation from the tuple passed as first parameter-fretN :: forall n x r t xs.-   ( ExtractTuple n t (x -> r)-   , xs ~ ContTupleToList t r-   , x ~ Index n xs-   , KnownNat n-   ) => t -> (x -> r)-{-# INLINE fretN #-}-fretN = tupleN @n @t @(x -> r)----- | Implicitly call the type-indexed continuation in the context-freturnN :: forall n x r t xs.-   ( ExtractTuple n t (x -> r)-   , xs ~ ContTupleToList t r-   , x ~ Index n xs-   , KnownNat n-   , ?__cs :: t-   ) => x -> r-{-# INLINE freturnN #-}-freturnN = fretN @n ?__cs----- | Recursive call-frec :: forall r xs.-   ( ?__cs :: ContListToTuple xs r-   ) => ContFlow xs r -> r-frec f = f >::> ?__cs---------------------------------------------- Control-flow--data Then = Then-data Else = Else--fIf :: Bool -> ContFlow '[Then,Else] r-{-# INLINE fIf #-}-fIf b = fdo-   case b of-      True  -> freturn Then-      False -> freturn Else

@@ -1,1780 +1,69 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE AllowAmbiguousTypes #-}---- | First-class control-flow (based on Variant)-module Haskus.Utils.Flow-   ( Flow-   , IOV-   , MonadIO (..)-   , MonadInIO (..)-   -- * Flow utils-   , flowRes-   , flowSingle-   , flowSetN-   , flowSet-   , flowLift-   , flowToCont-   , flowTraverse-   , flowFor-   , flowTraverseFilter-   , flowForFilter-   , Liftable-   , Popable-   , MaybePopable-   -- * Non-variant single operations-   , (|>)-   , (<|)-   , (||>)-   , (<||)-   -- * Monadic/applicative operators-   , when-   , unless-   , whenM-   , unlessM-   , ifM-   , guard-   , void-   , forever-   , foldM-   , foldM_-   , forM-   , forM_-   , mapM-   , mapM_-   , sequence-   , replicateM-   , replicateM_-   , filterM-   , join-   , (<=<)-   , (>=>)-   , loopM-   , whileM-   -- * Named operators-   , flowMap-   , flowBind-   , flowBind'-   , flowMatch-   , flowMatchFail-   -- * First element operations-   , (.~.>)-   , (>.~.>)-   , (.~+>)-   , (>.~+>)-   , (.~^^>)-   , (>.~^^>)-   , (.~^>)-   , (>.~^>)-   , (.~$>)-   , (>.~$>)-   , (.~|>)-   , (>.~|>)-   , (.~=>)-   , (>.~=>)-   , (.~!>)-   , (>.~!>)-   , (.~!!>)-   , (>.~!!>)-   -- * First element, pure variant-   , (.-.>)-   , (>.-.>)-   , (<.-.)-   , (<.-.<)-   -- * Functor, applicative equivalents-   , (<$<)-   , (<*<)-   , (<|<)-   -- * First element, const variant-   , (.~~.>)-   , (>.~~.>)-   , (.~~+>)-   , (>.~~+>)-   , (.~~^^>)-   , (>.~~^^>)-   , (.~~^>)-   , (>.~~^>)-   , (.~~$>)-   , (>.~~$>)-   , (.~~|>)-   , (>.~~|>)-   , (.~~=>)-   , (>.~~=>)-   , (.~~!>)-   , (>.~~!>)-   -- * Tail operations-   , (..~.>)-   , (>..~.>)-   , (..-.>)-   , (>..-.>)-   , (..-..>)-   , (>..-..>)-   , (..~..>)-   , (>..~..>)-   , (..~^^>)-   , (>..~^^>)-   , (..~^>)-   , (>..~^>)-   , (..~=>)-   , (>..~=>)-   , (..~!>)-   , (>..~!>)-   , (..~!!>)-   , (>..~!!>)-   -- * Tail pop operations-   , (..%~^>)-   , (>..%~^>)-   , (..%~^^>)-   , (>..%~^^>)-   , (..%~$>)-   , (>..%~$>)-   , (..%~!!>)-   , (>..%~!!>)-   , (..%~!>)-   , (>..%~!>)-   , (..?~^>)-   , (>..?~^>)-   , (..?~^^>)-   , (>..?~^^>)-   , (..?~$>)-   , (>..?~$>)-   , (..?~!!>)-   , (>..?~!!>)-   , (..?~!>)-   , (>..?~!>)-   -- * Caught element operations-   , (%~.>)-   , (>%~.>)-   , (%~+>)-   , (>%~+>)-   , (%~^^>)-   , (>%~^^>)-   , (%~^>)-   , (>%~^>)-   , (%~$>)-   , (>%~$>)-   , (%~|>)-   , (>%~|>)-   , (%~=>)-   , (>%~=>)-   , (%~!>)-   , (>%~!>)-   , (%~!!>)-   , (>%~!!>)-   , (?~.>)-   , (>?~.>)-   , (?~+>)-   , (>?~+>)-   , (?~^^>)-   , (>?~^^>)-   , (?~^>)-   , (>?~^>)-   , (?~$>)-   , (>?~$>)-   , (?~|>)-   , (>?~|>)-   , (?~=>)-   , (>?~=>)-   , (?~!>)-   , (>?~!>)-   , (?~!!>)-   , (>?~!!>)-   -- * Helpers-   , makeFlowOp-   , makeFlowOpM-   , selectTail-   , selectFirst-   , selectType-   , applyConst-   , applyPure-   , applyM-   , applyF-   , combineFirst-   , combineSameTail-   , combineEither-   , combineConcat-   , combineUnion-   , combineLiftUnselected-   , combineLiftBoth-   , combineSingle-   , liftV-   , liftF-   )-where--import Haskus.Utils.Variant-import Haskus.Utils.Types-import Haskus.Utils.Types.List-import Haskus.Utils.Monad-import Haskus.Utils.ContFlow---- | Control-flow-type Flow m (l :: [*]) = m (Variant l)--type IOV l = Flow IO l--------------------------------------------------------------- Flow utils--------------------------------------------------------------- | Return in the first element-flowSetN :: forall (n :: Nat) xs m.-   ( Monad m-   , KnownNat n-   ) => Index n xs -> Flow m xs-{-# INLINE flowSetN #-}-flowSetN = return . toVariantAt @n---- | Return in the first well-typed element-flowSet :: (Member x xs, Monad m) => x -> Flow m xs-{-# INLINE flowSet #-}-flowSet = return . toVariant---- | Return a single element-flowSingle :: Monad m => x -> Flow m '[x]-{-# INLINE flowSingle #-}-flowSingle = flowSetN @0---- | Lift a flow into another-flowLift :: (Liftable xs ys , Monad m) => Flow m xs -> Flow m ys-{-# INLINE flowLift #-}-flowLift = fmap liftVariant---- | Lift a flow into a ContFlow-flowToCont :: (ContVariant xs, Monad m) => Flow m xs -> ContFlow xs (m r)-flowToCont = variantToContM---- | Traverse a list and stop on first error-flowTraverse :: forall m a b xs.-   ( Monad m-   ) => (a -> Flow m (b ': xs)) -> [a] -> Flow m ([b] ': xs)-flowTraverse f = go (flowSetN @0 [])-   where-      go :: Flow m ([b] ': xs) -> [a] -> Flow m ([b] ': xs)-      go rs []     = rs >.-.> reverse-      go rs (a:as) = go rs' as-         where-            -- execute (f a) if previous execution succedded.-            -- prepend the result to the list-            rs' = rs >.~$> \bs -> (f a >.-.> (:bs))---- | Traverse a list and stop on first error-flowFor :: forall m a b xs.-   ( Monad m-   ) => [a] -> (a -> Flow m (b ': xs)) -> Flow m ([b] ': xs)-flowFor = flip flowTraverse---- | Traverse a list and return only valid values-flowTraverseFilter :: forall m a b xs.-   ( Monad m-   ) => (a -> Flow m (b ': xs)) -> [a] -> m [b]-flowTraverseFilter f = go-   where-      go :: [a] -> m [b]-      go []     = return []-      go (a:as) = do-         f a >.~.> (\b -> (b:) <$> go as)-             >..~.> const (go as)---- | Traverse a list and return only valid values-flowForFilter :: forall m a b xs.-   ( Monad m-   ) => [a] -> (a -> Flow m (b ': xs)) -> m [b]-flowForFilter = flip flowTraverseFilter----- | Extract single flow result-flowRes :: Functor m => Flow m '[x] -> m x-{-# INLINE flowRes #-}-flowRes = fmap variantToValue----- | Lift an operation on a Variant into an operation on a flow-liftm :: Monad m => (Variant x -> a -> m b) -> Flow m x -> a -> m b-{-# INLINE liftm #-}-liftm op x a = do-   x' <- x-   op x' a--------------------------------------------------------------- Single element not wrapped into a variant--------------------------------------------------------------- | Apply a function-(|>) :: a -> (a -> b) -> b-{-# INLINE (|>) #-}-x |> f = f x--infixl 0 |>---- | Apply a function-(<|) :: (a -> b) -> a -> b-{-# INLINE (<|) #-}-f <| x = f x--infixr 0 <|---- | Apply a function in a Functor-(||>) :: Functor f => f a -> (a -> b) -> f b-{-# INLINE (||>) #-}-x ||> f = fmap f x--infixl 0 ||>---- | Apply a function in a Functor-(<||) :: Functor f => (a -> b) -> f a -> f b-{-# INLINE (<||) #-}-f <|| x = fmap f x--infixr 0 <||--------------------------------------------------------------- Named operators--------------------------------------------------------------- | Map a pure function onto the correct value in the flow-flowMap :: Monad m => Flow m (x ': xs) -> (x -> y) -> Flow m (y ': xs)-{-# INLINE flowMap #-}-flowMap = (>.-.>)---- | Bind two flows in a monadish way (error types union)-flowBind :: forall xs ys zs m x.-   ( Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   , Monad m-   ) => Flow m (x ': ys) -> (x -> Flow m xs) -> Flow m zs-{-# INLINE flowBind #-}-flowBind = (>.~|>)---- | Bind two flows in a monadic way (constant error types)-flowBind' :: Monad m => Flow m (x ': xs) -> (x -> Flow m (y ': xs)) -> Flow m (y ': xs)-{-# INLINE flowBind' #-}-flowBind' = (>.~$>)---- | Match a value in a flow-flowMatch :: forall x xs zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs-{-# INLINE flowMatch #-}-flowMatch = (>%~^>)---- | Match a value in a flow and use a non-returning failure in this case-flowMatchFail :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)-{-# INLINE flowMatchFail #-}-flowMatchFail = (>%~!!>)--------------------------------------------------------------- First element operations--------------------------------------------------------------- | Extract the first value, set the first value-(.~.>) :: forall m l x a.-   ( Monad m )-   => Variant (a ': l) -> (a -> m x) -> Flow m (x ': l)-{-# INLINE (.~.>) #-}-(.~.>) v f = makeFlowOp selectFirst (applyM f) combineFirst v--infixl 0 .~.>---- | Extract the first value, set the first value-(>.~.>) :: forall m l x a.-   ( Monad m )-   => Flow m (a ': l) -> (a -> m x) -> Flow m (x ': l)-{-# INLINE (>.~.>) #-}-(>.~.>) = liftm (.~.>)--infixl 0 >.~.>---- | Extract the first value, concat the result-(.~+>) :: forall (k :: Nat) m l l2 a.-   ( KnownNat k-   , k ~ Length l2-   , Monad m )-   => Variant (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l)-{-# INLINE (.~+>) #-}-(.~+>) v f = makeFlowOp selectFirst (applyF f) combineConcat v--infixl 0 .~+>---- | Extract the first value, concat the results-(>.~+>) :: forall (k :: Nat) m l l2 a.-   ( KnownNat k-   , k ~ Length l2-   , Monad m )-   => Flow m (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l)-{-# INLINE (>.~+>) #-}-(>.~+>) = liftm (.~+>)--infixl 0 >.~+>---- | Extract the first value, lift both-(.~^^>) :: forall m a xs ys zs.-   ( Monad m-   , Liftable xs zs-   , Liftable ys zs-   ) => Variant (a ': ys) -> (a -> Flow m xs) -> Flow m zs-{-# INLINE (.~^^>) #-}-(.~^^>) v f = makeFlowOp selectFirst (applyF f) combineLiftBoth v--infixl 0 .~^^>----- | Extract the first value, lift both-(>.~^^>) :: forall m a xs ys zs.-   ( Monad m-   , Liftable xs zs-   , Liftable ys zs-   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs-{-# INLINE (>.~^^>) #-}-(>.~^^>) = liftm (.~^^>)--infixl 0 >.~^^>---- | Extract the first value, lift unselected-(.~^>) :: forall m a ys zs.-   ( Monad m-   , Liftable ys zs-   ) => Variant (a ': ys) -> (a -> Flow m zs) -> Flow m zs-{-# INLINE (.~^>) #-}-(.~^>) v f = makeFlowOp selectFirst (applyF f) combineLiftUnselected v--infixl 0 .~^>---- | Extract the first value, lift unselected-(>.~^>) :: forall m a ys zs.-   ( Monad m-   , Liftable ys zs-   ) => Flow m (a ': ys) -> (a -> Flow m zs) -> Flow m zs-{-# INLINE (>.~^>) #-}-(>.~^>) = liftm (.~^>)--infixl 0 >.~^>---- | Extract the first value, use the same tail-(.~$>) :: forall m x xs a.-   ( Monad m-   ) => Variant (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (.~$>) #-}-(.~$>) v f = makeFlowOp selectFirst (applyF f) combineSameTail v--infixl 0 .~$>---- | Extract the first value, use the same tail-(>.~$>) :: forall m x xs a.-   ( Monad m-   ) => Flow m (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (>.~$>) #-}-(>.~$>) = liftm (.~$>)--infixl 0 >.~$>---- | Take the first output, union the result-(.~|>) ::-   ( Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   , Monad m-   ) => Variant (a ': ys) -> (a -> Flow m xs) -> Flow m zs-{-# INLINE (.~|>) #-}-(.~|>) v f = makeFlowOp selectFirst (applyF f) combineUnion v--infixl 0 .~|>---- | Take the first output, fusion the result-(>.~|>) ::-   ( Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   , Monad m-   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs-{-# INLINE (>.~|>) #-}-(>.~|>) = liftm (.~|>)--infixl 0 >.~|>---- | Extract the first value and perform effect. Passthrough the input value-(.~=>) ::-   ( Monad m-   ) => Variant (a ': l) -> (a -> m ()) -> Flow m (a ': l)-{-# INLINE (.~=>) #-}-(.~=>) v f = case popVariantHead v of-   Right u -> f u >> return v-   Left  _ -> return v--infixl 0 .~=>---- | Extract the first value and perform effect. Passthrough the input value-(>.~=>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (a -> m ()) -> Flow m (a ': l)-{-# INLINE (>.~=>) #-}-(>.~=>) = liftm (.~=>)--infixl 0 >.~=>---- | Extract the first value and perform effect.-(.~!>) ::-   ( Monad m-   ) => Variant (a ': l) -> (a -> m ()) -> m ()-{-# INLINE (.~!>) #-}-(.~!>) v f = case popVariantHead v of-   Right u -> f u-   Left  _ -> return ()--infixl 0 .~!>---- | Extract the first value and perform effect.-(>.~!>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (a -> m ()) -> m ()-{-# INLINE (>.~!>) #-}-(>.~!>) = liftm (.~!>)--infixl 0 >.~!>---- | Extract the first value and perform effect.-(.~!!>) ::-   ( Monad m-   ) => Variant (a ': l) -> (a -> m ()) -> m (Variant l)-{-# INLINE (.~!!>) #-}-(.~!!>) v f = case popVariantHead v of-   Right u -> f u >> error ".~!!> error"-   Left  l -> return l--infixl 0 .~!!>---- | Extract the first value and perform effect.-(>.~!!>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (a -> m ()) -> m (Variant l)-{-# INLINE (>.~!!>) #-}-(>.~!!>) = liftm (.~!!>)--infixl 0 >.~!!>--------------------------------------------------------------- First element, pure variant--------------------------------------------------------------- | Extract the first value, set the first value-(.-.>) :: forall m l x a.-   ( Monad m )-   => Variant (a ': l) -> (a -> x) -> Flow m (x ': l)-{-# INLINE (.-.>) #-}-(.-.>) v f = makeFlowOp selectFirst (applyPure (liftV f)) combineFirst v--infixl 0 .-.>---- | Extract the first value, set the first value-(>.-.>) :: forall m l x a.-   ( Monad m )-   => Flow m (a ': l) -> (a -> x) -> Flow m (x ': l)-{-# INLINE (>.-.>) #-}-(>.-.>) = liftm (.-.>)--infixl 0 >.-.>---- | Extract the first value, set the first value-(<.-.) :: forall m l x a.-   ( Monad m )-   => (a -> x) -> Variant (a ': l) -> Flow m (x ': l)-{-# INLINE (<.-.) #-}-(<.-.) = flip (.-.>)--infixr 0 <.-.---- | Extract the first value, set the first value-(<.-.<) :: forall m l x a.-   ( Monad m )-   => (a -> x) -> Flow m (a ': l) -> Flow m (x ': l)-{-# INLINE (<.-.<) #-}-(<.-.<) = flip (>.-.>)--infixr 0 <.-.<--------------------------------------------------------------- Functor, applicative--------------------------------------------------------------- | Functor <$> equivalent-(<$<) :: forall m l a b.-   ( Monad m )-   => (a -> b) -> Flow m (a ': l) -> Flow m (b ': l)-{-# INLINE (<$<) #-}-(<$<) = (<.-.<)--infixl 4 <$<---- | Applicative <*> equivalent-(<*<) :: forall m l a b.-   ( Monad m )-   => Flow m ((a -> b) ': l) -> Flow m (a ': l) -> Flow m (b ': l)-{-# INLINE (<*<) #-}-(<*<) mf mg = mf >.~$> (mg >.-.>)--infixl 4 <*<---- | Applicative <*> equivalent, with error union-(<|<) :: forall m xs ys zs y z.-   ( Monad m-   , Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   ) => Flow m ((y -> z) ': xs) -> Flow m (y ': ys) -> Flow m (z ': zs)-{-# INLINE (<|<) #-}-(<|<) mf mg = -   mf >..-..> liftVariant-      >.~$> (\f -> mg >..-..> liftVariant-                      >.-.> f-            )--infixl 4 <|<--------------------------------------------------------------- First element, const variant--------------------------------------------------------------- | Extract the first value, set the first value-(.~~.>) :: forall m l x a.-   ( Monad m )-   => Variant (a ': l) -> m x -> Flow m (x ': l)-{-# INLINE (.~~.>) #-}-(.~~.>) v f = v .~.> const f--infixl 0 .~~.>---- | Extract the first value, set the first value-(>.~~.>) :: forall m l x a.-   ( Monad m )-   => Flow m (a ': l) -> m x -> Flow m (x ': l)-{-# INLINE (>.~~.>) #-}-(>.~~.>) = liftm (.~~.>)--infixl 0 >.~~.>---- | Extract the first value, concat the result-(.~~+>) :: forall (k :: Nat) m l l2 a.-   ( KnownNat k-   , k ~ Length l2-   , Monad m )-   => Variant (a ': l) -> Flow m l2 -> Flow m (Concat l2 l)-{-# INLINE (.~~+>) #-}-(.~~+>) v f = v .~+> const f--infixl 0 .~~+>---- | Extract the first value, concat the results-(>.~~+>) :: forall (k :: Nat) m l l2 a.-   ( KnownNat k-   , k ~ Length l2-   , Monad m )-   => Flow m (a ': l) -> Flow m l2 -> Flow m (Concat l2 l)-{-# INLINE (>.~~+>) #-}-(>.~~+>) = liftm (.~~+>)--infixl 0 >.~~+>---- | Extract the first value, lift the result-(.~~^^>) :: forall m a xs ys zs.-   ( Monad m-   , Liftable xs zs-   , Liftable ys zs-   ) => Variant (a ': ys) -> Flow m xs -> Flow m zs-{-# INLINE (.~~^^>) #-}-(.~~^^>) v f = v .~^^> const f--infixl 0 .~~^^>----- | Extract the first value, lift the result-(>.~~^^>) :: forall m a xs ys zs.-   ( Monad m-   , Liftable xs zs-   , Liftable ys zs-   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs-{-# INLINE (>.~~^^>) #-}-(>.~~^^>) = liftm (.~~^^>)--infixl 0 >.~~^^>---- | Extract the first value, connect to the expected output-(.~~^>) :: forall m a ys zs.-   ( Monad m-   , Liftable ys zs-   ) => Variant (a ': ys) -> Flow m zs -> Flow m zs-{-# INLINE (.~~^>) #-}-(.~~^>) v f = v .~^> const f--infixl 0 .~~^>---- | Extract the first value, connect to the expected output-(>.~~^>) :: forall m a ys zs.-   ( Monad m-   , Liftable ys zs-   ) => Flow m (a ': ys) -> Flow m zs -> Flow m zs-{-# INLINE (>.~~^>) #-}-(>.~~^>) = liftm (.~~^>)--infixl 0 >.~~^>---- | Extract the first value, use the same output type-(.~~$>) :: forall m x xs a.-   ( Monad m-   ) => Variant (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs)-{-# INLINE (.~~$>) #-}-(.~~$>) v f = v .~$> const f--infixl 0 .~~$>---- | Extract the first value, use the same output type-(>.~~$>) :: forall m x xs a.-   ( Monad m-   ) => Flow m (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs)-{-# INLINE (>.~~$>) #-}-(>.~~$>) = liftm (.~~$>)--infixl 0 >.~~$>---- | Take the first output, fusion the result-(.~~|>) ::-   ( Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   , Monad m-   ) => Variant (a ': ys) -> Flow m xs -> Flow m zs-{-# INLINE (.~~|>) #-}-(.~~|>) v f = v .~|> const f--infixl 0 .~~|>---- | Take the first output, fusion the result-(>.~~|>) ::-   ( Liftable xs zs-   , Liftable ys zs-   , zs ~ Union xs ys-   , Monad m-   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs-{-# INLINE (>.~~|>) #-}-(>.~~|>) = liftm (.~~|>)--infixl 0 >.~~|>---- | Extract the first value and perform effect. Passthrough the input value-(.~~=>) ::-   ( Monad m-   ) => Variant (a ': l) -> m () -> Flow m (a ': l)-{-# INLINE (.~~=>) #-}-(.~~=>) v f = v .~=> const f--infixl 0 .~~=>---- | Extract the first value and perform effect. Passthrough the input value-(>.~~=>) ::-   ( Monad m-   ) => Flow m (a ': l) -> m () -> Flow m (a ': l)-{-# INLINE (>.~~=>) #-}-(>.~~=>) = liftm (.~~=>)--infixl 0 >.~~=>---- | Extract the first value and perform effect.-(.~~!>) ::-   ( Monad m-   ) => Variant (a ': l) -> m () -> m ()-{-# INLINE (.~~!>) #-}-(.~~!>) v f = v .~!> const f--infixl 0 .~~!>---- | Extract the first value and perform effect.-(>.~~!>) ::-   ( Monad m-   ) => Flow m (a ': l) -> m () -> m ()-{-# INLINE (>.~~!>) #-}-(>.~~!>) = liftm (.~~!>)--infixl 0 >.~~!>---------------------------------------------------------------- Tail operations--------------------------------------------------------------- | Extract the tail, set the first value-(..~.>) ::-   ( Monad m-   ) => Variant (a ': l) -> (Variant l -> m a) -> m a-{-# INLINE (..~.>) #-}-(..~.>) v f = makeFlowOp selectTail (applyVM f) combineSingle v--infixl 0 ..~.>---- | Extract the tail, set the first value-(>..~.>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (Variant l -> m a) -> m a-{-# INLINE (>..~.>) #-}-(>..~.>) = liftm (..~.>)--infixl 0 >..~.>---- | Extract the tail, set the first value (pure function)-(..-.>) ::-   ( Monad m-   ) => Variant (a ': l) -> (Variant l -> a) -> m a-{-# INLINE (..-.>) #-}-(..-.>) v f = case popVariantHead v of-   Right u -> return u-   Left  l -> return (f l)--infixl 0 ..-.>---- | Extract the tail, set the first value (pure function)-(>..-.>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (Variant l -> a) -> m a-{-# INLINE (>..-.>) #-}-(>..-.>) = liftm (..-.>)--infixl 0 >..-.>---- | Extract the tail, set the tail-(..-..>) :: forall a l xs m.-   ( Monad m-   ) => Variant (a ': l) -> (Variant l -> Variant xs) -> Flow m (a ': xs)-{-# INLINE (..-..>) #-}-(..-..>) v f = case popVariantHead v of-   Right u -> flowSetN @0 u-   Left  l -> return (prependVariant @'[a] (f l))--infixl 0 ..-..>---- | Extract the tail, set the tail-(>..-..>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (Variant l -> Variant xs) -> Flow m (a ': xs)-{-# INLINE (>..-..>) #-}-(>..-..>) = liftm (..-..>)--infixl 0 >..-..>---- | Extract the tail, set the tail-(..~..>) :: forall a l xs m.-   ( Monad m-   ) => Variant (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': xs)-{-# INLINE (..~..>) #-}-(..~..>) v f = case popVariantHead v of-   Right u -> flowSetN @0 u-   Left  l -> prependVariant @'[a] <$> f l--infixl 0 ..~..>---- | Extract the tail, set the tail-(>..~..>) ::-   ( Monad m-   ) => Flow m (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': xs)-{-# INLINE (>..~..>) #-}-(>..~..>) = liftm (..~..>)--infixl 0 >..~..>---- | Extract the tail, lift the result-(..~^^>) ::-   ( Monad m-   , Liftable xs (a ': zs)-   ) => Variant (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': zs)-{-# INLINE (..~^^>) #-}-(..~^^>) v f = case popVariantHead v of-   Right u -> flowSetN @0 u-   Left  l -> liftVariant <$> f l--infixl 0 ..~^^>---- | Extract the tail, lift the result-(>..~^^>) ::-   ( Monad m-   , Liftable xs (a ': zs)-   ) => Flow m  (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': zs)-{-# INLINE (>..~^^>) #-}-(>..~^^>) = liftm (..~^^>)--infixl 0 >..~^^>---- | Extract the tail, connect the result-(..~^>) ::-   ( Monad m-   , Member a zs-   ) => Variant (a ': l) -> (Variant l -> Flow m zs) -> Flow m zs-{-# INLINE (..~^>) #-}-(..~^>) v f = case popVariantHead v of-   Right u -> flowSet u-   Left  l -> f l--infixl 0 ..~^>---- | Extract the tail, connect the result-(>..~^>) ::-   ( Monad m-   , Member a zs-   ) => Flow m (a ': l) -> (Variant l -> Flow m zs) -> Flow m zs-{-# INLINE (>..~^>) #-}-(>..~^>) = liftm (..~^>)--infixl 0 >..~^>---- | Match in the tail, connect to the expected result-(..?~^>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) ys-   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)-{-# INLINE (..?~^>) #-}-(..?~^>) v f = v ..~..> (\v' -> v' ?~^> f)--infixl 0 ..?~^>---- | Match in the tail, connect to the expected result-(>..?~^>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) ys-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)-{-# INLINE (>..?~^>) #-}-(>..?~^>) = liftm (..?~^>)--infixl 0 >..?~^>---- | Match in the tail, connect to the expected result-(..%~^>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) ys-   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)-{-# INLINE (..%~^>) #-}-(..%~^>) v f = v ..~..> (\v' -> v' %~^> f)--infixl 0 ..%~^>---- | Match in the tail, connect to the expected result-(>..%~^>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) ys-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)-{-# INLINE (>..%~^>) #-}-(>..%~^>) = liftm (..%~^>)--infixl 0 >..%~^>---- | Match in the tail, lift to the expected result-(..?~^^>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs-   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)-{-# INLINE (..?~^^>) #-}-(..?~^^>) v f = v ..~..> (\v' -> v' ?~^^> f)--infixl 0 ..?~^^>---- | Match in the tail, lift to the expected result-(>..?~^^>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)-{-# INLINE (>..?~^^>) #-}-(>..?~^^>) = liftm (..?~^^>)--infixl 0 >..?~^^>---- | Match in the tail, lift to the expected result-(..%~^^>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs-   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)-{-# INLINE (..%~^^>) #-}-(..%~^^>) v f = v ..~..> (\v' -> v' %~^^> f)--infixl 0 ..%~^^>---- | Match in the tail, lift to the expected result-(>..%~^^>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)-{-# INLINE (>..%~^^>) #-}-(>..%~^^>) = liftm (..%~^^>)--infixl 0 >..%~^^>---- | Match in the tail, keep the same types-(..?~$>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) (x ': xs)-   ) => Variant (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (..?~$>) #-}-(..?~$>) v f = case popVariantHead v of-   Right _ -> return v-   Left xs -> xs ?~^> f--infixl 0 ..?~$>---- | Match in the tail, keep the same types-(>..?~$>) ::-   ( Monad m-   , MaybePopable a xs-   , Liftable (Filter a xs) (x ': xs)-   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (>..?~$>) #-}-(>..?~$>) = liftm (..?~$>)--infixl 0 >..?~$>---- | Match in the tail, keep the same types-(..%~$>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) (x ': xs)-   ) => Variant (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (..%~$>) #-}-(..%~$>) v f = case popVariantHead v of-   Right _ -> return v-   Left xs -> xs %~^> f--infixl 0 ..%~$>---- | Match in the tail, keep the same types-(>..%~$>) ::-   ( Monad m-   , Popable a xs-   , Liftable (Filter a xs) (x ': xs)-   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)-{-# INLINE (>..%~$>) #-}-(>..%~$>) = liftm (..%~$>)--infixl 0 >..%~$>----- | Extract the tail and perform an effect. Passthrough the input value-(..~=>) ::-   ( Monad m-   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> Flow m (x ': xs)-{-# INLINE (..~=>) #-}-(..~=>) v f = case popVariantHead v of-   Right _ -> return v-   Left  l -> f l >> return v--infixl 0 ..~=>---- | Extract the tail and perform an effect. Passthrough the input value-(>..~=>) ::-   ( Monad m-   ) => Flow m (x ': xs) -> (Variant xs -> m ()) -> Flow m (x ': xs)-{-# INLINE (>..~=>) #-}-(>..~=>) = liftm (..~=>)--infixl 0 >..~=>---- | Extract the tail and perform an effect-(..~!>) ::-   ( Monad m-   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> m ()-{-# INLINE (..~!>) #-}-(..~!>) v f = case popVariantHead v of-   Right _ -> return ()-   Left  l -> f l--infixl 0 ..~!>---- | Extract the tail and perform an effect-(>..~!>) ::-   ( Monad m-   ) => Flow m (x ': xs) -> (Variant xs -> m ()) -> m ()-{-# INLINE (>..~!>) #-}-(>..~!>) = liftm (..~!>)--infixl 0 >..~!>---- | Extract the tail and perform an effect-(..~!!>) ::-   ( Monad m-   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> m x-{-# INLINE (..~!!>) #-}-(..~!!>) v f = case popVariantHead v of-   Right x -> return x-   Left xs -> f xs >> error "..~!!> error"--infixl 0 ..~!!>---- | Extract the tail and perform an effect-(>..~!!>) ::-   ( Monad m-   ) => Flow m (x ': xs) -> (Variant xs -> m ()) -> m x-{-# INLINE (>..~!!>) #-}-(>..~!!>) = liftm (..~!!>)--infixl 0 >..~!!>---- | Match in the tail and perform an effect-(..?~!!>) ::-   ( Monad m-   , MaybePopable y xs-   ) => Variant (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)-{-# INLINE (..?~!!>) #-}-(..?~!!>) v f = v ..~..> (\xs -> xs ?~!!> f)--infixl 0 ..?~!!>---- | Match in the tail and perform an effect-(>..?~!!>) ::-   ( Monad m-   , MaybePopable y xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)-{-# INLINE (>..?~!!>) #-}-(>..?~!!>) = liftm (..?~!!>)--infixl 0 >..?~!!>---- | Match in the tail and perform an effect-(..%~!!>) ::-   ( Monad m-   , Popable y xs-   ) => Variant (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)-{-# INLINE (..%~!!>) #-}-(..%~!!>) v f = v ..~..> (\xs -> xs %~!!> f)--infixl 0 ..%~!!>---- | Match in the tail and perform an effect-(>..%~!!>) ::-   ( Monad m-   , Popable y xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)-{-# INLINE (>..%~!!>) #-}-(>..%~!!>) = liftm (..%~!!>)--infixl 0 >..%~!!>---- | Match in the tail and perform an effect-(..?~!>) ::-   ( Monad m-   , MaybePopable y xs-   ) => Variant (x ': xs) -> (y -> m ()) -> m ()-{-# INLINE (..?~!>) #-}-(..?~!>) v f = case popVariantHead v of-   Right _ -> return ()-   Left xs -> xs ?~!> f--infixl 0 ..?~!>---- | Match in the tail and perform an effect-(>..?~!>) ::-   ( Monad m-   , MaybePopable y xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()-{-# INLINE (>..?~!>) #-}-(>..?~!>) = liftm (..?~!>)--infixl 0 >..?~!>---- | Match in the tail and perform an effect-(..%~!>) ::-   ( Monad m-   , Popable y xs-   ) => Variant (x ': xs) -> (y -> m ()) -> m ()-{-# INLINE (..%~!>) #-}-(..%~!>) v f = case popVariantHead v of-   Right _ -> return ()-   Left xs -> xs %~!> f--infixl 0 ..%~!>---- | Match in the tail and perform an effect-(>..%~!>) ::-   ( Monad m-   , Popable y xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()-{-# INLINE (>..%~!>) #-}-(>..%~!>) = liftm (..%~!>)--infixl 0 >..%~!>--------------------------------------------------------------- Caught element operations--------------------------------------------------------------- | Pop element, set the first value-(?~.>) :: forall x xs y ys m.-   ( ys ~ Filter x xs-   , Monad m-   , MaybePopable x xs-   ) => Variant xs -> (x -> m y) -> Flow m (y ': ys)-{-# INLINE (?~.>) #-}-(?~.>) v f = case popVariantMaybe v of-   Right x -> flowSetN @0 =<< f x-   Left ys -> prependVariant @'[y] <$> return ys--infixl 0 ?~.>---- | Pop element, set the first value-(>?~.>) ::-   ( ys ~ Filter x xs-   , Monad m-   , MaybePopable x xs-   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)-{-# INLINE (>?~.>) #-}-(>?~.>) = liftm (?~.>)--infixl 0 >?~.>---- | Pop element, set the first value-(%~.>) :: forall x xs y ys m.-   ( ys ~ Filter x xs-   , Monad m-   , Popable x xs-   ) => Variant xs -> (x -> m y) -> Flow m (y ': ys)-{-# INLINE (%~.>) #-}-(%~.>) = (?~.>)--infixl 0 %~.>---- | Pop element, set the first value-(>%~.>) ::-   ( ys ~ Filter x xs-   , Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)-{-# INLINE (>%~.>) #-}-(>%~.>) = liftm (%~.>)--infixl 0 >%~.>---- | Pop element, concat the result-(?~+>) :: forall x xs ys m.-   ( Monad m-   , MaybePopable x xs-   , KnownNat (Length ys)-   ) => Variant xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))-{-# INLINE (?~+>) #-}-(?~+>) v f = case popVariantMaybe v of-   Right x -> appendVariant  @(Filter x xs) <$> f x-   Left ys -> prependVariant @ys            <$> return ys--infixl 0 ?~+>---- | Pop element, concat the result-(>?~+>) :: forall x xs ys m.-   ( Monad m-   , MaybePopable x xs-   , KnownNat (Length ys)-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))-{-# INLINE (>?~+>) #-}-(>?~+>) = liftm (?~+>)--infixl 0 >?~+>---- | Pop element, concat the result-(%~+>) :: forall x xs ys m.-   ( Monad m-   , Popable x xs-   , KnownNat (Length ys)-   ) => Variant xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))-{-# INLINE (%~+>) #-}-(%~+>) = (?~+>)--infixl 0 %~+>---- | Pop element, concat the result-(>%~+>) :: forall x xs ys m.-   ( Monad m-   , Popable x xs-   , KnownNat (Length ys)-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))-{-# INLINE (>%~+>) #-}-(>%~+>) = liftm (%~+>)--infixl 0 >%~+>---- | Pop element, lift the result-(?~^^>) :: forall x xs ys zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (?~^^>) #-}-(?~^^>) v f = case popVariantMaybe v of-   Right x -> liftVariant <$> f x-   Left ys -> liftVariant <$> return ys--infixl 0 ?~^^>---- | Pop element, lift the result-(>?~^^>) :: forall x xs ys zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (>?~^^>) #-}-(>?~^^>) = liftm (?~^^>)--infixl 0 >?~^^>---- | Pop element, lift the result-(%~^^>) :: forall x xs ys zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (%~^^>) #-}-(%~^^>) = (?~^^>)--infixl 0 %~^^>---- | Pop element, lift the result-(>%~^^>) :: forall x xs ys zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (>%~^^>) #-}-(>%~^^>) = liftm (%~^^>)--infixl 0 >%~^^>---- | Pop element, connect to the expected output-(?~^>) :: forall x xs zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   ) => Variant xs -> (x -> Flow m zs) -> Flow m zs-{-# INLINE (?~^>) #-}-(?~^>) v f = case popVariantMaybe v of-   Right x -> f x-   Left ys -> return (liftVariant ys)--infixl 0 ?~^>---- | Pop element, connect to the expected output-(>?~^>) :: forall x xs zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs-{-# INLINE (>?~^>) #-}-(>?~^>) = liftm (?~^>)--infixl 0 >?~^>---- | Pop element, connect to the expected output-(%~^>) :: forall x xs zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   ) => Variant xs -> (x -> Flow m zs) -> Flow m zs-{-# INLINE (%~^>) #-}-(%~^>) = (?~^>)--infixl 0 %~^>---- | Pop element, connect to the expected output-(>%~^>) :: forall x xs zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs-{-# INLINE (>%~^>) #-}-(>%~^>) = liftm (%~^>)--infixl 0 >%~^>---- | Pop element, use the same output type-(?~$>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Variant xs -> (x -> Flow m xs) -> Flow m xs-{-# INLINE (?~$>) #-}-(?~$>) v f = case popVariantMaybe v of-   Right x -> f x-   Left _  -> return v--infixl 0 ?~$>---- | Pop element, use the same output type-(>?~$>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs-{-# INLINE (>?~$>) #-}-(>?~$>) = liftm (?~$>)--infixl 0 >?~$>---- | Pop element, use the same output type-(%~$>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Variant xs -> (x -> Flow m xs) -> Flow m xs-{-# INLINE (%~$>) #-}-(%~$>) = (?~$>)--infixl 0 %~$>---- | Pop element, use the same output type-(>%~$>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs-{-# INLINE (>%~$>) #-}-(>%~$>) = liftm (%~$>)--infixl 0 >%~$>---- | Pop element, fusion the result-(?~|>) :: forall x xs ys zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys-   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (?~|>) #-}-(?~|>) v f = case popVariantMaybe v of-   Right x -> liftVariant <$> f x-   Left ys -> return (liftVariant ys)--infixl 0 ?~|>---- | Pop element, fusion the result-(>?~|>) :: forall x xs ys zs m.-   ( Monad m-   , MaybePopable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (>?~|>) #-}-(>?~|>) = liftm (?~|>)--infixl 0 >?~|>---- | Pop element, fusion the result-(%~|>) :: forall x xs ys zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys-   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (%~|>) #-}-(%~|>) = (?~|>)--infixl 0 %~|>---- | Pop element, fusion the result-(>%~|>) :: forall x xs ys zs m.-   ( Monad m-   , Popable x xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs-{-# INLINE (>%~|>) #-}-(>%~|>) = liftm (%~|>)--infixl 0 >%~|>---- | Pop element and perform effect. Passthrough the input value.-(?~=>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Variant xs -> (x -> m ()) -> Flow m xs-{-# INLINE (?~=>) #-}-(?~=>) v f = case popVariantMaybe v of-   Right x -> f x >> return v-   Left _  -> return v--infixl 0 ?~=>---- | Pop element and perform effect. Passthrough the input value.-(>?~=>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Flow m xs -> (x -> m ()) -> Flow m xs-{-# INLINE (>?~=>) #-}-(>?~=>) = liftm (?~=>)--infixl 0 >?~=>---- | Pop element and perform effect. Passthrough the input value.-(%~=>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Variant xs -> (x -> m ()) -> Flow m xs-{-# INLINE (%~=>) #-}-(%~=>) = (?~=>)--infixl 0 %~=>---- | Pop element and perform effect. Passthrough the input value.-(>%~=>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> m ()) -> Flow m xs-{-# INLINE (>%~=>) #-}-(>%~=>) = liftm (%~=>)--infixl 0 >%~=>---- | Pop element and perform effect.-(?~!>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Variant xs -> (x -> m ()) -> m ()-{-# INLINE (?~!>) #-}-(?~!>) v f = case popVariantMaybe v of-   Right x -> f x-   Left _  -> return ()--infixl 0 ?~!>---- | Pop element and perform effect.-(>?~!>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Flow m xs -> (x -> m ()) -> m ()-{-# INLINE (>?~!>) #-}-(>?~!>) = liftm (?~!>)--infixl 0 >?~!>---- | Pop element and perform effect.-(%~!>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Variant xs -> (x -> m ()) -> m ()-{-# INLINE (%~!>) #-}-(%~!>) = (?~!>)--infixl 0 %~!>---- | Pop element and perform effect.-(>%~!>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> m ()) -> m ()-{-# INLINE (>%~!>) #-}-(>%~!>) = liftm (%~!>)--infixl 0 >%~!>---- | Pop element and perform effect.-(?~!!>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Variant xs -> (x -> m ()) -> Flow m (Filter x xs)-{-# INLINE (?~!!>) #-}-(?~!!>) v f = case popVariantMaybe v of-   Right x -> f x >> error "?~!!> error"-   Left u  -> return u--infixl 0 ?~!!>---- | Pop element and perform effect.-(>?~!!>) :: forall x xs m.-   ( Monad m-   , MaybePopable x xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)-{-# INLINE (>?~!!>) #-}-(>?~!!>) = liftm (?~!!>)--infixl 0 >?~!!>---- | Pop element and perform effect.-(%~!!>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Variant xs -> (x -> m ()) -> Flow m (Filter x xs)-{-# INLINE (%~!!>) #-}-(%~!!>) = (?~!!>)--infixl 0 %~!!>---- | Pop element and perform effect.-(>%~!!>) :: forall x xs m.-   ( Monad m-   , Popable x xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)-{-# INLINE (>%~!!>) #-}-(>%~!!>) = liftm (%~!!>)--infixl 0 >%~!!>------------------------------------------------------------------- Helpers-------------------------------------------------------------------- | Make a flow operator-makeFlowOp :: Monad m =>-      (Variant as -> Either (Variant bs) (Variant cs))-      -> (Variant cs -> Flow m ds)-      -> (Either (Variant bs) (Variant ds) -> es)-      -> Variant as -> m es-{-# INLINE makeFlowOp #-}-makeFlowOp select apply combine v = combine <$> traverse apply (select v)---- | Make a flow operator-makeFlowOpM :: Monad m =>-      (Variant as -> Either (Variant bs) (Variant cs))-      -> (Variant cs -> Flow m ds)-      -> (Either (Variant bs) (Variant ds) -> es)-      -> Flow m as -> m es-{-# INLINE makeFlowOpM #-}-makeFlowOpM select apply combine v = v >>= makeFlowOp select apply combine----- | Select the first value-selectFirst :: Variant (x ': xs) -> Either (Variant xs) (Variant '[x])-{-# INLINE selectFirst #-}-selectFirst = fmap (toVariantAt @0) . popVariantHead---- | Select the tail-selectTail :: Variant (x ': xs) -> Either (Variant '[x]) (Variant xs)-{-# INLINE selectTail #-}-selectTail = flipEither . selectFirst-   where-      flipEither (Left x)  = Right x-      flipEither (Right x) = Left x---- | Select by type-selectType ::-   ( Popable x xs-   ) => Variant xs -> Either (Variant (Filter x xs)) (Variant '[x])-{-# INLINE selectType #-}-selectType = fmap (toVariantAt @0) . popVariant---- | Const application-applyConst :: Flow m ys -> (Variant xs -> Flow m ys)-{-# INLINE applyConst #-}-applyConst = const---- | Pure application-applyPure :: Monad m => (Variant xs -> Variant ys) -> Variant xs -> Flow m ys-{-# INLINE applyPure #-}-applyPure f = return . f---- | Lift a monadic function-applyM :: Monad m => (a -> m b) -> Variant '[a] -> Flow m '[b]-{-# INLINE applyM #-}-applyM = liftF---- | Lift a monadic function-applyVM :: Monad m => (Variant a -> m b) -> Variant a -> Flow m '[b]-{-# INLINE applyVM #-}-applyVM f = fmap (toVariantAt @0) . f---- | Lift a monadic function-applyF :: (a -> Flow m b) -> Variant '[a] -> Flow m b-{-# INLINE applyF #-}-applyF f = f . variantToValue---- | Set the first value (the "correct" one)-combineFirst :: forall x xs. Either (Variant xs) (Variant '[x]) -> Variant (x ': xs)-{-# INLINE combineFirst #-}-combineFirst = \case-   Right x -> appendVariant  @xs x-   Left xs -> prependVariant @'[x] xs---- | Set the first value, keep the same tail type -combineSameTail :: forall x xs.-   Either (Variant xs) (Variant (x ': xs)) -> Variant (x ': xs)-{-# INLINE combineSameTail #-}-combineSameTail = \case-   Right x -> x-   Left xs -> prependVariant @'[x] xs---- | Return the valid variant unmodified-combineEither :: Either (Variant xs) (Variant xs) -> Variant xs-{-# INLINE combineEither #-}-combineEither = \case-   Right x -> x-   Left x  -> x---- | Concatenate unselected values-combineConcat :: forall xs ys.-   ( KnownNat (Length xs)-   ) => Either (Variant ys) (Variant xs) -> Variant (Concat xs ys)-{-# INLINE combineConcat #-}-combineConcat = \case-   Right xs -> appendVariant  @ys xs-   Left ys  -> prependVariant @xs ys---- | Union-combineUnion ::-   ( Liftable xs (Union xs ys)-   , Liftable ys (Union xs ys)-   ) => Either (Variant ys) (Variant xs) -> Variant (Union xs ys)-{-# INLINE combineUnion #-}-combineUnion = \case-   Right xs -> liftVariant xs-   Left  ys -> liftVariant ys---- | Lift unselected-combineLiftUnselected ::-   ( Liftable ys xs-   ) => Either (Variant ys) (Variant xs) -> Variant xs-{-# INLINE combineLiftUnselected #-}-combineLiftUnselected = \case-   Right xs -> xs-   Left ys  -> liftVariant ys---- | Lift both-combineLiftBoth ::-   ( Liftable ys zs-   , Liftable xs zs-   ) => Either (Variant ys) (Variant xs) -> Variant zs-{-# INLINE combineLiftBoth #-}-combineLiftBoth = \case-   Right xs -> liftVariant xs-   Left ys  -> liftVariant ys---- | Single value-combineSingle :: Either (Variant '[x]) (Variant '[x]) -> x-{-# INLINE combineSingle #-}-combineSingle = \case-   Right x -> variantToValue x-   Left  x -> variantToValue x----- | Lift a pure function into a Variant to Variant function-liftV :: (a -> b) -> Variant '[a] -> Variant '[b]-liftV = updateVariantAt @0---- | Lift a function into a Flow-liftF :: Monad m => (a -> m b) -> Variant '[a] -> Flow m '[b]-liftF = updateVariantFirstM @0+-- | Control-flow+module Haskus.Utils.Flow+   ( MonadIO (..)+   , MonadInIO (..)+   -- * Basic operators+   , (|>)+   , (<|)+   , (||>)+   , (<||)+   -- * Monadic/applicative operators+   , when+   , unless+   , whenM+   , unlessM+   , ifM+   , guard+   , void+   , forever+   , foldM+   , foldM_+   , forM+   , forM_+   , mapM+   , mapM_+   , sequence+   , replicateM+   , replicateM_+   , filterM+   , join+   , (<=<)+   , (>=>)+   , loopM+   , whileM+   -- * Variant based operators+   , module Haskus.Utils.Variant.Flow+   )+where++import Haskus.Utils.Variant+import Haskus.Utils.Variant.Flow+import Haskus.Utils.Monad++-- | Apply a function+(|>) :: a -> (a -> b) -> b+{-# INLINE (|>) #-}+x |> f = f x++infixl 0 |>++-- | Apply a function+(<|) :: (a -> b) -> a -> b+{-# INLINE (<|) #-}+f <| x = f x++infixr 0 <|++-- | Apply a function in a Functor+(||>) :: Functor f => f a -> (a -> b) -> f b+{-# INLINE (||>) #-}+x ||> f = fmap f x++infixl 0 ||>++-- | Apply a function in a Functor+(<||) :: Functor f => (a -> b) -> f a -> f b+{-# INLINE (<||) #-}+f <|| x = fmap f x++infixr 0 <||

@@ -1,252 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE StandaloneDeriving #-}---- | Heterogeneous list utils-module Haskus.Utils.HList-   ( HList (..)-   , hHead-   , hTail-   , hLength-   , hAppend-   , HFoldr' (..)-   , HFoldl' (..)-   , HTuple' (..)-   , Apply (..)-   , HZipList-   , hZipList-   , HFoldr-   , hFoldr-   , HFoldl-   , hFoldl-   , HReverse (..)-   )-where--import Haskus.Utils.Tuple-import Haskus.Utils.Types-import Haskus.Utils.Types.List---- | Heterogeneous list-data family HList (l :: [*])-data instance HList '[]       = HNil-data instance HList (x ': xs) = x `HCons` HList xs--infixr 2 `HCons`--deriving instance Eq (HList '[])-deriving instance (Eq x, Eq (HList xs)) => Eq (HList (x ': xs))--deriving instance Ord (HList '[])-deriving instance (Ord x, Ord (HList xs)) => Ord (HList (x ': xs))---instance Show (HList '[]) where-    show _ = "H[]"--instance (Show e, Show (HList l)) => Show (HList (e ': l)) where-    show (HCons x l) = let 'H':'[':s = show l-                       in "H[" ++ show x ++-                                  (if s == "]" then s else "," ++ s)---- | Head-hHead :: HList (e ': l) -> e-hHead (HCons x _) = x---- | Tail-hTail :: HList (e ': l) -> HList l-hTail (HCons _ l) = l---- | Length-hLength :: forall xs. (KnownNat (Length xs)) => HList xs -> Word-hLength _ = natValue' @(Length xs)--class HAppendList l1 l2 where-  hAppend :: HList l1 -> HList l2 -> HList (Concat l1 l2)--instance HAppendList '[] l2 where-  hAppend HNil l = l--instance HAppendList l l' => HAppendList (x ': l) l' where-  hAppend (HCons x l) l' = HCons x (hAppend l l')----- | Apply the function identified by the data type f from type a to type b.-class Apply f a b where-  apply :: f -> a -> b------------------------------------------- Folding-----------------------------------------class HFoldr f v (l :: [*]) r where-    hFoldr :: f -> v -> HList l -> r--instance (v ~ v') => HFoldr f v '[] v' where-    hFoldr _ v _   = v--instance-      ( Apply f (e, r) r'-      , HFoldr f v l r-      ) => HFoldr f v (e ': l) r'-   where-      hFoldr f v (HCons x l)    = apply f (x, hFoldr f v l :: r)----- | Like HFoldr but only use types, not values!------ It allows us to foldr over a list of types, without any associated hlist of--- values.-class HFoldr' f v (l :: [*]) r where-   hFoldr' :: f -> v -> HList l -> r--instance (v ~ v') => HFoldr' f v '[] v' where-   hFoldr' _ v _   = v--instance-      ( Apply f (e, r) r'-      , HFoldr' f v l r-      ) => HFoldr' f v (e ': l) r'-   where-      -- compared to hFoldr, we pass undefined values instead of the values-      -- supposedly in the list (we don't have a real list associated to HList l)-      hFoldr' f v _ = apply f (undefined :: e, hFoldr' f v (undefined :: HList l) :: r)--class HFoldl f (z :: *) xs (r :: *) where-    hFoldl :: f -> z -> HList xs -> r--instance forall f z z' r x zx xs.-      ( zx ~ (z,x)-      , Apply f zx z'-      , HFoldl f z' xs r-      ) => HFoldl f z (x ': xs) r-   where-      hFoldl f z (x `HCons` xs) = hFoldl f (apply f (z,x) :: z') xs--instance (z ~ z') => HFoldl f z '[] z' where-    hFoldl _ z _ = z---- | Like HFoldl but only use types, not values!------ It allows us to foldr over a list of types, without any associated hlist of--- values.-class HFoldl' f (z :: *) xs (r :: *) where-    hFoldl' :: f -> z -> HList xs -> r--instance forall f z z' r x zx xs.-      ( zx ~ (z,x)-      , Apply f zx z'-      , HFoldl' f z' xs r-      ) => HFoldl' f z (x ': xs) r-   where-      hFoldl' f z (_ `HCons` xs) = hFoldl' f (apply f (z,(undefined :: x)) :: z') xs--instance (z ~ z') => HFoldl' f z '[] z' where-   hFoldl' _ z _ = z----class HZipList x y l | x y -> l, l -> x y where-   hZipList   :: HList x -> HList y -> HList l-   hUnzipList :: HList l -> (HList x, HList y)--instance HZipList '[] '[] '[] where-   hZipList _ _ = HNil-   hUnzipList _ = (HNil, HNil)--instance ((x,y)~z, HZipList xs ys zs) => HZipList (x ': xs) (y ': ys) (z ': zs) where-   hZipList (HCons x xs) (HCons y ys) = (x,y) `HCons` hZipList xs ys-   hUnzipList (HCons ~(x,y) zs) = let ~(xs,ys) = hUnzipList zs in (x `HCons` xs, y `HCons` ys)---class HRevApp l1 l2 l3 | l1 l2 -> l3 where-   hRevApp :: HList l1 -> HList l2 -> HList l3--instance HRevApp '[] l2 l2 where-   hRevApp _ l = l--instance HRevApp l (x ': l') z => HRevApp (x ': l) l' z where-   hRevApp (HCons x l) l' = hRevApp l (HCons x l')----class HReverse xs sx | xs -> sx, sx -> xs where-   hReverse :: HList xs -> HList sx--instance-      ( HRevApp xs '[] sx-      , HRevApp sx '[] xs-      ) => HReverse xs sx-   where-      hReverse l = hRevApp l HNil-------------------------------------------- Tuple convertion------------------------------------------- * Conversion to and from tuples---- | Convert between hlists and tuples-class HTuple' v t | v -> t, t -> v where-   -- | Convert an heterogeneous list into a tuple-   hToTuple'   :: HList v -> t-   -   -- | Convert a tuple into an heterogeneous list-   hFromTuple' :: t -> HList v---instance HTuple' '[] () where-    hToTuple' HNil = ()-    hFromTuple' () = HNil--instance HTuple' '[a] (Single a) where-    hToTuple' (a `HCons` HNil) = Single a-    hFromTuple' (Single a) = a `HCons` HNil--instance HTuple' '[a,b] (a,b) where-    hToTuple' (a `HCons` b `HCons` HNil) = (a,b)-    hFromTuple' (a,b) = a `HCons` b `HCons` HNil--instance HTuple' '[a,b,c] (a,b,c) where-    hToTuple' (a `HCons` b `HCons` c `HCons` HNil) = (a,b,c)-    hFromTuple' (a,b,c) = a `HCons` b `HCons` c `HCons` HNil--instance HTuple' '[a,b,c,d] (a,b,c,d) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` HNil) = (a,b,c,d)-    hFromTuple' (a,b,c,d) = a `HCons` b `HCons` c `HCons` d `HCons` HNil--instance HTuple' '[a,b,c,d,e] (a,b,c,d,e) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` HNil) = (a,b,c,d,e)-    hFromTuple' (a,b,c,d,e) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` HNil--instance HTuple' '[a,b,c,d,e,f] (a,b,c,d,e,f) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil) = (a,b,c,d,e,f)-    hFromTuple' (a,b,c,d,e,f) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil--instance HTuple' '[a,b,c,d,e,f,g] (a,b,c,d,e,f,g) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` HNil) = (a,b,c,d,e,f,g)-    hFromTuple' (a,b,c,d,e,f,g) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` HNil--instance HTuple' '[a,b,c,d,e,f,g,h] (a,b,c,d,e,f,g,h) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` HNil) = (a,b,c,d,e,f,g,h)-    hFromTuple' (a,b,c,d,e,f,g,h) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` HNil--instance HTuple' '[a,b,c,d,e,f,g,h,i] (a,b,c,d,e,f,g,h,i) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` HNil) = (a,b,c,d,e,f,g,h,i)-    hFromTuple' (a,b,c,d,e,f,g,h,i) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` HNil--instance HTuple' '[a,b,c,d,e,f,g,h,i,j] (a,b,c,d,e,f,g,h,i,j) where-    hToTuple' (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` j `HCons` HNil) = (a,b,c,d,e,f,g,h,i,j)-    hFromTuple' (a,b,c,d,e,f,g,h,i,j) = a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` g `HCons` h `HCons` i `HCons` j `HCons` HNil

@@ -1,16 +0,0 @@-module Haskus.Utils.List-   ( checkLength-   , module Data.List-   , module Data.List.Extra-   )-where--import Data.List-import Data.List.Extra---- | Check that a list has the given length (support infinite lists)-checkLength :: Word -> [a] -> Bool-checkLength 0 []     = True-checkLength 0 _      = False-checkLength _ []     = False-checkLength i (_:xs) = checkLength (i-1) xs

@@ -1,6 +0,0 @@-module Haskus.Utils.Map-   ( module Data.Map-   )-where--import Data.Map

@@ -1,7 +0,0 @@-module Haskus.Utils.Map.Strict-   ( module Data.Map.Strict-   )-where--import Data.Map.Strict-

@@ -1,32 +0,0 @@-{-# LANGUAGE LambdaCase #-}---- | Utils for Maybe data type-module Haskus.Utils.Maybe-   ( onNothing-   , onNothingM-   , fromMaybeM-   , headMaybe-   , module Data.Maybe-   )-where--import Data.Maybe---- | Flipped `fromMaybe`-onNothing :: Maybe a -> a -> a-onNothing = flip fromMaybe---- | Flipped `fromMaybeM`-onNothingM :: Monad m => m (Maybe a) -> m a -> m a-onNothingM = flip fromMaybeM---- | fromMaybe in a Monad-fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a-fromMaybeM v f = f >>= \case-   Nothing -> v-   Just x  -> return x---- | Get the head of the list if the latter is not empty-headMaybe :: [a] -> Maybe a-headMaybe []    = Nothing-headMaybe (x:_) = Just x

@@ -1,43 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TypeFamilies #-}---- | Utils for Monads-module Haskus.Utils.Monad-   ( MonadInIO (..)-   , module Control.Monad-   , module Control.Monad.IO.Class-   , module Control.Monad.Extra-   , module Control.Monad.Trans.Class-   )-where--import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad-import Control.Monad.Extra-import Control.Monad.State--class MonadIO m => MonadInIO m where-   -- | Lift with*-like functions into IO (alloca, etc.)-   liftWith :: (forall c. (a -> IO c) -> IO c) -> (a -> m b) -> m b--   -- | Lift with*-like functions into IO (alloca, etc.)-   liftWith2 :: (forall c. (a -> b -> IO c) -> IO c) -> (a -> b -> m e) -> m e--instance MonadInIO IO where-   {-# INLINE liftWith #-}-   liftWith = id--   {-# INLINE liftWith2 #-}-   liftWith2 = id--instance MonadInIO m => MonadInIO (StateT s m) where-   {-# INLINE liftWith #-}-   liftWith wth f =-      StateT $ \s -> do-         liftWith wth (\a -> runStateT (f a) s)--   {-# INLINE liftWith2 #-}-   liftWith2 wth f =-      StateT $ \s ->-         liftWith2 wth (\a b -> runStateT (f a b) s)

@@ -1,502 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}---- | Tuple helpers-module Haskus.Utils.Tuple-   ( uncurry3-   , uncurry4-   , take4-   , fromTuple4-   , module Data.Tuple-   , Single (..)-   , TupleToList-   , ListToTuple-   , ExtractTuple (..)-   , TupleHead (..)-   , TupleTail (..)-   , TupleCons (..)-   , ReorderTuple (..)-   )-where--import Data.Tuple-import Haskus.Utils.Types---- | Uncurry specialised for triple-uncurry3 :: (a -> b -> c -> e) -> (a,b,c) -> e-{-# INLINE uncurry3 #-}-uncurry3 f (a,b,c) = f a b c---- | Uncurry specialised for quadruple-uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e-{-# INLINE uncurry4 #-}-uncurry4 f (a,b,c,d) = f a b c d----- | Take specialised for quadruple-take4 :: [a] -> (a,a,a,a)-{-# INLINE take4 #-}-take4 [a,b,c,d] = (a,b,c,d)-take4 _         = error "take4: invalid list (exactly 4 elements required)"----- | toList for quadruple-fromTuple4 :: (a,a,a,a) -> [a]-{-# INLINE fromTuple4 #-}-fromTuple4 (a,b,c,d) = [a,b,c,d]---- | Singleton type-newtype Single a = Single a deriving (Show,Eq)---type family TupleToList t where-   TupleToList (Single a)                                            = '[a]-   TupleToList (a,b)                                                 = '[a,b]-   TupleToList (a,b,c)                                               = '[a,b,c]-   TupleToList (a,b,c,d)                                             = '[a,b,c,d]-   TupleToList (a,b,c,d,e)                                           = '[a,b,c,d,e]-   TupleToList (a,b,c,d,e,f)                                         = '[a,b,c,d,e,f]-   TupleToList (a,b,c,d,e,f,g)                                       = '[a,b,c,d,e,f,g]-   TupleToList (a,b,c,d,e,f,g,h)                                     = '[a,b,c,d,e,f,g,h]-   TupleToList (a,b,c,d,e,f,g,h,i)                                   = '[a,b,c,d,e,f,g,h,i]-   TupleToList (a,b,c,d,e,f,g,h,i,j)                                 = '[a,b,c,d,e,f,g,h,i,j]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k)                               = '[a,b,c,d,e,f,g,h,i,j,k]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l)                             = '[a,b,c,d,e,f,g,h,i,j,k,l]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m)                           = '[a,b,c,d,e,f,g,h,i,j,k,l,m]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n)                         = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)                       = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)                     = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)                   = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)                 = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)               = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)             = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)           = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)         = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)       = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)     = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)   = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y]-   TupleToList (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z]--type family ListToTuple t where-   ListToTuple '[a]                                                   = Single a-   ListToTuple '[a,b]                                                 = (a,b)-   ListToTuple '[a,b,c]                                               = (a,b,c)-   ListToTuple '[a,b,c,d]                                             = (a,b,c,d)-   ListToTuple '[a,b,c,d,e]                                           = (a,b,c,d,e)-   ListToTuple '[a,b,c,d,e,f]                                         = (a,b,c,d,e,f)-   ListToTuple '[a,b,c,d,e,f,g]                                       = (a,b,c,d,e,f,g)-   ListToTuple '[a,b,c,d,e,f,g,h]                                     = (a,b,c,d,e,f,g,h)-   ListToTuple '[a,b,c,d,e,f,g,h,i]                                   = (a,b,c,d,e,f,g,h,i)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j]                                 = (a,b,c,d,e,f,g,h,i,j)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k]                               = (a,b,c,d,e,f,g,h,i,j,k)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l]                             = (a,b,c,d,e,f,g,h,i,j,k,l)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m]                           = (a,b,c,d,e,f,g,h,i,j,k,l,m)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]                         = (a,b,c,d,e,f,g,h,i,j,k,l,m,n)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]                       = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]                     = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]                   = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]                 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]               = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]             = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]           = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]         = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]       = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]     = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y]   = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)-   ListToTuple '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)---- | Extract a tuple value statically-class ExtractTuple (n :: Nat) t x | n t -> x where-   -- | Extract a tuple value by type-level index-   tupleN :: t -> x--instance ExtractTuple 0 (Single t) t where-   {-# INLINE tupleN #-}-   tupleN (Single t) = t--instance ExtractTuple 0 (e0, e1) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_) = t--instance ExtractTuple 1 (e0, e1) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t) = t--instance ExtractTuple 0 (e0, e1, e2) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_) = t--instance ExtractTuple 1 (e0, e1, e2) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_) = t--instance ExtractTuple 2 (e0, e1, e2) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t) = t--instance ExtractTuple 0 (e0, e1, e2, e3) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_,_) = t--instance ExtractTuple 1 (e0, e1, e2, e3) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_,_) = t--instance ExtractTuple 2 (e0, e1, e2, e3) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t,_) = t--instance ExtractTuple 3 (e0, e1, e2, e3) e3 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,t) = t---instance ExtractTuple 0 (e0, e1, e2, e3, e4) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_,_,_) = t--instance ExtractTuple 1 (e0, e1, e2, e3, e4) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_,_,_) = t--instance ExtractTuple 2 (e0, e1, e2, e3, e4) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t,_,_) = t--instance ExtractTuple 3 (e0, e1, e2, e3, e4) e3 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,t,_) = t--instance ExtractTuple 4 (e0, e1, e2, e3, e4) e4 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,t) = t---instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_,_,_,_) = t--instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_,_,_,_) = t--instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t,_,_,_) = t--instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5) e3 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,t,_,_) = t--instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5) e4 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,t,_) = t--instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5) e5 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,t) = t---instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5, e6) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_,_,_,_,_) = t--instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5, e6) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_,_,_,_,_) = t--instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5, e6) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t,_,_,_,_) = t--instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5, e6) e3 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,t,_,_,_) = t--instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5, e6) e4 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,t,_,_) = t--instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5, e6) e5 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,t,_) = t--instance ExtractTuple 6 (e0, e1, e2, e3, e4, e5, e6) e6 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,_,t) = t---instance ExtractTuple 0 (e0, e1, e2, e3, e4, e5, e6, e7) e0 where-   {-# INLINE tupleN #-}-   tupleN (t,_,_,_,_,_,_,_) = t--instance ExtractTuple 1 (e0, e1, e2, e3, e4, e5, e6, e7) e1 where-   {-# INLINE tupleN #-}-   tupleN (_,t,_,_,_,_,_,_) = t--instance ExtractTuple 2 (e0, e1, e2, e3, e4, e5, e6, e7) e2 where-   {-# INLINE tupleN #-}-   tupleN (_,_,t,_,_,_,_,_) = t--instance ExtractTuple 3 (e0, e1, e2, e3, e4, e5, e6, e7) e3 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,t,_,_,_,_) = t--instance ExtractTuple 4 (e0, e1, e2, e3, e4, e5, e6, e7) e4 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,t,_,_,_) = t--instance ExtractTuple 5 (e0, e1, e2, e3, e4, e5, e6, e7) e5 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,t,_,_) = t--instance ExtractTuple 6 (e0, e1, e2, e3, e4, e5, e6, e7) e6 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,_,t,_) = t--instance ExtractTuple 7 (e0, e1, e2, e3, e4, e5, e6, e7) e7 where-   {-# INLINE tupleN #-}-   tupleN (_,_,_,_,_,_,_,t) = t---class TupleHead ts ts' | ts -> ts' where-   tupleHead :: ts -> ts'--instance TupleHead (Single a) a where-   {-# INLINE tupleHead #-}-   tupleHead (Single a) = a--instance TupleHead (a,b) a where-   {-# INLINE tupleHead #-}-   tupleHead (a,_) = a--instance TupleHead (a,b,c) a where-   {-# INLINE tupleHead #-}-   tupleHead (a,_,_) = a--instance TupleHead (a,b,c,d) a where-   {-# INLINE tupleHead #-}-   tupleHead (a,_,_,_) = a--instance TupleHead (a,b,c,d,e) a where-   {-# INLINE tupleHead #-}-   tupleHead (a,_,_,_,_) = a--instance TupleHead (a,b,c,d,e,f) a where-   {-# INLINE tupleHead #-}-   tupleHead (a,_,_,_,_,_) = a---class TupleTail ts ts' | ts -> ts' where-   tupleTail :: ts -> ts'--instance TupleTail (a,b) (Single b) where-   {-# INLINE tupleTail #-}-   tupleTail (_,b) = Single b--instance TupleTail (a,b,c) (b,c) where-   {-# INLINE tupleTail #-}-   tupleTail (_,b,c) = (b,c)--instance TupleTail (a,b,c,d) (b,c,d) where-   {-# INLINE tupleTail #-}-   tupleTail (_,b,c,d) = (b,c,d)--instance TupleTail (a,b,c,d,e) (b,c,d,e) where-   {-# INLINE tupleTail #-}-   tupleTail (_,b,c,d,e) = (b,c,d,e)--instance TupleTail (a,b,c,d,e,f) (b,c,d,e,f) where-   {-# INLINE tupleTail #-}-   tupleTail (_,b,c,d,e,f) = (b,c,d,e,f)----class TupleCons t ts ts' | t ts -> ts' where-   tupleCons :: t -> ts -> ts'--instance TupleCons a (Single b) (a,b) where-   {-# INLINE tupleCons #-}-   tupleCons a (Single b) = (a,b)--instance TupleCons a (b,c) (a,b,c) where-   {-# INLINE tupleCons #-}-   tupleCons a (b,c) = (a,b,c)--instance TupleCons a (b,c,d) (a,b,c,d) where-   {-# INLINE tupleCons #-}-   tupleCons a (b,c,d) = (a,b,c,d)--instance TupleCons a (b,c,d,e) (a,b,c,d,e) where-   {-# INLINE tupleCons #-}-   tupleCons a (b,c,d,e) = (a,b,c,d,e)--instance TupleCons a (b,c,d,e,f) (a,b,c,d,e,f) where-   {-# INLINE tupleCons #-}-   tupleCons a (b,c,d,e,f) = (a,b,c,d,e,f)----- | Reorder tuple elements-class ReorderTuple t1 t2 where-   -- | Reorder tuple elements-   tupleReorder :: t1 -> t2---instance ReorderTuple (Single a) (Single a) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b) (a,b) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c) (a,b,c) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d) (a,b,c,d) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e) (a,b,c,d,e) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e,f) (a,b,c,d,e,f) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e,f,g) (a,b,c,d,e,f,g) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g,h) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h,i) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id--instance ReorderTuple (a,b,c,d,e,f,g,h,i,j) (a,b,c,d,e,f,g,h,i,j) where-   {-# INLINE tupleReorder #-}-   tupleReorder = id---instance ReorderTuple (a,b) (b,a) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b) = (b,a)--instance ReorderTuple (a,b,c) (a,c,b) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c) = (a,c,b)--instance ReorderTuple (a,b,c) (b,a,c) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c) = (b,a,c)--instance ReorderTuple (a,b,c) (b,c,a) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c) = (b,c,a)--instance ReorderTuple (a,b,c) (c,a,b) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c) = (c,a,b)--instance ReorderTuple (a,b,c) (c,b,a) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c) = (c,b,a)--instance ReorderTuple (b,c,d) (x,y,z) => ReorderTuple (a,b,c,d) (a,x,y,z) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (b,c,d) in (a,x,y,z)--instance ReorderTuple (a,c,d) (x,y,z) => ReorderTuple (a,b,c,d) (x,b,y,z) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,c,d) in (x,b,y,z)--instance ReorderTuple (a,b,d) (x,y,z) => ReorderTuple (a,b,c,d) (x,y,c,z) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,b,d) in (x,y,c,z)--instance ReorderTuple (a,b,c) (x,y,z) => ReorderTuple (a,b,c,d) (x,y,z,d) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d) = let (x,y,z) = tupleReorder (a,b,c) in (x,y,z,d)--instance ReorderTuple (b,c,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (a,x,y,z,w) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (b,c,d,e) in (a,x,y,z,w)--instance ReorderTuple (a,c,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,b,y,z,w) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,c,d,e) in (x,b,y,z,w)--instance ReorderTuple (a,b,d,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,c,z,w) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,d,e) in (x,y,c,z,w)--instance ReorderTuple (a,b,c,e) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,z,d,w) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,c,e) in (x,y,z,d,w)--instance ReorderTuple (a,b,c,d) (x,y,z,w) => ReorderTuple (a,b,c,d,e) (x,y,z,w,e) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e) = let (x,y,z,w) = tupleReorder (a,b,c,d) in (x,y,z,w,e)--instance ReorderTuple (b,c,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (a,x,y,z,w,v) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (b,c,d,e,f) in (a,x,y,z,w,v)--instance ReorderTuple (a,c,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,b,y,z,w,v) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,c,d,e,f) in (x,b,y,z,w,v)--instance ReorderTuple (a,b,d,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,c,z,w,v) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,d,e,f) in (x,y,c,z,w,v)--instance ReorderTuple (a,b,c,e,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,d,w,v) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,e,f) in (x,y,z,d,w,v)--instance ReorderTuple (a,b,c,d,f) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,w,e,v) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,d,f) in (x,y,z,w,e,v)--instance ReorderTuple (a,b,c,d,e) (x,y,z,w,v) => ReorderTuple (a,b,c,d,e,f) (x,y,z,w,v,f) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f) = let (x,y,z,w,v) = tupleReorder (a,b,c,d,e) in (x,y,z,w,v,f)---instance ReorderTuple (b,c,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (a,x,y,z,w,v,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (b,c,d,e,f,g) in (a,x,y,z,w,v,u)--instance ReorderTuple (a,c,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,b,y,z,w,v,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,c,d,e,f,g) in (x,b,y,z,w,v,u)--instance ReorderTuple (a,b,d,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,c,z,w,v,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,d,e,f,g) in (x,y,c,z,w,v,u)--instance ReorderTuple (a,b,c,e,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,d,w,v,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,e,f,g) in (x,y,z,d,w,v,u)--instance ReorderTuple (a,b,c,d,f,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,e,v,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,f,g) in (x,y,z,w,e,v,u)--instance ReorderTuple (a,b,c,d,e,g) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,v,f,u) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,e,g) in (x,y,z,w,v,f,u)--instance ReorderTuple (a,b,c,d,e,f) (x,y,z,w,v,u) => ReorderTuple (a,b,c,d,e,f,g) (x,y,z,w,v,u,g) where-   {-# INLINE tupleReorder #-}-   tupleReorder (a,b,c,d,e,f,g) = let (x,y,z,w,v,u) = tupleReorder (a,b,c,d,e,f) in (x,y,z,w,v,u,g)

@@ -1,93 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE PolyKinds #-}---- | Common type functions-module Haskus.Utils.Types-   ( Nat-   , Symbol-   , natValue-   , natValue'-   , symbolValue-   , KnownNat-   , KnownSymbol-   , CmpNat-   , CmpSymbol-   , type (<=?)-   , type (<=)-   , type (+)-   , type (-)-   , type (*)-   , type (^)-   , Assert-   , If-   , Modulo-   , Same-   , Proxy (..)-   , TypeError-   , ErrorMessage (..)-   )-where--import GHC.TypeLits-import Data.Proxy---- | Get a Nat value-natValue :: forall (n :: Nat) a. (KnownNat n, Num a) => a-{-# INLINE natValue #-}-natValue = fromIntegral (natVal (Proxy :: Proxy n))---- | Get a Nat value-natValue' :: forall (n :: Nat). KnownNat n => Word-{-# INLINE natValue' #-}-natValue' = natValue @n---- | Get a Symbol value-symbolValue :: forall (s :: Symbol). (KnownSymbol s) => String-{-# INLINE symbolValue #-}-symbolValue = symbolVal (Proxy :: Proxy s)---- | If-then-else-type family If (c :: Bool) (t :: k) (e :: k) where-   If 'True  t e = t-   If 'False t e = e----- | Like: If cond t (TypeError msg)------ The difference is that the TypeError doesn't appear in the RHS of the type--- which lead to better error messages (see GHC #14771).------ For instance:---    type family F n where---       F n = If (n <=? 8) Int8 (TypeError (Text "ERROR"))------    type family G n where---       G n = Assert (n <=? 8) Int8 (Text "ERROR")------    If GHC cannot solve `F n ~ Word`, it shows: ERROR---    If GHC cannot solve `G n ~ Word`, it shows:---       can't match `Assert...` with `Word`----type family Assert (prop :: Bool) (val :: k) (msg :: ErrorMessage) where-   Assert 'True  val msg = val-   Assert 'False val msg = TypeError msg---- | Modulo-type family Modulo (a :: Nat) (b :: Nat) where-   Modulo a b = Modulo' (a <=? b) a b---- | Helper for Modulo-type family Modulo' c a b where-   Modulo' 'True  a b = a-   Modulo' 'False a b = Modulo' ((a-b) <=? b) (a-b) b---- | Type equality to Nat-type family Same a b :: Nat where-   Same a a = 1-   Same a b = 0

@@ -1,75 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE UndecidableInstances #-}---- | Generics-module Haskus.Utils.Types.Generics-   ( module GHC.Generics-   -- * Fields-   , Field-   , FieldType-   , LookupField-   , LookupFieldType-   -- * Data type fields-   , ExtractFields-   , ExtractFieldTypes-   )-where--import Haskus.Utils.Types.List-import Haskus.Utils.Types-import GHC.Generics---- | Named field-data Field (name :: Symbol) (t :: *)--type family FieldType f where-   FieldType (Field name t) = t--type family LookupFieldType fs s where-   LookupFieldType fs s = FieldType (LookupField fs s)--type family LookupField (fs :: [*]) (s :: Symbol) where-   LookupField (Field name t ': fs) name = Field name t-   LookupField (Field name t ': fs) s    = LookupField fs s-   LookupField '[]                  name =-      TypeError ('Text "Cannot find field with name: " ':<>: 'ShowType name)----- | Extract fields of a data type:---    - require selector symbols---    - only support data type with a single constructor-type family ExtractFields (a :: *)  where-   ExtractFields a = ExtractFields' (Rep a)--type family ExtractFields' a where-   -- extract constructors-   ExtractFields' (D1 _ cs)   = ExtractFields' cs--   -- extract selectors-   ExtractFields' (C1 _ ss)   = ExtractFields' ss-   ExtractFields' (s1 :*: s2) = Concat (ExtractFields' s1) (ExtractFields' s2)--   -- extract field name and type from the selector-   ExtractFields' (S1 ('MetaSel ('Just name) _ _ _) (Rec0 t)) = '[Field name t]------ | Extract types of the fields of a data type---    - only support data type with a single constructor-type family ExtractFieldTypes (a :: *)  where-   ExtractFieldTypes a = ExtractFieldTypes' (Rep a)--type family ExtractFieldTypes' a where-   -- extract constructors-   ExtractFieldTypes' (D1 _ cs)   = ExtractFieldTypes' cs--   -- extract selectors-   ExtractFieldTypes' (C1 _ ss)   = ExtractFieldTypes' ss-   ExtractFieldTypes' (s1 :*: s2) =-      Concat (ExtractFieldTypes' s1) (ExtractFieldTypes' s2)--   -- extract field type from the selector-   ExtractFieldTypes' (S1 _ (Rec0 t)) = '[t]

@@ -1,314 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds #-}---- | Utils for type lists-module Haskus.Utils.Types.List-   ( Map-   , Max-   , Tail-   , Drop-   , Take-   , Init-   , Head-   , Snoc-   , InsertAt-   , ReplaceAt-   , Replace-   , ReplaceN-   , ReplaceNS-   , Reverse-   , RemoveAt-   , RemoveAt1-   , RemoveAtN-   , Concat-   , Length-   , Replicate-   , MapMaybe-   , Generate-   , IsMember-   , IsSubset-   , Indexes-   , MapTest-   , Zip-   , Filter-   , Nub-   , NubHead-   , IndexOf-   , IndexesOf-   , MaybeIndexOf-   , Index-   , Union-   , Member-   , CheckNub-   )-where--import Haskus.Utils.Types---- | Map a type function-type family Map (f :: a -> k) (xs :: [a]) where-   Map f '[]       = '[]-   Map f (x ': xs) = f x ': Map f xs---- | Get the max of a list of Nats-type family Max (xs :: [Nat]) where-   Max (x ': xs) = Max' x xs---- | Helper for Max-type family Max' (x :: Nat) (xs :: [Nat]) where-   Max' x '[]       = x-   Max' x (a ': xs) = Max' (If (x <=? a) a x) xs---- | Tail of a list-type family Tail (xs :: [*]) where-   Tail (x ': xs) = xs---- | Drop elements in a list-type family Drop (n :: Nat) (xs :: [*]) where-   Drop 0 xs        = xs-   Drop n (x ': xs) = Drop (n-1) xs---- | Take elements in a list-type family Take (n :: Nat) (xs :: [*]) where-   Take 0 xs        = '[]-   Take n (x ': xs) = x ': (Take (n-1) xs)---- | Init of a list-type family Init (xs :: [*]) where-   Init '[x]      = '[]-   Init (x ': xs) = x ': (Init xs)---- | Snoc-type family Snoc (xs :: [*]) x where-   Snoc '[] x       = '[x]-   Snoc (y ': ys) x = y ': (Snoc ys x)---- | Head of a list-type family Head (xs :: [*]) where-   Head (x ': xs) = x---- | Concat two type lists-type family Concat (xs :: [*]) (ys :: [*]) where-   Concat '[] '[]      = '[]-   Concat '[] ys       = ys-   Concat (x ': xs) ys = x ': Concat xs ys---- | Get list length-type family Length xs where-   Length xs = Length' 0 xs--type family Length' n xs where-   Length' n '[]       = n-   Length' n (x ': xs) = Length' (n+1) xs---- | Replicate-type family Replicate n s where-   Replicate n s = Replicate' s n '[]--type family Replicate' x n xs where-   Replicate' x 0 xs = xs-   Replicate' x n xs = Replicate' x (n-1) (x ': xs)---- | Insert a list at n-type family InsertAt (n :: Nat) l l2 where-   InsertAt 0 xs ys        = Concat ys xs-   InsertAt n (x ': xs) ys = x ': InsertAt (n-1) xs ys---- | replace l[n] with l2 (folded)-type family ReplaceAt (n :: Nat) l l2 where-   ReplaceAt 0 (x ': xs) ys = Concat ys xs-   ReplaceAt n (x ': xs) ys = x ': ReplaceAt (n-1) xs ys---- | replace a type by another in l-type family Replace t1 t2 l where-   Replace t1 t2 '[]        = '[]-   Replace t1 t2 (t1 ': xs) = t2 ': (Replace t1 t2 xs)-   Replace t1 t2 (x ': xs)  = x ': (Replace t1 t2 xs)---- | replace a type at offset n in l-type family ReplaceN n t l where-   ReplaceN 0 t (x ': xs)  = (t ': xs)-   ReplaceN n t (x ': xs)  = x ': ReplaceN (n-1) t xs---- | replace types at offsets ns in l-type family ReplaceNS ns t l where-   ReplaceNS '[] t l       = l-   ReplaceNS (i ': is) t l = ReplaceNS is t (ReplaceN i t l)---- | Reverse a list-type family Reverse (l :: [*]) where-   Reverse l = Reverse' l '[]--type family Reverse' (l :: [*]) (l2 :: [*]) where-   Reverse' '[] l       = l-   Reverse' (x ': xs) l = Reverse' xs (x ': l)----- | Remove a type at index-type family RemoveAt (n :: Nat) l where-   RemoveAt 0 (x ': xs) = xs-   RemoveAt n (x ': xs) = x ': RemoveAt (n-1) xs---- | Remove a type at index (0 == don't remove)-type family RemoveAt1 (n :: Nat) l where-   RemoveAt1 0 xs        = xs-   RemoveAt1 1 (x ': xs) = xs-   RemoveAt1 n (x ': xs) = x ': RemoveAt1 (n-1) xs---- | Remove types at several indexes-type family RemoveAtN (ns :: [Nat]) l where-   RemoveAtN '[] xs       = xs-   RemoveAtN (i ': is) xs = RemoveAtN is (RemoveAt i xs)---- | Apply Maybe to all the elements of the list-type family MapMaybe l where-   MapMaybe '[]       = '[]-   MapMaybe (x ': xs) = Maybe x ': MapMaybe xs---- | Generate a list of Nat [n..m-1]-type family Generate (n :: Nat) (m :: Nat) :: [Nat] where-   Generate n n = '[]-   Generate n m = n ': Generate (n+1) m---- | Check that a type is member of a type list-type family IsMember a (l :: [*]) :: Bool where-   IsMember a l = IsMember' l a l---- | Check that a type is member of a type list-type family IsMember' (i :: [*]) a (l :: [*]) :: Bool where-   IsMember' i a (a ': l) = 'True-   IsMember' i a (b ': l) = IsMember' i a l-   IsMember' i a '[]      = TypeError ( 'Text "`"-                                   ':<>: 'ShowType a-                                   ':<>: 'Text "'"-                                   ':<>: 'Text " is not a member of "-                                   ':<>: 'ShowType i)----- | Check that a list is a subset of another-type family IsSubset l1 l2 :: Bool where-   IsSubset l1 l1 = 'True-   IsSubset l1 l2 = IsSubset' l2 l1 l2---- | Helper for IsSubset-type family IsSubset' i l1 l2 :: Bool where-   IsSubset' i '[] l2 = 'True-   IsSubset' i l1 '[] = TypeError (     'ShowType l1-                                   ':$$: 'Text "is not a subset of"-                                   ':$$: 'ShowType i)-   IsSubset' i (x ': xs) (x ': ys) = IsSubset' i xs i-   IsSubset' i (x ': xs) (y ': ys) = IsSubset' i (x ': xs) ys---- | Get list indexes-type family Indexes (l :: [*]) where-   Indexes xs      = IndexesFrom 0 xs--type family IndexesFrom (n :: Nat) (xs :: [*]) where-   IndexesFrom n '[]       = '[]-   IndexesFrom n (x ': xs) = Proxy n ': IndexesFrom (n+1) xs---- | Map to 1 if type equality, 0 otherwise-type family MapTest a (l :: [*]) where-   MapTest a '[]       = '[]-   MapTest a (a ': xs) = Proxy 1 ': MapTest a xs-   MapTest a (x ': xs) = Proxy 0 ': MapTest a xs---- | Zip two lists-type family Zip (l :: [*]) (l2 :: [*]) where-   Zip '[] xs              = '[]-   Zip xs '[]              = '[]-   Zip (x ': xs) (y ': ys) = (x,y) ': Zip xs ys---- | Remove `a` in `l`-type family Filter a (l :: [*]) where-   Filter a '[]       = '[]-   Filter a (a ': as) = Filter a as-   Filter a (b ': as) = b ': Filter a as---- | Keep only a single value of each type-type family Nub (l :: [*]) where-   Nub xs = Reverse (Nub' xs '[])--type family Nub' as xs where-   Nub' '[]       xs = xs-   Nub' (x ': as) xs = Nub' (Filter x as) (x ': xs) ---- | Keep only a single value of the head type-type family NubHead (l :: [*]) where-   NubHead '[]       = '[]-   NubHead (x ': xs) = x ': Filter x xs---- | Get the first index of a type-type family IndexOf a (l :: [*]) :: Nat where-   IndexOf x xs = IndexOf' x xs xs---- | Get the first index of a type-type family IndexOf' a (l :: [*]) (l2 :: [*]) :: Nat where-   IndexOf' x (x ': xs) l2 = 0-   IndexOf' y (x ': xs) l2 = 1 + IndexOf' y xs l2-   IndexOf' y '[]       l2 = TypeError ( 'Text "`"-                                    ':<>: 'ShowType y-                                    ':<>: 'Text "'"-                                    ':<>: 'Text " is not a member of "-                                    ':<>: 'ShowType l2)---- | Get all the indexes of a type-type family IndexesOf a (l :: [*]) :: [Nat] where-   IndexesOf x xs = IndexesOf' 0 x xs---- | Get the first index of a type-type family IndexesOf' n a (l :: [*]) :: [Nat] where-   IndexesOf' n x '[]       = '[]-   IndexesOf' n x (x ': xs) = n ': IndexesOf' (n+1) x xs-   IndexesOf' n x (y ': xs) = IndexesOf' (n+1) x xs---- | Get the first index (starting from 1) of a type or 0 if none-type family MaybeIndexOf a (l :: [*]) where-   MaybeIndexOf x xs = MaybeIndexOf' 0 x xs---- | Helper for MaybeIndexOf-type family MaybeIndexOf' (n :: Nat) a (l :: [*]) where-   MaybeIndexOf' n x '[]       = 0-   MaybeIndexOf' n x (x ': xs) = 1 + n-   MaybeIndexOf' n x (y ': xs) = MaybeIndexOf' (n+1) x xs---- | Indexed access into the list-type family Index (n :: Nat) (l :: [*]) where-   Index 0 (x ': xs) = x-   Index n (x ': xs) = Index (n-1) xs---- | Union two lists-type family Union (xs :: [*]) (ys :: [*]) where-   Union xs ys = Nub (Concat xs ys)------------------------------------------- Constraints------------------------------------------- | Constraint: x member of xs-type Member x xs =-   ( IsMember x xs ~ 'True-   , x ~ Index (IndexOf x xs) xs-   , KnownNat (IndexOf x xs)-   )---- | Check that a list only contain a value of each type-type CheckNub (l :: [*]) =-   ( CheckNubEx l (Nub l) ~ 'True-   )--type family CheckNubEx (l1 :: [*]) (l2 :: [*]) where-   CheckNubEx l l   = 'True-   CheckNubEx l1 l2 = TypeError-      ( 'Text "Type-list contains unallowed redundant types."-      ':$$: 'Text "Got: "      ':<>: 'ShowType l1-      ':$$: 'Text "Expected: " ':<>: 'ShowType l2-      )-

@@ -1,1162 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE RoleAnnotations #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}---- | Open sum type-module Haskus.Utils.Variant-   ( Variant-   , V-   , variantIndex-   -- * Patterns-   , pattern V-   , pattern VMaybe-   -- * Operations by index-   , toVariantAt-   , toVariantHead-   , toVariantTail-   , fromVariantAt-   , popVariantAt-   , popVariantHead-   , updateVariantAt-   , foldMapVariantAt-   , foldMapVariantAtM-   -- * Operations by type-   , toVariant-   , Member-   , Filter-   , Popable-   , MaybePopable-   , popVariant-   , popVariantMaybe-   , fromVariant-   , fromVariantMaybe-   , fromVariantFirst-   , updateVariantFirst-   , updateVariantFirstM-   , MappableVariant-   , mapVariant-   , foldMapVariantFirst-   , foldMapVariantFirstM-   , foldMapVariant-   -- * Generic operations with type classes-   , AlterVariant (..)-   , TraverseVariant (..)-   , NoConstraint-   , alterVariant-   , traverseVariant-   , traverseVariant_-   -- * Conversions between variants-   , appendVariant-   , prependVariant-   , Liftable-   , liftVariant-   , nubVariant-   -- * Conversions to/from other data types-   , variantToValue-   , variantToEither-   , variantFromEither-   , variantToHList-   , variantToTuple-   -- ** Continuations-   , ContVariant (..)-   )-where--import Unsafe.Coerce-import GHC.Exts (Any,Constraint)--import Haskus.Utils.Monad-import Haskus.Utils.Types-import Haskus.Utils.Tuple-import Haskus.Utils.HList-import Haskus.Utils.ContFlow-import Haskus.Utils.Types.List---- | A variant contains a value whose type is at the given position in the type--- list-data Variant (l :: [*]) = Variant {-# UNPACK #-} !Word Any--type V = Variant---- | Make GHC consider `l` as a representational parameter to make coercions--- between Variant values unsafe-type role Variant representational---- | Pattern synonym for Variant------ Usage: case v of---          V (x :: Int)    -> ...---          V (x :: String) -> ...-pattern V :: forall c cs. Popable c cs => c -> Variant cs-pattern V x <- (fromVariant -> Just x)-   where-      V x = toVariant x---- | Statically unchecked matching on a Variant-pattern VMaybe :: forall c cs. (MaybePopable c cs) => c -> Variant cs-pattern VMaybe x <- (fromVariantMaybe -> Just x)--instance Eq (Variant '[]) where-   (==) = error "Empty variant"--instance-   ( Eq (Variant xs)-   , Eq x-   ) => Eq (Variant (x ': xs))-   where-      {-# INLINE (==) #-}-      (==) v1@(Variant t1 _) v2@(Variant t2 _)-         | t1 /= t2  = False-         | otherwise = case (popVariantHead v1, popVariantHead v2) of-            (Right a, Right b) -> a == b-            (Left as, Left bs) -> as == bs-            _                  -> False--instance Ord (Variant '[]) where-   compare = error "Empty variant"--instance-   ( Ord (Variant xs)-   , Ord x-   ) => Ord (Variant (x ': xs))-   where-      compare v1 v2 = case (popVariantHead v1, popVariantHead v2) of-         (Right a, Right b) -> compare a b-         (Left as, Left bs) -> compare as bs-         (Right _, Left _)  -> LT-         (Left _, Right _)  -> GT--instance Show (Variant '[]) where-   show = error "Empty variant"--instance-   ( Show (Variant xs)-   , Show x-   ) => Show (Variant (x ': xs))-   where-      show v = case popVariantHead v of-         Right x -> show x-         Left xs -> show xs---------------------------------------------------------------- Operations by index---------------------------------------------------------------- | Get Variant index-variantIndex :: Variant a -> Word-variantIndex (Variant n _) = n---- | Set the value with the given indexed type-toVariantAt :: forall (n :: Nat) (l :: [*]).-   ( KnownNat n-   ) => Index n l -> Variant l-{-# INLINE toVariantAt #-}-toVariantAt a = Variant (natValue' @n) (unsafeCoerce a)---- | Set the first value-toVariantHead :: forall x xs. x -> Variant (x ': xs)-{-# INLINE toVariantHead #-}-toVariantHead a = Variant 0 (unsafeCoerce a)---- | Set the tail-toVariantTail :: forall x xs. Variant xs -> Variant (x ': xs)-{-# INLINE toVariantTail #-}-toVariantTail (Variant t a) = Variant (t+1) a---- | Get the value if it has the indexed type-fromVariantAt :: forall (n :: Nat) (l :: [*]).-   ( KnownNat n-   ) => Variant l -> Maybe (Index n l)-{-# INLINE fromVariantAt #-}-fromVariantAt (Variant t a) = do-   guard (t == natValue' @n)-   return (unsafeCoerce a) -- we know it is the effective type---- | Pop a variant value by index, return either the value or the remaining--- variant-popVariantAt :: forall (n :: Nat) l. -   ( KnownNat n-   ) => Variant l -> Either (Variant (RemoveAt n l)) (Index n l)-{-# INLINE popVariantAt #-}-popVariantAt v@(Variant t a) = case fromVariantAt @n v of-   Just x  -> Right x-   Nothing -> Left $ if t > natValue' @n-      then Variant (t-1) a-      else Variant t a---- | Pop the head of a variant value-popVariantHead :: forall x xs. Variant (x ': xs) -> Either (Variant xs) x-{-# INLINE popVariantHead #-}-popVariantHead v@(Variant t a) = case fromVariantAt @0 v of-   Just x  -> Right x-   Nothing -> Left $ Variant (t-1) a---- | Update a variant value-updateVariantAt :: forall (n :: Nat) a b l.-   ( KnownNat n-   , a ~ Index n l-   ) => (a -> b) -> Variant l -> Variant (ReplaceN n b l)-{-# INLINE updateVariantAt #-}-updateVariantAt f v@(Variant t a) =-   case fromVariantAt @n v of-      Nothing -> Variant t a-      Just x  -> Variant t (unsafeCoerce (f x))---------------------------------------------------------------- Operations by type---------------------------------------------------------------- | Put a value into a Variant------ Use the first matching type index.-toVariant :: forall a l.-   ( Member a l-   ) => a -> Variant l-{-# INLINE toVariant #-}-toVariant = toVariantAt @(IndexOf a l)--class PopVariant a xs where-   -- | Remove a type from a variant-   popVariant' :: Variant xs -> Either (Variant (Filter a xs)) a--instance PopVariant a '[] where-   popVariant' _ = undefined--instance forall a xs n xs' y ys.-      ( PopVariant a xs'-      , n ~ MaybeIndexOf a xs-      , xs' ~ RemoveAt1 n xs-      , Filter a xs' ~ Filter a xs-      , KnownNat n-      , xs ~ (y ': ys)-      ) => PopVariant a (y ': ys)-   where-      {-# INLINE popVariant' #-}-      popVariant' (Variant t a)-         = case natValue' @n of-            0             -> Left (Variant t a) -- no 'a' left in xs-            n | n-1 == t  -> Right (unsafeCoerce a)-              | n-1 < t   -> popVariant' @a @xs' (Variant (t-1) a)-              | otherwise -> Left (Variant t a)---- | a is popable in xs-type Popable a xs =-   ( Member a xs-   , PopVariant a xs-   )---- | a may be popable in xs-type MaybePopable a xs =-   ( PopVariant a xs-   )---- | Extract a type from a variant. Return either the value of this type or the--- remaining variant-popVariant :: forall a xs.-   ( Popable a xs-   ) => Variant xs -> Either (Variant (Filter a xs)) a-popVariant v = popVariant' @a v---- | Extract a type from a variant. Return either the value of this type or the--- remaining variant-popVariantMaybe :: forall a xs.-   ( MaybePopable a xs-   ) => Variant xs -> Either (Variant (Filter a xs)) a-popVariantMaybe v = popVariant' @a v---- | Pick the first matching type of a Variant------ fromVariantFirst @A (Variant 2 undefined :: Variant '[A,B,A]) == Nothing-fromVariantFirst :: forall a l.-   ( Member a l-   ) => Variant l -> Maybe a-{-# INLINE fromVariantFirst #-}-fromVariantFirst = fromVariantAt @(IndexOf a l)---- | Try to a get a value of a given type from a Variant-fromVariant :: forall a xs.-   ( Popable a xs-   ) => Variant xs -> Maybe a-{-# INLINE fromVariant #-}-fromVariant v = case popVariant v of-   Right a -> Just a-   Left _  -> Nothing---- | Try to a get a value of a given type from a Variant that may not even--- support the given type.-fromVariantMaybe :: forall a xs.-   ( MaybePopable a xs-   ) => Variant xs -> Maybe a-{-# INLINE fromVariantMaybe #-}-fromVariantMaybe v = case popVariantMaybe v of-   Right a -> Just a-   Left _  -> Nothing---- | Update a variant value-updateVariantFirst :: forall a b n l.-   ( Member a l-   , n ~ IndexOf a l-   ) => (a -> b) -> Variant l -> Variant (ReplaceN n b l)-{-# INLINE updateVariantFirst #-}-updateVariantFirst f v = updateVariantAt @n f v---- | Monadic update of the first matching variant value-updateVariantFirstM :: forall (n :: Nat) l l2 m .-   (KnownNat n, Monad m)-   => (Index n l -> m (Index n l2)) -> Variant l -> m (Variant l2)-{-# INLINE updateVariantFirstM #-}-updateVariantFirstM f v@(Variant t a) =-   case fromVariantAt @n v of-      Nothing -> return (Variant t a)-      Just x  -> Variant t <$> unsafeCoerce (f x)--class MapVariant a b cs (is :: [Nat]) where-   mapVariant' :: (a -> b) -> Variant cs -> Variant (ReplaceNS is b cs)--instance MapVariant a b '[] is where-   {-# INLINE mapVariant' #-}-   mapVariant' = undefined--instance MapVariant a b cs '[] where-   {-# INLINE mapVariant' #-}-   mapVariant' _ v = v--instance forall a b cs is i.-   ( MapVariant a b (ReplaceN i b cs) is-   , a ~ Index i cs-   , KnownNat i-   ) => MapVariant a b cs (i ': is) where-   {-# INLINE mapVariant' #-}-   mapVariant' f v = mapVariant' @a @b @(ReplaceN i b cs) @is f (updateVariantAt @i f v)--type MappableVariant a b cs =-   ( MapVariant a b cs (IndexesOf a cs)-   )---- | Map the matching types of a variant-mapVariant :: forall a b cs.-   ( MappableVariant a b cs-   ) => (a -> b) -> Variant cs -> Variant (ReplaceNS (IndexesOf a cs) b cs)-mapVariant = mapVariant' @a @b @cs @(IndexesOf a cs)----- | Update a variant value with a variant and fold the result-foldMapVariantAt :: forall (n :: Nat) l l2 .-   ( KnownNat n-   , KnownNat (Length l2)-   ) => (Index n l -> Variant l2) -> Variant l -> Variant (ReplaceAt n l l2)-foldMapVariantAt f v@(Variant t a) =-   case fromVariantAt @n v of-      Nothing ->-         -- we need to adapt the tag if new valid tags (from l2) are added before-         if t < n-            then Variant t a-            else Variant (t+nl2-1) a--      Just x  -> case f x of-         Variant t2 a2 -> Variant (t2+n) a2-   where-      n   = natValue' @n-      nl2 = natValue' @(Length l2)---- | Update a variant value with a variant and fold the result-foldMapVariantAtM :: forall (n :: Nat) m l l2.-   ( KnownNat n-   , KnownNat (Length l2)-   , Monad m-   ) => (Index n l -> m (Variant l2)) -> Variant l -> m (Variant (ReplaceAt n l l2))-foldMapVariantAtM f v@(Variant t a) =-   case fromVariantAt @n v of-      Nothing ->-         -- we need to adapt the tag if new valid tags (from l2) are added before-         return $ if t < n-            then Variant t a-            else Variant (t+nl2-1) a--      Just x  -> do-         y <- f x-         case y of-            Variant t2 a2 -> return (Variant (t2+n) a2)-   where-      n   = natValue' @n-      nl2 = natValue' @(Length l2)---- | Update a variant value with a variant and fold the result-foldMapVariantFirst :: forall a (n :: Nat) l l2 .-   ( KnownNat n-   , KnownNat (Length l2)-   , n ~ IndexOf a l-   , a ~ Index n l-   ) => (a -> Variant l2) -> Variant l -> Variant (ReplaceAt n l l2)-foldMapVariantFirst f v = foldMapVariantAt @n f v---- | Update a variant value with a variant and fold the result-foldMapVariantFirstM :: forall a (n :: Nat) l l2 m.-   ( KnownNat n-   , KnownNat (Length l2)-   , n ~ IndexOf a l-   , a ~ Index n l-   , Monad m-   ) => (a -> m (V l2)) -> V l -> m (V (ReplaceAt n l l2))-foldMapVariantFirstM f v = foldMapVariantAtM @n f v------ | Update a variant value with a variant and fold the result-foldMapVariant :: forall a cs ds i.-   ( i ~ IndexOf a cs-   , Popable a cs-   ) => (a -> V ds) -> V cs -> V (InsertAt i (Filter a cs) ds)-foldMapVariant f v = case popVariant v of-   Right a -> case f a of-      Variant t x -> Variant (i + t) x-   Left (Variant t x)-      | t < i     -> Variant t x-      | otherwise -> Variant (i+t) x-   where-      i = natValue' @i------------------------------------------------------------------- Generic operations with type classes--------------------------------------------------------------class AlterVariant c (b :: [*]) where-   alterVariant' :: Alter c -> Word -> Any -> Any--instance AlterVariant c '[] where-   {-# INLINE alterVariant' #-}-   alterVariant' = undefined--instance-   ( AlterVariant c xs-   , c x-   ) => AlterVariant c (x ': xs)-   where-      {-# INLINE alterVariant' #-}-      alterVariant' m@(Alter f) t v =-         case t of-            0 -> unsafeCoerce (f (unsafeCoerce v :: x))-            n -> alterVariant' @c @xs m (n-1) v---- | Wrap a function and its constraints-data Alter (c :: * -> Constraint) = Alter (forall a. c a => a -> a)---- | Wrap a function and its constraints-data AlterM (c :: * -> Constraint) m = AlterM (forall a. (Monad m, c a) => a -> m a)---- | Useful to specify a "* -> Constraint" function returning no constraint-class NoConstraint a-instance NoConstraint a--class TraverseVariant c (b :: [*]) m where-   traverseVariant' :: AlterM c m -> Word -> Any -> m Any--instance TraverseVariant c '[] m where-   {-# INLINE traverseVariant' #-}-   traverseVariant' = undefined--instance-   ( TraverseVariant c xs m-   , c x-   , Monad m-   ) => TraverseVariant c (x ': xs) m-   where-      {-# INLINE traverseVariant' #-}-      traverseVariant' m@(AlterM f) t v =-         case t of-            0 -> unsafeCoerce <$> f (unsafeCoerce v :: x)-            n -> traverseVariant' @c @xs m (n-1) v----- | Alter a variant. You need to specify the constraints required by the--- modifying function.------ Usage:---    alterVariant @NoConstraint id         v---    alterVariant @Resizable    (resize 4) v------    class (Ord a, Num a) => OrdNum a---    instance (Ord a, Num a) => OrdNum a----{-# INLINE alterVariant #-}-alterVariant :: forall c (a :: [*]).-   ( AlterVariant c a-   ) => (forall x. c x => x -> x) -> Variant a  -> Variant a-alterVariant f (Variant t a) = -   Variant t (alterVariant' @c @a (Alter @c f) t a)---- | Traverse a variant. You need to specify the constraints required by the--- modifying function.-{-# INLINE traverseVariant #-}-traverseVariant :: forall c (a :: [*]) m.-   ( TraverseVariant c a m-   , Monad m-   ) => (forall x. c x => x -> m x) -> Variant a  -> m (Variant a)-traverseVariant f (Variant t a) = -   Variant t <$> traverseVariant' @c @a (AlterM @c @m f) t a---- | Traverse a variant. You need to specify the constraints required by the--- modifying function.-traverseVariant_ :: forall c (a :: [*]) m.-   ( TraverseVariant c a m-   , Monad m-   ) => (forall x. c x => x -> m ()) -> Variant a  -> m ()-traverseVariant_ f v = void (traverseVariant @c @a f' v)-   where-      f' :: forall x. c x => x -> m x-      f' x = f x >> return x---------------------------------------------------------------- Conversions between variants---------------------------------------------------------------- | Extend a variant by appending other possible values-appendVariant :: forall (ys :: [*]) (xs :: [*]). Variant xs -> Variant (Concat xs ys)-{-# INLINE appendVariant #-}-appendVariant (Variant t a) = Variant t a---- | Extend a variant by prepending other possible values-prependVariant :: forall (ys :: [*]) (xs :: [*]).-   ( KnownNat (Length ys)-   ) => Variant xs -> Variant (Concat ys xs)-{-# INLINE prependVariant #-}-prependVariant (Variant t a) = Variant (n+t) a-   where-      n = natValue' @(Length ys)---- | xs is liftable in ys-type Liftable xs ys =-   ( IsSubset xs ys ~ 'True-   , VariantLift xs ys-   )--class VariantLift xs ys where-   liftVariant' :: Variant xs -> Variant ys--instance VariantLift '[] ys where-   liftVariant' = error "Lifting empty variant"--instance forall xs ys x.-      ( VariantLift xs ys-      , KnownNat (IndexOf x ys)-      ) => VariantLift (x ': xs) ys-   where-      {-# INLINE liftVariant' #-}-      liftVariant' (Variant t a)-         | t == 0    = Variant (natValue' @(IndexOf x ys)) a-         | otherwise = liftVariant' @xs (Variant (t-1) a)----- | Lift a variant into another------ Set values to the first matching type-liftVariant :: forall xs ys.-   ( Liftable xs ys-   ) => Variant xs -> Variant ys-{-# INLINE liftVariant #-}-liftVariant = liftVariant'---- | Nub the type list-nubVariant :: (Liftable xs (Nub xs)) => V xs -> V (Nub xs)-nubVariant = liftVariant---------------------------------------------------------------- Conversions to other data types---------------------------------------------------------------- | Retreive a single value-variantToValue :: Variant '[a] -> a-{-# INLINE variantToValue #-}-variantToValue (Variant _ a) = unsafeCoerce a----- | Convert a variant of two values in a Either-variantToEither :: forall a b. Variant '[a,b] -> Either b a-variantToEither (Variant 0 a) = Right (unsafeCoerce a)-variantToEither (Variant _ a) = Left (unsafeCoerce a)--class VariantToHList xs where-   -- | Convert a variant into a HList of Maybes-   variantToHList :: Variant xs -> HList (MapMaybe xs)--instance VariantToHList '[] where-   variantToHList _ = HNil--instance-   ( VariantToHList xs-   ) => VariantToHList (x ': xs)-   where-      variantToHList v@(Variant t a) =-            fromVariantAt @0 v `HCons` variantToHList v'-         where-            v' :: Variant xs-            v' = Variant (t-1) a---- | Get variant possible values in a tuple of Maybe types-variantToTuple :: forall l t.-   ( VariantToHList l-   , HTuple' (MapMaybe l) t-   ) => Variant l -> t-variantToTuple = hToTuple' . variantToHList----- | Lift an Either into a Variant (reversed order by convention)-variantFromEither :: Either a b -> Variant '[b,a]-{-# INLINE variantFromEither #-}-variantFromEither (Left a)  = toVariantAt @1 a-variantFromEither (Right b) = toVariantAt @0 b---class ContVariant xs where-   -- | Convert a variant into a multi-continuation-   variantToCont :: Variant xs -> ContFlow xs r--   -- | Convert a variant into a multi-continuation-   variantToContM :: Monad m => m (Variant xs) -> ContFlow xs (m r)--   -- | Convert a multi-continuation into a Variant-   contToVariant :: ContFlow xs (Variant xs) -> Variant xs--   -- | Convert a multi-continuation into a Variant-   contToVariantM :: Monad m => ContFlow xs (m (Variant xs)) -> m (Variant xs)--instance ContVariant '[a] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant _ a) = ContFlow $ \(Single f) ->-      f (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(Single f) -> do-      Variant _ a <- act-      f (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      Single (toVariantAt @0)--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      Single (return . toVariantAt @0)--instance ContVariant '[a,b] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         _ -> f2 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         _ -> f2 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      )--instance ContVariant '[a,b,c] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         _ -> f3 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         _ -> f3 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      )--instance ContVariant '[a,b,c,d] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         _ -> f4 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         _ -> f4 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      )--instance ContVariant '[a,b,c,d,e] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         _ -> f5 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         _ -> f5 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      )--instance ContVariant '[a,b,c,d,e,f] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         _ -> f6 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         _ -> f6 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      )--instance ContVariant '[a,b,c,d,e,f,g] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         _ -> f7 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         _ -> f7 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      )--instance ContVariant '[a,b,c,d,e,f,g,h] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         6 -> f7 (unsafeCoerce a)-         _ -> f8 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         6 -> f7 (unsafeCoerce a)-         _ -> f8 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      , toVariantAt @7-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      , return . toVariantAt @7-      )--instance ContVariant '[a,b,c,d,e,f,g,h,i] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) ->-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         6 -> f7 (unsafeCoerce a)-         7 -> f8 (unsafeCoerce a)-         _ -> f9 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) -> do-      Variant t a <- act-      case t of-         0 -> f1 (unsafeCoerce a)-         1 -> f2 (unsafeCoerce a)-         2 -> f3 (unsafeCoerce a)-         3 -> f4 (unsafeCoerce a)-         4 -> f5 (unsafeCoerce a)-         5 -> f6 (unsafeCoerce a)-         6 -> f7 (unsafeCoerce a)-         7 -> f8 (unsafeCoerce a)-         _ -> f9 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      , toVariantAt @7-      , toVariantAt @8-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      , return . toVariantAt @7-      , return . toVariantAt @8-      )--instance ContVariant '[a,b,c,d,e,f,g,h,i,j] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) ->-      case t of-         0 -> f1  (unsafeCoerce a)-         1 -> f2  (unsafeCoerce a)-         2 -> f3  (unsafeCoerce a)-         3 -> f4  (unsafeCoerce a)-         4 -> f5  (unsafeCoerce a)-         5 -> f6  (unsafeCoerce a)-         6 -> f7  (unsafeCoerce a)-         7 -> f8  (unsafeCoerce a)-         8 -> f9  (unsafeCoerce a)-         _ -> f10 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) -> do-      Variant t a <- act-      case t of-         0 -> f1  (unsafeCoerce a)-         1 -> f2  (unsafeCoerce a)-         2 -> f3  (unsafeCoerce a)-         3 -> f4  (unsafeCoerce a)-         4 -> f5  (unsafeCoerce a)-         5 -> f6  (unsafeCoerce a)-         6 -> f7  (unsafeCoerce a)-         7 -> f8  (unsafeCoerce a)-         8 -> f9  (unsafeCoerce a)-         _ -> f10 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      , toVariantAt @7-      , toVariantAt @8-      , toVariantAt @9-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      , return . toVariantAt @7-      , return . toVariantAt @8-      , return . toVariantAt @9-      )--instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) ->-      case t of-         0 -> f1  (unsafeCoerce a)-         1 -> f2  (unsafeCoerce a)-         2 -> f3  (unsafeCoerce a)-         3 -> f4  (unsafeCoerce a)-         4 -> f5  (unsafeCoerce a)-         5 -> f6  (unsafeCoerce a)-         6 -> f7  (unsafeCoerce a)-         7 -> f8  (unsafeCoerce a)-         8 -> f9  (unsafeCoerce a)-         9 -> f10 (unsafeCoerce a)-         _ -> f11 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) -> do-      Variant t a <- act-      case t of-         0 -> f1  (unsafeCoerce a)-         1 -> f2  (unsafeCoerce a)-         2 -> f3  (unsafeCoerce a)-         3 -> f4  (unsafeCoerce a)-         4 -> f5  (unsafeCoerce a)-         5 -> f6  (unsafeCoerce a)-         6 -> f7  (unsafeCoerce a)-         7 -> f8  (unsafeCoerce a)-         8 -> f9  (unsafeCoerce a)-         9 -> f10 (unsafeCoerce a)-         _ -> f11 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      , toVariantAt @7-      , toVariantAt @8-      , toVariantAt @9-      , toVariantAt @10-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      , return . toVariantAt @7-      , return . toVariantAt @8-      , return . toVariantAt @9-      , return . toVariantAt @10-      )--instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k,l] where-   {-# INLINE variantToCont #-}-   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12) ->-      case t of-         0  -> f1  (unsafeCoerce a)-         1  -> f2  (unsafeCoerce a)-         2  -> f3  (unsafeCoerce a)-         3  -> f4  (unsafeCoerce a)-         4  -> f5  (unsafeCoerce a)-         5  -> f6  (unsafeCoerce a)-         6  -> f7  (unsafeCoerce a)-         7  -> f8  (unsafeCoerce a)-         8  -> f9  (unsafeCoerce a)-         9  -> f10 (unsafeCoerce a)-         10 -> f11 (unsafeCoerce a)-         _  -> f12 (unsafeCoerce a)--   {-# INLINE variantToContM #-}-   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12) -> do-      Variant t a <- act-      case t of-         0  -> f1  (unsafeCoerce a)-         1  -> f2  (unsafeCoerce a)-         2  -> f3  (unsafeCoerce a)-         3  -> f4  (unsafeCoerce a)-         4  -> f5  (unsafeCoerce a)-         5  -> f6  (unsafeCoerce a)-         6  -> f7  (unsafeCoerce a)-         7  -> f8  (unsafeCoerce a)-         8  -> f9  (unsafeCoerce a)-         9  -> f10 (unsafeCoerce a)-         10 -> f11 (unsafeCoerce a)-         _  -> f12 (unsafeCoerce a)--   {-# INLINE contToVariant #-}-   contToVariant c = c >::>-      ( toVariantAt @0-      , toVariantAt @1-      , toVariantAt @2-      , toVariantAt @3-      , toVariantAt @4-      , toVariantAt @5-      , toVariantAt @6-      , toVariantAt @7-      , toVariantAt @8-      , toVariantAt @9-      , toVariantAt @10-      , toVariantAt @11-      )--   {-# INLINE contToVariantM #-}-   contToVariantM c = c >::>-      ( return . toVariantAt @0-      , return . toVariantAt @1-      , return . toVariantAt @2-      , return . toVariantAt @3-      , return . toVariantAt @4-      , return . toVariantAt @5-      , return . toVariantAt @6-      , return . toVariantAt @7-      , return . toVariantAt @8-      , return . toVariantAt @9-      , return . toVariantAt @10-      , return . toVariantAt @11-      )