haskus-utils-variant 2.0.2 → 2.0.3

raw patch · 5 files changed

+68/−2 lines, 5 files

Files

• haskus-utils-variant.cabal +2/−1
• src/lib/Haskus/Utils/ContFlow.hs +9/−0
• src/lib/Haskus/Utils/EADT.hs +6/−1
• src/lib/Haskus/Utils/Variant.hs +22/−0
• src/lib/Haskus/Utils/Variant/Syntax.hs +29/−0

@@ -1,6 +1,6 @@ cabal-version: 1.20 name: haskus-utils-variant-version: 2.0.2+version: 2.0.3 license: BSD3 license-file: LICENSE copyright: Sylvain Henry 2018@@ -24,6 +24,7 @@         Haskus.Utils.Variant         Haskus.Utils.Variant.Flow         Haskus.Utils.Variant.Cont+        Haskus.Utils.Variant.Syntax         Haskus.Utils.EADT         Haskus.Utils.EADT.TH     hs-source-dirs: src/lib

@@ -18,6 +18,7 @@    , ContTupleToList    , StripR    , AddR+   , MultiCont (..)    ) where @@ -73,3 +74,11 @@ infixl 0 >:%:>  +class MultiCont a where+   type MultiContTypes a :: [*]++   -- | Convert a data into a multi-continuation+   toCont :: a -> ContFlow (MultiContTypes a) r++   -- | Convert a data into a multi-continuation (monadic)+   toContM :: Monad m => m a -> ContFlow (MultiContTypes a) (m r)

@@ -262,6 +262,11 @@    ) => ContFlow (ApplyAll e xs) (m (V (ApplyAll e xs))) -> m (VariantF xs e) contToVariantFM f = VariantF <$> contToVariantM f +instance ContVariant (ApplyAll e xs) => MultiCont (VariantF xs e) where+   type MultiContTypes (VariantF xs e) = ApplyAll e xs+   toCont = variantFToCont+   toContM = variantFToContM+ -------------------------------------------- -- Extensible ADT --------------------------------------------@@ -311,7 +316,7 @@ liftEADT = cata (Fix . liftVariantF)  -- | Pop an EADT value-popEADT :: forall xs f e.+popEADT :: forall f xs e.    ( f :<: xs    , e ~ EADT xs    , f e :< ApplyAll e xs

@@ -37,6 +37,8 @@    , mapVariantAtM    , foldMapVariantAt    , foldMapVariantAtM+   , bindVariant+   , constBindVariant    -- * Operations by type    , toVariant    , Member@@ -270,6 +272,22 @@       Nothing -> pure (Variant t a)       Just x  -> Variant t <$> unsafeCoerce (f x) +-- | Bind (>>=) for a Variant+bindVariant :: forall x xs ys.+   ( KnownNat (Length ys)+   ) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)+{-# INLINABLE bindVariant #-}+v `bindVariant` f  = case popVariantHead v of+   Right x  -> appendVariant @xs (f x)+   Left  xs -> prependVariant @ys xs++-- | Const bind (>>) for a Variant+constBindVariant :: forall xs ys.+   V xs -> V ys -> V (Concat ys xs)+{-# INLINABLE constBindVariant #-}+_ `constBindVariant` v2 = appendVariant @xs v2++ ----------------------------------------------------------- -- Operations by type -----------------------------------------------------------@@ -865,6 +883,10 @@ variantToTuple = hToTuple' . variantToHList  +instance ContVariant xs => MultiCont (V xs) where+   type MultiContTypes (V xs) = xs+   toCont  = variantToCont+   toContM = variantToContM  class ContVariant xs where    -- | Convert a variant into a multi-continuation

@@ -0,0 +1,29 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}++-- | Rebindable syntax for Variant+module Haskus.Utils.Variant.Syntax+   ( (>>=)+   , (>>)+   , return+   )+where++import Haskus.Utils.Variant+import Haskus.Utils.Types+import Haskus.Utils.Types.List++import Prelude hiding ((>>=),(>>),return)++(>>=) :: forall x xs ys. +   ( KnownNat (Length ys)+   ) => V (x ': xs) -> (x -> V ys) -> V (Concat ys xs)+(>>=) = bindVariant++(>>) :: V xs -> V ys -> V (Concat ys xs)+(>>) = constBindVariant++return :: x -> V '[x]+return = variantFromValue