fraxl 0.2.0.1 → 0.3.0.0

raw patch · 4 files changed

+39/−66 lines, 4 filesdep +fastsumdep −vinylPVP ok

version bump matches the API change (PVP)

Dependencies added: fastsum

Dependencies removed: vinyl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• fraxl.cabal +4/−4
• src/Control/Monad/Fraxl/Class.hs +4/−4
• src/Control/Monad/Trans/Fraxl.hs +28/−58

@@ -0,0 +1,3 @@+0.3.0.0 [2019.02.07]+--+Switched from vinyl to fastsum

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: fraxl-version: 0.2.0.1+version: 0.3.0.0 license: BSD3 license-file: LICENSE copyright: 2016 Will Fancher@@ -14,6 +14,7 @@ build-type: Simple extra-source-files:     README.md+    CHANGELOG.md  source-repository head     type: git@@ -42,8 +43,8 @@         mtl >=2.2.2 && <2.3,         dependent-sum ==0.4.*,         dependent-map >=0.2.4.0 && <0.3,-        vinyl >=0.6 && <0.9,-        type-aligned >=0.9.6 && <0.10+        type-aligned >=0.9.6 && <0.10,+        fastsum >=0.1.0.0 && <0.2  executable examples     main-is: Main.hs@@ -52,7 +53,6 @@     ghc-options: -Wall      if flag(install-examples)-        buildable: True         build-depends:             base -any,             fraxl -any,

@@ -35,8 +35,8 @@                                                as Lazy import qualified Control.Monad.Trans.Writer.Strict                                                as Strict-import           Data.Vinyl-import           Data.Vinyl.CoRec+import qualified Data.Sum  as Sum+import           GHC.TypeNats  -- | Class for Fraxl-capable monads. class Monad m => MonadFraxl f m where@@ -45,8 +45,8 @@   default dataFetch :: (MonadTrans t, MonadFraxl f n, t n ~ m) => f a -> m a   dataFetch = lift . dataFetch -instance (Monad m, f ∈ r) => MonadFraxl f (Fraxl r m) where-  dataFetch = liftF . liftAp . Union . CoRec . Flap+instance (Monad m, KnownNat (Sum.ElemIndex f r)) => MonadFraxl f (Fraxl r m) where+  dataFetch = liftF . liftAp . Union . Sum.inject  instance Monad m => MonadFraxl f (FreerT f m) where   dataFetch = liftF . liftAp

