haskus-utils-variant 3.3 → 3.4
raw patch · 4 files changed
+39/−4 lines, 4 filesdep +unliftio-corePVP ok
version bump matches the API change (PVP)
Dependencies added: unliftio-core
API changes (from Hackage documentation)
- Haskus.Utils.VariantF: instance (Data.Functor.Classes.Eq1 f, Data.Functor.Classes.Eq1 (Haskus.Utils.VariantF.VariantF fs)) => Data.Functor.Classes.Eq1 (Haskus.Utils.VariantF.VariantF (f : fs))
- Haskus.Utils.VariantF: instance (Data.Functor.Classes.Ord1 f, Data.Functor.Classes.Ord1 (Haskus.Utils.VariantF.VariantF fs)) => Data.Functor.Classes.Ord1 (Haskus.Utils.VariantF.VariantF (f : fs))
- Haskus.Utils.VariantF: instance (Data.Functor.Classes.Show1 f, Data.Functor.Classes.Show1 (Haskus.Utils.VariantF.VariantF fs)) => Data.Functor.Classes.Show1 (Haskus.Utils.VariantF.VariantF (f : fs))
+ Haskus.Utils.ContFlow: type MultiContTypes a :: [Type];
+ Haskus.Utils.Variant: instance (GHC.Exception.Type.Exception x, Data.Typeable.Internal.Typeable xs, GHC.Exception.Type.Exception (Haskus.Utils.Variant.V xs)) => GHC.Exception.Type.Exception (Haskus.Utils.Variant.V (x : xs))
+ Haskus.Utils.Variant: instance GHC.Exception.Type.Exception (Haskus.Utils.Variant.V '[])
+ Haskus.Utils.Variant.Excepts: instance (Control.Monad.Catch.MonadCatch m, Control.Monad.IO.Unlift.MonadUnliftIO m, GHC.Exception.Type.Exception (Haskus.Utils.Variant.V es)) => Control.Monad.IO.Unlift.MonadUnliftIO (Haskus.Utils.Variant.Excepts.Excepts es m)
+ Haskus.Utils.VariantF: instance (Data.Functor.Classes.Eq1 f, Data.Functor.Classes.Eq1 (Haskus.Utils.VariantF.VariantF fs), Haskus.Utils.Types.Constraint.ConstraintAll1 Data.Functor.Classes.Eq1 fs) => Data.Functor.Classes.Eq1 (Haskus.Utils.VariantF.VariantF (f : fs))
+ Haskus.Utils.VariantF: instance (Data.Functor.Classes.Ord1 f, Data.Functor.Classes.Ord1 (Haskus.Utils.VariantF.VariantF fs), Haskus.Utils.Types.Constraint.ConstraintAll1 Data.Functor.Classes.Eq1 fs, Haskus.Utils.Types.Constraint.ConstraintAll1 Data.Functor.Classes.Ord1 fs) => Data.Functor.Classes.Ord1 (Haskus.Utils.VariantF.VariantF (f : fs))
+ Haskus.Utils.VariantF: instance (Data.Functor.Classes.Show1 f, Data.Functor.Classes.Show1 (Haskus.Utils.VariantF.VariantF fs), Haskus.Utils.Types.Constraint.ConstraintAll1 Data.Functor.Classes.Show1 fs) => Data.Functor.Classes.Show1 (Haskus.Utils.VariantF.VariantF (f : fs))
- Haskus.Utils.ContFlow: type family MultiContTypes a :: [Type];
+ Haskus.Utils.ContFlow: type family ToMultiCont xs r
- Haskus.Utils.Variant: bindVariant :: forall x xs ys. KnownNat (Length ys) => V (x : xs) -> (x -> V ys) -> V (Concat ys xs)
+ Haskus.Utils.Variant: bindVariant :: forall x xs ys. KnownNat (Length ys) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)
- Haskus.Utils.Variant: fromVariantHead :: V (x : xs) -> Maybe x
+ Haskus.Utils.Variant: fromVariantHead :: V (x ': xs) -> Maybe x
- Haskus.Utils.Variant: mapVariantHeadTail :: (x -> y) -> (V xs -> V ys) -> V (x : xs) -> V (y : ys)
+ Haskus.Utils.Variant: mapVariantHeadTail :: (x -> y) -> (V xs -> V ys) -> V (x ': xs) -> V (y ': ys)
- Haskus.Utils.Variant: popVariantHead :: forall x xs. V (x : xs) -> Either (V xs) x
+ Haskus.Utils.Variant: popVariantHead :: forall x xs. V (x ': xs) -> Either (V xs) x
- Haskus.Utils.Variant: toVariantHead :: forall x xs. x -> V (x : xs)
+ Haskus.Utils.Variant: toVariantHead :: forall x xs. x -> V (x ': xs)
- Haskus.Utils.Variant: toVariantTail :: forall x xs. V xs -> V (x : xs)
+ Haskus.Utils.Variant: toVariantTail :: forall x xs. V xs -> V (x ': xs)
- Haskus.Utils.Variant: variantHeadTail :: (x -> u) -> (V xs -> u) -> V (x : xs) -> u
+ Haskus.Utils.Variant: variantHeadTail :: (x -> u) -> (V xs -> u) -> V (x ': xs) -> u
- Haskus.Utils.Variant.Excepts: catchRemove :: forall e es a m. Monad m => (e -> Excepts es m a) -> Excepts (e : es) m a -> Excepts es m a
+ Haskus.Utils.Variant.Excepts: catchRemove :: forall e es a m. Monad m => (e -> Excepts es m a) -> Excepts (e ': es) m a -> Excepts es m a
- Haskus.Utils.Variant.Excepts: variantToExcepts :: Monad m => V (a : es) -> Excepts es m a
+ Haskus.Utils.Variant.Excepts: variantToExcepts :: Monad m => V (a ': es) -> Excepts es m a
- Haskus.Utils.Variant.Syntax: (>>=) :: forall x xs ys. KnownNat (Length ys) => V (x : xs) -> (x -> V ys) -> V (Concat ys xs)
+ Haskus.Utils.Variant.Syntax: (>>=) :: forall x xs ys. KnownNat (Length ys) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)
- Haskus.Utils.Variant.VEither: veitherFromVariant :: V (a : es) -> VEither es a
+ Haskus.Utils.Variant.VEither: veitherFromVariant :: V (a ': es) -> VEither es a
- Haskus.Utils.Variant.VEither: veitherToVariant :: VEither es a -> V (a : es)
+ Haskus.Utils.Variant.VEither: veitherToVariant :: VEither es a -> V (a ': es)
- Haskus.Utils.VariantF: popVariantFHead :: forall x xs e. VariantF (x : xs) e -> Either (VariantF xs e) (x e)
+ Haskus.Utils.VariantF: popVariantFHead :: forall x xs e. VariantF (x ': xs) e -> Either (VariantF xs e) (x e)
- Haskus.Utils.VariantF: toVariantFHead :: forall x xs e. x e -> VariantF (x : xs) e
+ Haskus.Utils.VariantF: toVariantFHead :: forall x xs e. x e -> VariantF (x ': xs) e
- Haskus.Utils.VariantF: toVariantFTail :: forall x xs e. VariantF xs e -> VariantF (x : xs) e
+ Haskus.Utils.VariantF: toVariantFTail :: forall x xs e. VariantF xs e -> VariantF (x ': xs) e
Files
- haskus-utils-variant.cabal +10/−1
- src/lib/Haskus/Utils/Variant.hs +12/−3
- src/lib/Haskus/Utils/Variant/Excepts.hs +13/−0
- src/lib/Haskus/Utils/VariantF.hs +4/−0
haskus-utils-variant.cabal view
@@ -1,5 +1,5 @@ name: haskus-utils-variant-version: 3.3+version: 3.4 synopsis: Variant and EADT license: BSD3 license-file: LICENSE@@ -19,6 +19,11 @@ type: git location: git://github.com/haskus/packages.git +flag unliftio+ Description: Enable MonadUnliftIO instance+ Manual: True+ Default: True+ library exposed-modules: Haskus.Utils.ContFlow@@ -42,6 +47,10 @@ , haskus-utils-types >= 1.5 , haskus-utils-data >= 1.2 , mtl >= 2.2++ if flag(unliftio)+ build-depends: unliftio-core >= 0.2+ cpp-options: -DENABLE_UNLIFTIO ghc-options: -Wall default-language: Haskell2010
src/lib/Haskus/Utils/Variant.hs view
@@ -112,6 +112,7 @@ import GHC.Exts (Any) import Data.Typeable import Control.DeepSeq+import Control.Exception import Haskus.Utils.Monad import Haskus.Utils.Types@@ -271,6 +272,14 @@ {-# INLINABLE showTypeList #-} showTypeList _ = showsPrec 0 (typeOf (undefined :: x)) : showTypeList (undefined :: V xs) +instance Exception (V '[]) where++instance+ ( Exception x+ , Typeable xs+ , Exception (V xs)+ ) => Exception (V (x ': xs))+ -- | Get Variant index -- -- >>> let x = V "Test" :: V '[Int,String,Double]@@ -614,8 +623,7 @@ -- | A value of type "x" can be extracted from (V xs) type (:<) x xs =- ( CheckMember x xs- , Member x xs+ ( Member x xs , x :<? xs ) @@ -669,7 +677,8 @@ -- >>> fromVariant @Double x -- <BLANKLINE> -- ... error:--- ... `Double' is not a member of '[Int, String, Int]+-- ... Double not found in list:+-- ... '[Int, String, Int] -- ... -- fromVariant :: forall a xs.
src/lib/Haskus/Utils/Variant/Excepts.hs view
@@ -61,6 +61,10 @@ import qualified Control.Monad.Fail import Control.Monad.Fail ( MonadFail ) #endif+#if defined(ENABLE_UNLIFTIO)+import Control.Monad.IO.Unlift+import qualified Control.Exception as E+#endif newtype Excepts es m a = Excepts (m (VEither es a)) @@ -419,3 +423,12 @@ v1 <- f v2 <- g pure (v1,v2)++#if defined(ENABLE_UNLIFTIO)+instance forall es m . (MonadCatch m, MonadUnliftIO m, Exception (V es)) => MonadUnliftIO (Excepts es m) where+ withRunInIO exceptSToIO = Excepts $ fmap (either VLeft VRight) $ try $ do+ withRunInIO $ \runInIO ->+ exceptSToIO (runInIO . ((\case+ VLeft v -> liftIO $ E.throwIO $ toException v+ VRight a -> pure a) <=< runE))+#endif
src/lib/Haskus/Utils/VariantF.hs view
@@ -165,6 +165,7 @@ instance ( Eq1 f , Eq1 (VariantF fs)+ , ConstraintAll1 Eq1 fs ) => Eq1 (VariantF (f:fs)) where liftEq cmp x y = case (popVariantFHead x, popVariantFHead y) of (Right a, Right b) -> liftEq cmp a b@@ -177,6 +178,8 @@ instance ( Ord1 f , Ord1 (VariantF fs)+ , ConstraintAll1 Eq1 fs+ , ConstraintAll1 Ord1 fs ) => Ord1 (VariantF (f:fs)) where liftCompare cmp x@(VariantF v1) y@(VariantF v2) = case (popVariantFHead x, popVariantFHead y) of@@ -191,6 +194,7 @@ instance ( Show1 f , Show1 (VariantF fs)+ , ConstraintAll1 Show1 fs ) => Show1 (VariantF (f:fs)) where liftShowsPrec shw shwl p x = case popVariantFHead x of Right a -> liftShowsPrec shw shwl p a