haskus-utils-variant 2.5 → 2.6

raw patch · 6 files changed

+57/−42 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskus-utils-variant.cabal +1/−1
• src/lib/Haskus/Utils/Variant.hs +17/−5
• src/lib/Haskus/Utils/Variant/Cont.hs +0/−1
• src/lib/Haskus/Utils/Variant/Flow.hs +39/−33
• src/lib/Haskus/Utils/Variant/OldFlow.hs +0/−1
• src/lib/Haskus/Utils/Variant/Syntax.hs +0/−1

@@ -1,5 +1,5 @@ name:                haskus-utils-variant-version:             2.5+version:             2.6 synopsis:            Variant and EADT license:             BSD3 license-file:        LICENSE

@@ -20,6 +20,7 @@ module Haskus.Utils.Variant    ( V (..)    , variantIndex+   , variantSize    -- * Patterns    , pattern V    , pattern VMaybe@@ -115,7 +116,6 @@ import Haskus.Utils.Tuple import Haskus.Utils.HList import Haskus.Utils.ContFlow-import Haskus.Utils.Types.List  -- $setup -- >>> :set -XDataKinds@@ -249,11 +249,8 @@    {-# INLINE showTypeList #-}    showTypeList _ = showsPrec 0 (typeOf (undefined :: x)) : showTypeList (undefined :: V xs) --------------------------------------------------------------- Operations by index------------------------------------------------------------- -- | Get Variant index+-- -- >>> let x = V "Test" :: V '[Int,String,Double] -- >>> variantIndex x -- 1@@ -263,6 +260,21 @@ -- variantIndex :: V a -> Word variantIndex (Variant n _) = n++-- | Get variant size+--+-- >>> let x = V "Test" :: V '[Int,String,Double]+-- >>> variantSize x+-- 3+-- >>> let y = toVariantAt @0 10 :: V '[Int,String,Double,Int]+-- >>> variantSize y+-- 4+variantSize :: forall xs. (KnownNat (Length xs)) => V xs -> Word+variantSize _ = natValue @(Length xs)++-----------------------------------------------------------+-- Operations by index+-----------------------------------------------------------  -- | Set the value with the given indexed type --

@@ -25,7 +25,6 @@  import Haskus.Utils.Tuple import Haskus.Utils.Types-import Haskus.Utils.Types.List import Haskus.Utils.ContFlow  -- this define has to be defined in each module using ContFlow for now

@@ -30,6 +30,7 @@    , catchLiftRight    , catchAllE    , catchDie+   , catchDieAll    , catchRemove    , onFlowError_    , onFlowError@@ -51,7 +52,7 @@ type Flow es     = FlowT es Identity  runFlow :: Flow es a -> V (a ': es)-{-# INLINE runFlow #-}+{-# INLINABLE runFlow #-} runFlow (FlowT m) = runIdentity m  ------------------------------------------------------------------------------@@ -62,51 +63,51 @@ deriving instance Show (m (V (a ': es))) => Show (FlowT es m a)  runFlowT :: FlowT es m a -> m (V (a ': es))-{-# INLINE runFlowT #-}+{-# INLINABLE runFlowT #-} runFlowT (FlowT m) = m  runFlowT_ :: Functor m => FlowT es m a -> m ()-{-# INLINE runFlowT_ #-}+{-# INLINABLE runFlowT_ #-} runFlowT_ m = void (runFlowT m)  injectFlowT :: Monad m => FlowT es m a -> FlowT es m (V (a ': es))-{-# INLINE injectFlowT #-}+{-# INLINABLE injectFlowT #-} injectFlowT (FlowT m) = return =<< lift m  -- | Convert a flow without error into a value evalFlowT :: Monad m => FlowT '[] m a -> m a-{-# INLINE evalFlowT #-}+{-# INLINABLE evalFlowT #-} evalFlowT v = variantToValue <$> runFlowT v  mapFlowT :: (m (V (a ': es)) -> n (V (b ': es'))) -> FlowT es m a -> FlowT es' n b-{-# INLINE mapFlowT #-}+{-# INLINABLE mapFlowT #-} mapFlowT f m = FlowT $ f (runFlowT m)  -- | Lift a FlowT into another liftFlowT :: (Monad m, LiftVariant es es') => FlowT es m a -> FlowT es' m a-{-# INLINE liftFlowT #-}+{-# INLINABLE liftFlowT #-} liftFlowT (FlowT m) = FlowT $ do    a <- m    return (mapVariantHeadTail id liftVariant a)  instance Functor m => Functor (FlowT es m) where-   {-# INLINE fmap #-}+   {-# INLINABLE fmap #-}    fmap f = FlowT . fmap (mapVariantHeadTail f id) . runFlowT  instance Foldable m => Foldable (FlowT es m) where-   {-# INLINE foldMap #-}+   {-# INLINABLE foldMap #-}    foldMap f (FlowT m) = foldMap (variantHeadTail f (const mempty)) m  instance Traversable m => Traversable (FlowT es m) where-   {-# INLINE traverse #-}+   {-# INLINABLE traverse #-}    traverse f (FlowT m) =       FlowT <$> traverse (variantHeadTail (fmap toVariantHead . f) (pure . toVariantTail)) m  instance (Functor m, Monad m) => Applicative (FlowT es m) where-    {-# INLINE pure #-}+    {-# INLINABLE pure #-}     pure a = FlowT $ return (toVariantHead a) -    {-# INLINEABLE (<*>) #-}+    {-# INLINABLE (<*>) #-}     FlowT f <*> FlowT v = FlowT $ do         mf <- f         case popVariantHead mf of@@ -117,32 +118,32 @@                     Left es -> return (toVariantTail es)                     Right x -> return (toVariantHead (k x)) -    {-# INLINE (*>) #-}+    {-# INLINABLE (*>) #-}     m *> k = m >>= \_ -> k  instance (Monad m) => Monad (FlowT es m) where-    {-# INLINE (>>=) #-}+    {-# INLINABLE (>>=) #-}     m >>= k = FlowT $ do         a <- runFlowT m         case popVariantHead a of             Left es -> return (toVariantTail es)             Right x -> runFlowT (k x) -    {-# INLINE fail #-}+    {-# INLINABLE fail #-}     fail = FlowT . fail  instance MonadTrans (FlowT e) where-    {-# INLINE lift #-}+    {-# INLINABLE lift #-}     lift = FlowT . liftM toVariantHead  instance (MonadIO m) => MonadIO (FlowT es m) where-    {-# INLINE liftIO #-}+    {-# INLINABLE liftIO #-}     liftIO = lift . liftIO   -- | Throws exceptions into the base monad. instance MonadThrow m => MonadThrow (FlowT e m) where-   {-# INLINE throwM #-}+   {-# INLINABLE throwM #-}    throwM = lift . throwM  -- | Catches exceptions from the base monad.@@ -187,12 +188,12 @@  -- | Signal an exception value @e@. throwE :: (Monad m, e :< es) => e -> FlowT es m a-{-# INLINE throwE #-}+{-# INLINABLE throwE #-} throwE = FlowT . return . toVariantTail . V  -- | Signal an exception value @e@. failure :: Monad m => e -> FlowT '[e] m a-{-# INLINE failure #-}+{-# INLINABLE failure #-} failure = throwE  -- | Handle an exception. Lift both normal and exceptional flows into the result@@ -204,7 +205,7 @@    , LiftVariant es'' es'    ) =>     FlowT es m a -> (e -> FlowT es'' m a) -> FlowT es' m a-{-# INLINE catchE #-}+{-# INLINABLE catchE #-} m `catchE` h = m `catchLiftBoth` h  -- | Handle an exception. Lift both normal and exceptional flows into the result@@ -216,7 +217,7 @@    , LiftVariant es'' es'    ) =>     FlowT es m a -> (e -> FlowT es'' m a) -> FlowT es' m a-{-# INLINE catchLiftBoth #-}+{-# INLINABLE catchLiftBoth #-} m `catchLiftBoth` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -230,7 +231,7 @@    ( Monad m    ) =>     FlowT (e ': es) m a -> (e -> FlowT es m a) -> FlowT es m a-{-# INLINE catchRemove #-}+{-# INLINABLE catchRemove #-} m `catchRemove` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -246,7 +247,7 @@    , LiftVariant (Remove e es) es'    ) =>     FlowT es m a -> (e -> FlowT es' m a) -> FlowT es' m a-{-# INLINE catchLiftLeft #-}+{-# INLINABLE catchLiftLeft #-} m `catchLiftLeft` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -262,7 +263,7 @@    , LiftVariant es' (Remove e es)    ) =>     FlowT es m a -> (e -> FlowT es' m a) -> FlowT (Remove e es) m a-{-# INLINE catchLiftRight #-}+{-# INLINABLE catchLiftRight #-} m `catchLiftRight` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -273,7 +274,7 @@  -- | Do something in case of error catchAllE :: Monad m => FlowT es m a -> (V es -> FlowT es' m a) -> FlowT es' m a-{-# INLINE catchAllE #-}+{-# INLINABLE catchAllE #-} m `catchAllE` h = FlowT $ do    a <- runFlowT m    case popVariantAt @0 a of@@ -282,16 +283,21 @@  -- | Evaluate a FlowT. Use the provided function to handle error cases. evalCatchFlowT :: Monad m => (V es -> m a) -> FlowT es m a -> m a-{-# INLINE evalCatchFlowT #-}+{-# INLINABLE evalCatchFlowT #-} evalCatchFlowT h m = do    a <- runFlowT m    case popVariantAt @0 a of       Right x  -> return x       Left xs  -> h xs +-- | Evaluate a FlowT. Use the provided function to handle error cases.+catchDieAll :: Monad m => FlowT es m a -> (V es -> m a) -> m a+{-# INLINABLE catchDieAll #-}+catchDieAll m h = evalCatchFlowT h m+ -- | Catch and die in case of error catchDie :: (e :< es, Monad m) => FlowT es m a -> (e -> m ()) -> FlowT (Remove e es) m a-{-# INLINE catchDie #-}+{-# INLINABLE catchDie #-} m `catchDie` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -302,7 +308,7 @@  -- | Do something in case of error onFlowError_ :: Monad m => FlowT es m a -> m () -> FlowT es m a-{-# INLINE onFlowError_ #-}+{-# INLINABLE onFlowError_ #-} m `onFlowError_` h = FlowT $ do    a <- runFlowT m    case fromVariantHead a of@@ -311,7 +317,7 @@  -- | Do something in case of error onFlowError :: Monad m => FlowT es m a -> (V es -> m ()) -> FlowT es m a-{-# INLINE onFlowError #-}+{-# INLINABLE onFlowError #-} m `onFlowError` h = FlowT $ do    a <- runFlowT m    case popVariantHead a of@@ -320,7 +326,7 @@  -- | Finally for FlowT finallyFlow :: Monad m => FlowT es m a -> m () -> FlowT es m a-{-# INLINE finallyFlow #-}+{-# INLINABLE finallyFlow #-} m `finallyFlow` h = FlowT $ do    a <- runFlowT m    h@@ -331,10 +337,10 @@ variantToFlowT v = FlowT (return v)  instance MonadInIO m => MonadInIO (FlowT es m) where-   {-# INLINE liftWith #-}+   {-# INLINABLE liftWith #-}    liftWith wth f =       FlowT $ liftWith wth (\a -> runFlowT (f a)) -   {-# INLINE liftWith2 #-}+   {-# INLINABLE liftWith2 #-}    liftWith2 wth f =       FlowT $ liftWith2 wth (\a b -> runFlowT (f a b))

@@ -193,7 +193,6 @@  import Haskus.Utils.Variant import Haskus.Utils.Types-import Haskus.Utils.Types.List import Haskus.Utils.ContFlow import Haskus.Utils.Tuple 

@@ -13,7 +13,6 @@  import Haskus.Utils.Variant import Haskus.Utils.Types-import Haskus.Utils.Types.List  import Prelude hiding ((>>=),(>>),return)