mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 10:36:40 +03:00
Small code simplifications (#360)
* Small code simplifications These are all replacements of the form before: fmap f $ x after: f <$> x Minor change, but feels marginally easier to read to me. Co-authored-by: TheMatten <matten@tuta.io>
This commit is contained in:
parent
e99cb94305
commit
235813da00
@ -199,7 +199,7 @@ exactlyOneWantedForR wanteds
|
||||
-- work?
|
||||
. fmap (second (/= 1))
|
||||
. countLength
|
||||
$ fmap (OrdType . fcRow) wanteds
|
||||
$ OrdType . fcRow <$> wanteds
|
||||
|
||||
|
||||
solveFundep
|
||||
@ -241,4 +241,3 @@ solveFundep (ref, stuff) given _ wanted = do
|
||||
tcPluginIO $ modifyIORef ref $ S.union $ S.fromList unifications
|
||||
|
||||
pure $ TcPluginOk (solveBogusError stuff wanted) new_wanteds
|
||||
|
||||
|
@ -21,7 +21,7 @@ whenA
|
||||
-> m a
|
||||
-> m (z a)
|
||||
whenA False _ = pure empty
|
||||
whenA True ma = fmap pure ma
|
||||
whenA True ma = pure <$> ma
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@ -30,4 +30,3 @@ countLength :: Eq a => [a] -> [(a, Int)]
|
||||
countLength as =
|
||||
let grouped = group as
|
||||
in zipWith (curry $ bimap head length) grouped grouped
|
||||
|
||||
|
@ -78,7 +78,7 @@ asyncToIO m = withLowerToIO $ \lower _ -> lower $
|
||||
ma <- runT a
|
||||
ins <- getInspectorT
|
||||
fa <- embed $ A.async $ lower $ asyncToIO ma
|
||||
pureT $ fmap (inspect ins) fa
|
||||
pureT $ inspect ins <$> fa
|
||||
|
||||
Await a -> pureT =<< embed (A.wait a)
|
||||
Cancel a -> pureT =<< embed (A.cancel a)
|
||||
@ -132,7 +132,7 @@ lowerAsync lower m = interpretH
|
||||
ma <- runT a
|
||||
ins <- getInspectorT
|
||||
fa <- embed $ A.async $ lower $ lowerAsync lower ma
|
||||
pureT $ fmap (inspect ins) fa
|
||||
pureT $ inspect ins <$> fa
|
||||
|
||||
Await a -> pureT =<< embed (A.wait a)
|
||||
Cancel a -> pureT =<< embed (A.cancel a)
|
||||
|
@ -69,5 +69,4 @@ lowerEmbedded run_m (Sem m) = withLowerToIO $ \lower _ ->
|
||||
$ hoist (lowerEmbedded run_m) x
|
||||
|
||||
Right (Weaving (Embed wd) s _ y _) ->
|
||||
fmap y $ fmap (<$ s) wd
|
||||
|
||||
y <$> ((<$ s) <$> wd)
|
||||
|
@ -52,7 +52,7 @@ runInputList is = fmap snd . runState is . reinterpret
|
||||
Input -> do
|
||||
s <- gets uncons
|
||||
for_ s $ put . snd
|
||||
pure $ fmap fst s
|
||||
pure $ fst <$> s
|
||||
)
|
||||
{-# INLINE runInputList #-}
|
||||
|
||||
@ -63,4 +63,3 @@ runInputSem :: forall i r a. Sem r i -> Sem (Input i ': r) a -> Sem r a
|
||||
runInputSem m = interpret $ \case
|
||||
Input -> m
|
||||
{-# INLINE runInputSem #-}
|
||||
|
||||
|
@ -260,7 +260,7 @@ usingSem k m = runSem m k
|
||||
|
||||
|
||||
instance Functor (Sem f) where
|
||||
fmap f (Sem m) = Sem $ \k -> fmap f $ m k
|
||||
fmap f (Sem m) = Sem $ \k -> f <$> m k
|
||||
{-# INLINE fmap #-}
|
||||
|
||||
|
||||
|
@ -107,7 +107,7 @@ interpretInStateT f s (Sem m) = Sem $ \k ->
|
||||
(Just . snd)
|
||||
$ x
|
||||
Right (Weaving e z _ y _) ->
|
||||
fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e
|
||||
y . (<$ z) <$> S.mapStateT (usingSem k) (f e)
|
||||
{-# INLINE interpretInStateT #-}
|
||||
|
||||
|
||||
@ -129,7 +129,7 @@ interpretInLazyStateT f s (Sem m) = Sem $ \k ->
|
||||
(Just . snd)
|
||||
$ x
|
||||
Right (Weaving e z _ y _) ->
|
||||
fmap (y . (<$ z)) $ LS.mapStateT (usingSem k) $ f e
|
||||
y . (<$ z) <$> LS.mapStateT (usingSem k) (f e)
|
||||
{-# INLINE interpretInLazyStateT #-}
|
||||
|
||||
|
||||
@ -342,7 +342,7 @@ interceptUsingH
|
||||
interceptUsingH pr f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
case prjUsing pr u of
|
||||
Just (Weaving e s d y v) ->
|
||||
usingSem k $ fmap y $ runTactics s (raise . d) v $ f e
|
||||
usingSem k $ y <$> runTactics s (raise . d) v (f e)
|
||||
Nothing -> k $ hoist (interceptUsingH pr f) u
|
||||
{-# INLINE interceptUsingH #-}
|
||||
|
||||
@ -379,4 +379,3 @@ transform f (Sem m) = Sem $ \k -> m $ \u ->
|
||||
Left g -> g
|
||||
Right (Weaving e s wv ex ins) ->
|
||||
injWeaving (Weaving (f e) s wv ex ins)
|
||||
|
||||
|
@ -100,7 +100,7 @@ pureS a = pure . (a <$) <$> getInitialStateS
|
||||
liftS :: Functor m => m a -> Strategic m n a
|
||||
liftS m = do
|
||||
s <- getInitialStateS
|
||||
pure $ fmap (<$ s) m
|
||||
pure $ (<$ s) <$> m
|
||||
{-# INLINE liftS #-}
|
||||
|
||||
|
||||
@ -128,4 +128,3 @@ runS na = bindS (const na) <*> getInitialStateS
|
||||
bindS :: (a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
|
||||
bindS = send . HoistInterpretation
|
||||
{-# INLINE bindS #-}
|
||||
|
||||
|
@ -172,7 +172,7 @@ makeSemType r result = ConT ''Sem `AppT` VarT r `AppT` result
|
||||
-- the 'ConLiftInfo'.
|
||||
makeUnambiguousSend :: Bool -> ConLiftInfo -> Exp
|
||||
makeUnambiguousSend should_make_sigs cli =
|
||||
let fun_args_names = fmap fst $ cliFunArgs cli
|
||||
let fun_args_names = fst <$> cliFunArgs cli
|
||||
action = foldl1' AppE
|
||||
$ ConE (cliConName cli) : (VarE <$> fun_args_names)
|
||||
eff = foldl' AppT (ConT $ cliEffName cli) $ args
|
||||
|
@ -161,7 +161,7 @@ genSig cli
|
||||
-- @x a b c = send (X a b c :: E m a)@.
|
||||
genDec :: Bool -> ConLiftInfo -> Q [Dec]
|
||||
genDec should_mk_sigs cli = do
|
||||
let fun_args_names = fmap fst $ cliFunArgs cli
|
||||
let fun_args_names = fst <$> cliFunArgs cli
|
||||
|
||||
pure
|
||||
[ PragmaD $ InlineP (cliFunName cli) Inlinable ConLike AllPhases
|
||||
|
@ -67,7 +67,7 @@ data Union (r :: EffectRow) (mWoven :: Type -> Type) a where
|
||||
-> Union r m a
|
||||
|
||||
instance Functor (Union r mWoven) where
|
||||
fmap f (Union w t) = Union w $ fmap f t
|
||||
fmap f (Union w t) = Union w $ f <$> t
|
||||
{-# INLINE fmap #-}
|
||||
|
||||
|
||||
|
@ -59,7 +59,7 @@ writerToEndoWriter = interpretH $ \case
|
||||
id
|
||||
(\(f, _) (Endo oo) -> let !o' = f (oo mempty) in Endo (o' <>))
|
||||
(inspect ins t)
|
||||
return (f', fmap snd t)
|
||||
return (f', snd <$> t)
|
||||
{-# INLINE writerToEndoWriter #-}
|
||||
|
||||
|
||||
|
@ -41,7 +41,7 @@ runNonDetMaybe (Sem sem) = Sem $ \k -> runMaybeT $ sem $ \u ->
|
||||
case e of
|
||||
Empty -> empty
|
||||
Choose left right ->
|
||||
MaybeT $ usingSem k $ runMaybeT $ fmap ex $ do
|
||||
MaybeT $ usingSem k $ runMaybeT $ fmap ex $
|
||||
MaybeT (runNonDetMaybe (wv (left <$ s)))
|
||||
<|> MaybeT (runNonDetMaybe (wv (right <$ s)))
|
||||
Left x -> MaybeT $
|
||||
|
@ -55,7 +55,7 @@ makeSem ''State
|
||||
|
||||
|
||||
gets :: forall s a r. Member (State s) r => (s -> a) -> Sem r a
|
||||
gets f = fmap f get
|
||||
gets f = f <$> get
|
||||
{-# INLINABLE gets #-}
|
||||
|
||||
|
||||
@ -251,12 +251,11 @@ hoistStateIntoStateT (Sem m) = m $ \u ->
|
||||
Left x -> S.StateT $ \s ->
|
||||
liftSem . fmap swap
|
||||
. weave (s, ())
|
||||
(\(s', m') -> fmap swap
|
||||
$ S.runStateT m' s')
|
||||
(\(s', m') -> swap <$> S.runStateT m' s')
|
||||
(Just . snd)
|
||||
$ hoist hoistStateIntoStateT x
|
||||
Right (Weaving Get z _ y _) -> fmap (y . (<$ z)) $ S.get
|
||||
Right (Weaving (Put s) z _ y _) -> fmap (y . (<$ z)) $ S.put s
|
||||
Right (Weaving Get z _ y _) -> y . (<$ z) <$> S.get
|
||||
Right (Weaving (Put s) z _ y _) -> y . (<$ z) <$> S.put s
|
||||
{-# INLINE hoistStateIntoStateT #-}
|
||||
|
||||
|
||||
@ -269,4 +268,3 @@ hoistStateIntoStateT (Sem m) = m $ \u ->
|
||||
forall s e (f :: forall m x. e m x -> Sem (State s ': r) x).
|
||||
runLazyState s (reinterpret f e) = lazilyStateful (\x s' -> runLazyState s' $ f x) s e
|
||||
#-}
|
||||
|
||||
|
@ -45,7 +45,7 @@ censor :: Member (Writer o) r
|
||||
=> (o -> o)
|
||||
-> Sem r a
|
||||
-> Sem r a
|
||||
censor f m = pass (fmap (f ,) m)
|
||||
censor f m = pass $ (f ,) <$> m
|
||||
{-# INLINE censor #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@ -75,14 +75,14 @@ runWriter = runState mempty . reinterpretH
|
||||
-- TODO(sandy): this is stupid
|
||||
(o, fa) <- raise $ runWriter mm
|
||||
modify' (<> o)
|
||||
pure $ fmap (o, ) fa
|
||||
pure $ (o, ) <$> fa
|
||||
Pass m -> do
|
||||
mm <- runT m
|
||||
(o, t) <- raise $ runWriter mm
|
||||
ins <- getInspectorT
|
||||
let f = maybe id fst (inspect ins t)
|
||||
modify' (<> f o)
|
||||
pure (fmap snd t)
|
||||
pure $ snd <$> t
|
||||
)
|
||||
{-# INLINE runWriter #-}
|
||||
|
||||
@ -112,7 +112,7 @@ runLazyWriter = interpretViaLazyWriter $ \(Weaving e s wv ex ins) ->
|
||||
Lazy.pass $ do
|
||||
ft <- m'
|
||||
let f = maybe id fst (ins ft)
|
||||
return (ex (fmap snd ft), f)
|
||||
return (ex $ snd <$> ft, f)
|
||||
{-# INLINE runLazyWriter #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
|
@ -82,7 +82,7 @@ spec = parallel $ describe "fixpointToFinal on Identity" $ do
|
||||
it "should work with runState" $ do
|
||||
test1 `shouldBe` ("12", (2, ()))
|
||||
it "should work with runError" $ do
|
||||
let res = fmap (take 10) test2
|
||||
let res = take 10 <$> test2
|
||||
res `shouldBe` Right (take 10 $ cycle [1,2])
|
||||
it "should not trigger the bomb" $ do
|
||||
test3 `shouldBe` Left ()
|
||||
|
Loading…
Reference in New Issue
Block a user