Code Monkey home page Code Monkey logo

freer-effects's Introduction

Freer Effects: Extensible Effects with Freer Monads

Haskell Programming Language BSD3 License

Hackage Stackage LTS 8 Stackage Nightly Hackage Dependencies Build

Description

Library freer-effects (actively maintained fork of freer) is an implementation of effect system for Haskell, which is based on the work of Oleg Kiselyov et al.:

Much of the implementation is a repackaging and cleaning up of the reference materials provided here.

Features

The key features of Freer are:

  • An efficient effect system for Haskell as a library.
  • Implementations for several common Haskell monads as effects:
    • Reader
    • Writer
    • State
    • StateRW: State in terms of Reader/Writer.
    • Trace
    • Exception
  • Core components for defining your own Effects.

Example: Console DSL

Here's what using Freer looks like:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
module Console where

import Control.Monad.Freer
import Control.Monad.Freer.Internal
import System.Exit hiding (ExitSuccess)

--------------------------------------------------------------------------------
                               -- Effect Model --
--------------------------------------------------------------------------------
data Console s where
    PutStrLn    :: String -> Console ()
    GetLine     :: Console String
    ExitSuccess :: Console ()

putStrLn' :: Member Console r => String -> Eff r ()
putStrLn' = send . PutStrLn

getLine' :: Member Console r => Eff r String
getLine' = send GetLine

exitSuccess' :: Member Console r => Eff r ()
exitSuccess' = send ExitSuccess

--------------------------------------------------------------------------------
                          -- Effectful Interpreter --
--------------------------------------------------------------------------------
runConsole :: Eff '[Console] w -> IO w
runConsole (Val x) = return x
runConsole (E u q) =
    case extract u of
        PutStrLn msg -> putStrLn msg >>  runConsole (qApp q ())
        GetLine      -> getLine      >>= \s -> runConsole (qApp q s)
        ExitSuccess  -> exitSuccess

--------------------------------------------------------------------------------
                             -- Pure Interpreter --
