mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
Remove View (#439)
This commit is contained in:
parent
5e638ebfb0
commit
3f965b7947
@ -4,6 +4,7 @@
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
- Removed `Polysemy.View`
|
||||
- Removed `Polysemy.Law`
|
||||
|
||||
### Other Changes
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user