diff --git a/ChangeLog.md b/ChangeLog.md index b6d9e4d..c2cef9a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,6 +4,7 @@ ### Breaking Changes +- Removed `Polysemy.View` - Removed `Polysemy.Law` ### Other Changes diff --git a/polysemy.cabal b/polysemy.cabal index 4791c63..afafb35 100644 --- a/polysemy.cabal +++ b/polysemy.cabal @@ -76,7 +76,6 @@ library Polysemy.State Polysemy.Tagged Polysemy.Trace - Polysemy.View Polysemy.Writer other-modules: Polysemy.Internal.PluginLookup @@ -147,7 +146,6 @@ test-suite polysemy-test TacticsSpec ThEffectSpec TypeErrors - ViewSpec WriterSpec Paths_polysemy Build_doctests diff --git a/src/Polysemy/View.hs b/src/Polysemy/View.hs deleted file mode 100644 index 6e86acc..0000000 --- a/src/Polysemy/View.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Polysemy.View - ( -- * Effect - View (..) - - -- * Actions - , see - - -- * Interpretations - , viewToState - , viewToInput - ) where - -import Polysemy -import Polysemy.Input -import Polysemy.State -import Polysemy.Tagged - - ------------------------------------------------------------------------------- --- | A 'View' is an expensive computation that should be cached. -data View v m a where - See :: View v m v - -makeSem ''View - - ------------------------------------------------------------------------------- --- | Transform a 'View' into an 'Input'. -viewToInput - :: forall v i r a - . Member (Input i) r - => (i -> v) - -> Sem (View v ': r) a - -> Sem r a -viewToInput f = interpret $ \case - See -> f <$> input - - ------------------------------------------------------------------------------- --- | Get a 'View' as an exensive computation over an underlying 'State' effect. --- This 'View' is only invalidated when the underlying 'State' changes. -viewToState - :: forall v s r a - . Member (State s) r - => (s -> Sem r v) - -> Sem (View v ': r) a - -> Sem r a -viewToState f = do - evalState Dirty - . untag @"view" @(State (Cached v)) - . intercept @(State s) - ( \case - Get -> get - Put s -> do - put s - tag @"view" @(State (Cached v)) $ put $ Dirty @v - ) - . reinterpret @(View v) - ( \case - See -> do - dirty <- tagged @"view" $ get @(Cached v) - case dirty of - Dirty -> do - s <- get - v' <- raise $ f s - tagged @"view" $ put $ Cached v' - pure v' - Cached v -> pure v - ) - - -data Cached a = Cached a | Dirty - deriving (Eq, Ord, Show, Functor) - diff --git a/test/ViewSpec.hs b/test/ViewSpec.hs deleted file mode 100644 index 61baaec..0000000 --- a/test/ViewSpec.hs +++ /dev/null @@ -1,40 +0,0 @@ -module ViewSpec where - -import Polysemy -import Polysemy.State -import Polysemy.Trace -import Polysemy.View -import Test.Hspec - - -check_see :: Members '[View String, Trace] r => Sem r () -check_see = trace . ("saw " ++) =<< see - -spec :: Spec -spec = parallel $ do - describe "View effect" $ do - it "should cache views" $ do - let a = run - . runTraceList - . runState @Int 0 - . viewToState @String @Int (\i -> do - trace $ "caching " ++ show i - pure $ show i ) $ do - check_see - check_see - put @Int 3 - trace "it's lazy" - put @Int 5 - check_see - check_see - get @Int - - a `shouldBe` ([ "caching 0" - , "saw 0" - , "saw 0" - , "it's lazy" - , "caching 5" - , "saw 5" - , "saw 5" - ], (5, 5)) -