--------------------------------------------------------------------------------
runConsolePure :: [String] -> Eff '[Console] w -> [String]
runConsolePure inputs req =
    reverse . snd $ run (handleRelayS (inputs, []) (\s _ -> pure s) go req)
  where
    go  :: ([String], [String])
        -> Console v
        -> (([String], [String]) -> Arr '[] v ([String], [String]))
        -> Eff '[] ([String], [String])
    go (is,   os) (PutStrLn msg) q = q (is, msg : os) ()
    go (i:is, os) GetLine        q = q (is, os) i
    go ([],   _ ) GetLine        _ = error "Not enough lines"
    go (_,    os) ExitSuccess    _ = pure ([], os)

Combining with Transformers

You already have some mtl code and are afraid that combining effects with your current tranformer stack would not be possible? Package freer-effects-extra has some mtl-related and other goodies.

Contributing

Contributions are welcome! Documentation, examples, code, and feedback - they all help.

Developer Setup

The easiest way to start contributing is to install stack. Stack can install GHC/Haskell for you, and automates common developer tasks.

The key commands are:

  • stack setup – install required version of GHC compiler
  • stack build – builds project, dependencies are automatically resolved
  • stack test – builds project, its tests, and executes the tests
  • stack bench – builds project, its benchmarks, and executes the benchamks
  • stack ghci – start a REPL instance with a project modules loaded
  • stack clean
  • stack haddock – builds documentation

For more information about stack tool can be found in its documentation.

Licensing

This project is distrubted under a BSD3 license. See the included LICENSE file for more details.

Acknowledgements

Package freer-effects started as a fork of freer authored by Allele Dev.

This package would not be possible without the paper and the reference implementation. In particular:

There will be deviations from the source.

freer-effects's People

Contributors

elvishjerricco avatar fosskers avatar isovector avatar lazersmoke avatar liskin avatar pseudonom avatar queertypes avatar schell avatar tmcgilchrist avatar trskop avatar xkollar avatar

Stargazers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

Watchers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

freer-effects's Issues

Rename Data.Open.Union to Data.OpenUnion

Each hierarchical part of module name should be significant, in its own right. In case of Data.Open.Union the Open part doesn't make much sense on its own. This issue was raised by @liskin on today's meetup.

Document relation to `freer` better

I'm trying to evaluate the effects ecosystem and was quite confused until I saw an old issue linking to : commercialhaskell/stackage#2239 (comment)

It would be helpful to have a short summary of the situation at the top of the package description (why forked, whether there are plans to merge to upstream, whether changes to freer can be expected to be merged into this package, how it has diverged currently (maybe that's in a changelog, etc.)

In any case, thanks for working on this.

While I'm here, can I ask has using free/your fork worked out well for you? Do you have performance constraints and has the package met them?

Using state requires type signature

main = putStrLn . run . flip execState "Test" $ do
    modify id

Overlapping instances for Data.OpenUnion.Internal.FindElem (State s0) '[State [Char]]

If I type id as String -> String it works but I feel like that the type signature should not be required.

Is it possible to write a continuation effect?

I've been trying to write a Cont effect, where a computation either ends in a value Left a or should be continued later (at your choice) Right eff. Here's my idea so far:

import           Control.Monad                 (when)
import           Control.Monad.Freer           as F
import           Control.Monad.Freer.Coroutine as F
import           Control.Monad.Freer.Exception as F
import           Control.Monad.Freer.Internal
import           Data.Function                 (fix)

newtype AnyIO a = AnyIO (IO a)

io :: Member AnyIO r => IO a -> Eff r a
io = send . AnyIO

runAnyIO :: Member IO r => Eff (AnyIO ': r) a -> Eff r a
runAnyIO = runIt $ \(AnyIO f) -> f
  where runIt :: Member IO r => (forall a. AnyIO a -> IO a)
              -> Eff (AnyIO ': r) w -> Eff r w
        runIt = runNat

data Cont r a where
  Cont :: Eff r a -> Cont r a

cont :: Member (Cont r) r => Eff r a -> Eff r a
cont = send . Cont

runCont :: Eff (Cont r ': r) a -> Eff r (Either a (Eff r a))
runCont = undefined

blah :: (Member AnyIO r, Member (Cont r) r) => Eff r ()
blah = do
  io $ putStrLn "enter something:"
  ln <- io getLine

  when ('x' `elem` ln) $ fix $ \loop -> do
    io $ putStrLn "found an x! will loop getLine until another x is found..."
    ln2 <- io getLine
    if 'x' `elem` ln2
      then io $ putStrLn "found another x, breaking."
      else cont loop

  if 'e' `elem` ln
    then do
      io $ putStrLn "found an e, recursing with Eph"
      cont blah
    else io $ putStrLn "bye!"

The above compiles, but my problem is that I seem to be running into overlapping instances when trying to write the interpreter runCont, as well as writing a concrete effect type, since the type is recursive
type MyEff = Eff '[Cont MyEff, AnyIO] (this will not compile).

Thoughts?

Control.Monad.forever causes <<loop>>

I'm not quite sure of the root cause of this, but I can provide a minimal example of my bug. Any use of forever in an Eff r effect causes ghc to throw a <<loop>> exception. Other forms of loops (tail loops, fix) do not exhibit this bug.

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Tests.Loop
  ( runFixLoop
  , runTailLoop
  , runForeverLoop
  ) where

import           Control.Monad       (forever)
import           Control.Monad.Freer
import           Data.Function       (fix)

-- | This loops forever as expected
fixLoop :: Member IO r => Eff r ()
fixLoop = fix $ \fxLoop -> do
  send $ putStrLn "fixLoop"
  fxLoop

runFixLoop :: IO ()
runFixLoop = runM fixLoop

-- | This loops as expected
tailLoop :: Member IO r => Eff r ()
tailLoop = send (putStrLn "tailLoop") >> tailLoop

runTailLoop :: IO ()
runTailLoop = runM tailLoop

-- | This <<loop>>s.
foreverLoop ::  Member IO r => Eff r ()
foreverLoop = forever $ send $ putStrLn "loop"

runForeverLoop :: IO ()
runForeverLoop = runM foreverLoop

Relax type signature of asks function

Function asks currently it has:

asks :: (e -> a) -> Eff '[Reader e] a

Which is very specific and should be relaxed using Member (Reader e) effs constraint.

Active maintenance?

Hi IxpertaSolutions -- this project seems to be inactive, but we’re using it to great success at Takt (takt.com). Would you like some help maintaining it, if not having us taking it over? We can throw some full-time resources at the task :)

TemplateHaskell for convenience funtions

Let us have a look at the example code.

data Console s where
    PutStrLn :: String -> Console ()
    GetLine :: Console String

putStrLn :: Member Console r => String -> Eff r ()
putStrLn = send . PutStrLn

getLine :: Member Console r => Eff r String
getLine = send GetLine

It seems like putStrLn and getLine is very boilerplaty and could be generated by TH.

build failure: NonDet not in scope

As seen on the stackage build server:

[8 of 9] Compiling NonDet           ( examples/src/NonDet.hs, dist/build/freer-examples/freer-examples-tmp/NonDet.o )

examples/src/NonDet.hs:8:16: error:
    Not in scope: type constructor or class ‘NonDet’
  |
8 | ifte :: Member NonDet r
  |                ^^^^^^

examples/src/NonDet.hs:12:20: error:
    Not in scope: type constructor or class ‘NonDet’
   |
12 | testIfte :: Member NonDet r => Eff r Int
   |                    ^^^^^^

Include remarks from (or compare to) extensible-streaming

From researching what has been implemented around freer-effects I stumbled upon
https://github.com/michaelt/extensible-streaming
mentionened here at reddit while discussing some benchmarks (there extensible-streaming was faster than freer).

A deeper look at the implementation of extensible-streaming, i.e.
https://github.com/michaelt/extensible-streaming/blob/master/Data/Functor/Effs.hs and https://github.com/michaelt/extensible-streaming/blob/master/Streaming/Extensible.hs (that is the whole implementation),
suggests that the author had a lot to say how to even "improve" or alter freer in a for him sensible manner.
The code is extremely simple and extremely well documented.

Further researches through the web however haven't revealed anything more on the relationship between extensible-streaming and extensible freer-effects. Especially no one from the freer side seem to have ever reacted on extensible-streaming (to the best of my knowledge).

Do you have some remarks / more details on this? Maybe extensible-streaming is the way to go?

Functor/Foldable/Traversable/Applicative instances for Union?

It would be amazing if you could provide instances of these classes for Data.OpenUnion. Here's how I implemented Functor:

type family ConstrainedMembers constr l = (r :: Constraint) where
  ConstrainedMembers constr (t ': c) = (constr t, ConstrainedMembers constr c)
  ConstrainedMembers constr '[] = ()

instance {-#OVERLAPPING#-} Functor (Union '[]) where
  fmap f a = error "Absurd?"
instance {-#OVERLAPPING#-} (ConstrainedMembers Functor f, r ~ (h : tail), Functor (Union tail)) => Functor (Union r) where
  fmap f a = case decomp a of
                       Right t -> inj (fmap f t)
                       Left remainder -> weaken (fmap f remainder)

As you can see, it's pretty ugly and it took quite a while to get everything just right. I'm scared of doing the rest!

Create module for NonDetEff consider also renaming the effect

NonDetEff is the only effect exported from the top module, which is inconsistent with the rest. Its definition has to stay in the Control.Monad.Freer.Internal module, to avoid orphan instances, but it still should have its own module. Functions makeChoiceA and msplit should be moved in to that newly created module.

Decided by @liskin, @xkollar, @Siprj and I.

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.