@@ -1,14 +1,14 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}  module Control.Monad.Trans.Fraxl   (@@ -37,7 +37,6 @@   -- * Union   , Union(..)   , unconsCoRec-  , Flap(..)   ) where  import           Control.Applicative.Free.Fast@@ -48,14 +47,10 @@ import           Control.Monad.IO.Class import           Control.Monad.State import           Control.Monad.Trans.Fraxl.Free-import           Data.Dependent.Map (DMap)-import qualified Data.Dependent.Map as DMap+import           Data.Dependent.Map             (DMap)+import qualified Data.Dependent.Map             as DMap import           Data.GADT.Compare-import           Data.Maybe (fromJust)-import           Data.Vinyl-import           Data.Vinyl.CoRec-import           Data.Vinyl.Functor (Compose(..), (:.))-import           Data.Vinyl.TypeLevel+import           Data.Sum  -- | Fraxl is based on a particular Freer monad. -- This Freer monad has applicative optimization,@@ -78,7 +73,7 @@ fetchNil _ = error "Not possible - empty union"  -- | Like '(:)' for constructing @Fetch (Union (f ': r))@-(|:|) :: forall f r a m. (Monad m, RecApplicative r, FoldRec r r)+(|:|) :: forall f r a m. (Monad m)        => (forall a'. Fetch f m a')        -> (forall a'. Fetch (Union r) m a')        -> Fetch (Union (f ': r)) m a@@ -89,7 +84,7 @@            -> m (ASeq m x, ASeq m y, ASeq m z)   runUnion flist ulist ANil = (, , ANil) <$> fetch flist <*> fetchU ulist   runUnion flist ulist (ACons (Union u) us) = case unconsCoRec u of-    Left (Flap fa) -> fmap+    Left fa -> fmap       (\(ACons ma ms, other, rest) -> (ms, other, ACons ma rest))       (runUnion (ACons fa flist) ulist us)     Right u' -> fmap@@ -180,55 +175,30 @@                    => (forall a'. Fetch f m a') -> FreerT f m a -> m a evalCachedFraxl fetch a = fst <$> runCachedFraxl fetch a DMap.empty -class RIndex t ts ~ i => FMatch1 t ts i where-  fmatch1' :: Handler r (f t) -> Rec (Maybe :. f) ts -> Either r (Rec (Maybe :. f) (RDelete t ts))+unconsCoRec :: Sum (t ': ts) f -> Either (t f) (Sum ts f)+unconsCoRec s = case decompose s of+  Left s'     -> Right s'+  Right found -> Left found -instance FMatch1 t (t ': ts) 'Z where-  fmatch1' _ (Compose Nothing :& xs) = Right xs-  fmatch1' (H h) (Compose (Just x) :& _) = Left (h x) -instance (FMatch1 t ts i, RIndex t (s ': ts) ~ 'S i,-          RDelete t (s ': ts) ~ (s ': RDelete t ts))-         => FMatch1 t (s ': ts) ('S i) where-  fmatch1' h (x :& xs) = (x :&) <$> fmatch1' h xs---- | Handle a single variant of a 'CoRec': either the function is--- applied to the variant or the type of the 'CoRec' is refined to--- reflect the fact that the variant is /not/ compatible with the type--- of the would-be handler-fmatch1 :: (FMatch1 t ts (RIndex t ts),-            RecApplicative ts,-            FoldRec (RDelete t ts) (RDelete t ts))-        => Handler r (f t)-        -> CoRec f ts-        -> Either r (CoRec f (RDelete t ts))-fmatch1 h = fmap (fromJust . firstField)-          . fmatch1' h-          . coRecToRec--unconsCoRec :: (RecApplicative ts, FoldRec ts ts) => CoRec f (t ': ts) -> Either (f t) (CoRec f ts)-unconsCoRec = fmatch1 (H id)--newtype Flap a f = Flap (f a)- -- | @Union@ represents a value of any type constructor in @r@ applied with @a@.-newtype Union r a = Union (CoRec (Flap a) r)+newtype Union ts f = Union (Sum ts f)  instance GEq (Union '[]) where   _ `geq` _ = error "Not possible - empty union" -instance (RecApplicative r, FoldRec r r, GEq f, GEq (Union r)) => GEq (Union (f ': r)) where+instance (GEq f, GEq (Union r)) => GEq (Union (f ': r)) where   Union a `geq` Union b = case (unconsCoRec a, unconsCoRec b) of-    (Left (Flap fa), Left (Flap fb)) -> fa `geq` fb+    (Left fa, Left fb)   -> fa `geq` fb     (Right a', Right b') -> Union a' `geq` Union b'-    _ -> Nothing+    _                    -> Nothing  instance GCompare (Union '[]) where   _ `gcompare` _ = error "Not possible - empty union" -instance (RecApplicative r, FoldRec r r, GCompare f, GCompare (Union r)) => GCompare (Union (f ': r)) where+instance (GCompare f, GCompare (Union r)) => GCompare (Union (f ': r)) where   Union a `gcompare` Union b = case (unconsCoRec a, unconsCoRec b) of-    (Left (Flap fa), Left (Flap fb)) -> fa `gcompare` fb-    (Right a', Right b')             -> Union a' `gcompare` Union b'-    (Left _, Right _)                -> GLT-    (Right _, Left _)                -> GGT+    (Left fa, Left fb)   -> fa `gcompare` fb+    (Right a', Right b') -> Union a' `gcompare` Union b'+    (Left _, Right _)    -> GLT+    (Right _, Left _)    -> GGT