Updates for 0.12 by garyb · Pull Request #97 · purescript/purescript-free · GitHub
Skip to content

Updates for 0.12 #97

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
garyb merged 4 commits into from
May 23, 2018
Merged

Updates for 0.12 #97

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
830d139
use ((->) Unit) instead of Lazy
safareli Apr 24, 2017
955eba3
Updates for 0.12
garyb Apr 25, 2018
c3bec77
Merge pull request #85 from safareli/lazytoarr
garyb May 22, 2018
37d5b35
Update dependencies, license
garyb May 23, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 23 additions & 17 deletions LICENSE
View file
Open in desktop
26 changes: 17 additions & 9 deletions bower.json
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,15 +1,14 @@
{
"name": "purescript-free",
"homepage": "https://github.com/purescript/purescript-free",
"description": "Free, Cofree, Yoneda, Coyoneda, Trampoline",
"authors": [
"Eric Thul <thul.eric@gmail.com>",
"Brian McKenna <brian@brianmckenna.org>",
"John A. De Goes <john@degoes.net> (http://degoes.net)",
"Gary Burgess <gary.burgess@gmail.com>",
"Phil Freeman <paf31@cantab.net>"
],
"license": "MIT",
"license": "BSD-3-Clause",
"repository": {
"type": "git",
"url": "git://github.com/purescript/purescript-free.git"
Expand All @@ -24,14 +23,23 @@
"package.json"
],
"dependencies": {
"purescript-catenable-lists": "^4.0.0",
"purescript-exists": "^3.0.0",
"purescript-transformers": "^3.0.0",
"purescript-unsafe-coerce": "^3.0.0",
"purescript-control": "^3.0.0"
"purescript-catenable-lists": "^5.0.0",
"purescript-control": "^4.0.0",
"purescript-distributive": "^4.0.0",
"purescript-either": "^4.0.0",
"purescript-exists": "^4.0.0",
"purescript-foldable-traversable": "^4.0.0",
"purescript-invariant": "^4.0.0",
"purescript-lazy": "^4.0.0",
"purescript-maybe": "^4.0.0",
"purescript-prelude": "^4.0.0",
"purescript-tailrec": "^4.0.0",
"purescript-transformers": "^4.0.0",
"purescript-tuples": "^5.0.0",
"purescript-unsafe-coerce": "^4.0.0"
},
"devDependencies": {
"purescript-console": "^3.0.0",
"purescript-functors": "^2.0.0"
"purescript-console": "^4.0.0",
"purescript-functors": "^3.0.0"
}
}
6 changes: 3 additions & 3 deletions package.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@
"test": "pulp test"
},
"devDependencies": {
"pulp": "^10.0.4",
"purescript-psa": "^0.5.0-rc.1",
"rimraf": "^2.6.1"
"pulp": "^12.2.x",
"purescript-psa": "^0.6.x",
"rimraf": "^2.6.2"
}
}
2 changes: 1 addition & 1 deletion src/Control/Comonad/Cofree.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ instance foldableCofree :: Foldable f => Foldable (Cofree f) where
go fa = f (head fa) <> (foldMap go (tail fa))

instance traversableCofree :: Traversable f => Traversable (Cofree f) where
sequence = traverse id
sequence = traverse identity
traverse f = loop
where
loop ta = mkCofree <$> f (head ta) <*> (traverse loop (tail ta))
Expand Down
2 changes: 1 addition & 1 deletion src/Control/Monad/Free.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ instance traversableFree :: Traversable f => Traversable (Free f) where
go = resume >>> case _ of
Left fa -> join <<< liftF <$> traverse go fa
Right a -> pure <$> f a
sequence tma = traverse id tma
sequence tma = traverse identity tma

-- | Lift an impure value described by the generating type constructor `f` into
-- | the free monad.
Expand Down
19 changes: 4 additions & 15 deletions src/Control/Monad/Trampoline.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,40 +5,29 @@
module Control.Monad.Trampoline
( Trampoline
, done
, suspend
, delay'
, delay
, runTrampoline
) where

import Prelude

import Control.Monad.Free (Free, liftF, runFree, suspendF)
import Control.Monad.Free (Free, liftF, runFree)

import Data.Lazy (Lazy, force, defer)

-- | The `Trampoline` monad
-- |
-- | A computation of type `Trampoline a` consists of zero or more lazy
-- | suspensions before a value is returned.
type Trampoline = Free Lazy
type Trampoline = Free ((->) Unit)

-- | Return a value immediately
done :: forall a. a -> Trampoline a
done = pure

-- | Suspend a computation by one step.
suspend :: forall a. Trampoline a -> Trampoline a
suspend = suspendF

-- | Use the `Trampoline` monad to represent a `Lazy` value.
delay' :: forall a. Lazy a -> Trampoline a
delay' = liftF

-- | Use the `Trampoline` monad to represent the delayed evaluation of a value.
delay :: forall a. (Unit -> a) -> Trampoline a
delay = delay' <<< defer
delay = liftF

-- | Run a computation in the `Trampoline` monad.
runTrampoline :: forall a. Trampoline a -> a
runTrampoline = runFree force
runTrampoline = runFree (_ $ unit)
16 changes: 8 additions & 8 deletions src/Data/Coyoneda.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,11 +40,11 @@ data CoyonedaF f a i = CoyonedaF (i -> a) (f i)
-- | hoistCoyoneda nat`:
-- | ```purescript
-- | lowerCoyoneda <<< hoistCoyoneda nat <<< liftCoyoneda $ fi
-- | = lowerCoyoneda (hoistCoyoneda nat (Coyoneda $ mkExists $ CoyonedaF id fi)) (by definition of liftCoyoneda)
-- | = lowerCoyoneda (coyoneda id (nat fi)) (by definition of hoistCoyoneda)
-- | = unCoyoneda map (coyoneda id (nat fi)) (by definition of lowerCoyoneda)
-- | = unCoyoneda map (Coyoneda $ mkExists $ CoyonedaF id (nat fi)) (by definition of coyoneda)
-- | = map id (nat fi) (by definition of unCoyoneda)
-- | = lowerCoyoneda (hoistCoyoneda nat (Coyoneda $ mkExists $ CoyonedaF identity fi)) (by definition of liftCoyoneda)
-- | = lowerCoyoneda (coyoneda identity (nat fi)) (by definition of hoistCoyoneda)
-- | = unCoyoneda map (coyoneda identity (nat fi)) (by definition of lowerCoyoneda)
-- | = unCoyoneda map (Coyoneda $ mkExists $ CoyonedaF identity (nat fi)) (by definition of coyoneda)
-- | = map identity (nat fi) (by definition of unCoyoneda)
-- | = nat fi (since g is a Functor)
-- | ```
newtype Coyoneda f a = Coyoneda (Exists (CoyonedaF f a))
Expand Down Expand Up @@ -154,15 +154,15 @@ unCoyoneda f (Coyoneda e) = runExists (\(CoyonedaF k fi) -> f k fi) e
-- | = liftCoyoneda <<< unCoyoneda map $ (Coyoneda e)
-- | = liftCoyonead (runExists (\(CoyonedaF k fi) -> map k fi) e)
-- | = liftCoyonead (Coyoneda e)
-- | = coyoneda id (Coyoneda e)
-- | = coyoneda identity (Coyoneda e)
-- | = Coyoneda e
-- | ```
-- | Moreover if `f` is a `Functor` then `liftCoyoneda` is an isomorphism of
-- | functors with inverse `lowerCoyoneda`: we already showed that
-- | `lowerCoyoneda <<< hoistCoyoneda id = lowerCoyoneda` is its left inverse
-- | `lowerCoyoneda <<< hoistCoyoneda identity = lowerCoyoneda` is its left inverse
-- | whenever `f` is a functor.
liftCoyoneda :: forall f. f ~> Coyoneda f
liftCoyoneda = coyoneda id
liftCoyoneda = coyoneda identity

-- | Lower a value of type `Coyoneda f a` to the `Functor` `f`.
lowerCoyoneda :: forall f. Functor f => Coyoneda f ~> f
Expand Down
8 changes: 4 additions & 4 deletions src/Data/Yoneda.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,21 +36,21 @@ instance functorYoneda :: Functor (Yoneda f) where
map f m = Yoneda (\k -> runYoneda m (k <<< f))

instance applyYoneda :: Apply f => Apply (Yoneda f) where
apply (Yoneda f) (Yoneda g) = Yoneda (\k -> f (compose k) <*> g id)
apply (Yoneda f) (Yoneda g) = Yoneda (\k -> f (compose k) <*> g identity)

instance applicativeYoneda :: Applicative f => Applicative (Yoneda f) where
pure = liftYoneda <<< pure

instance bindYoneda :: Bind f => Bind (Yoneda f) where
bind (Yoneda f) g = Yoneda (\k -> f id >>= \a -> runYoneda (g a) k)
bind (Yoneda f) g = Yoneda (\k -> f identity >>= \a -> runYoneda (g a) k)

instance monadYoneda :: Monad f => Monad (Yoneda f)

instance monadTransYoneda :: MonadTrans Yoneda where
lift = liftYoneda

instance extendYoneda :: Extend w => Extend (Yoneda w) where
extend f (Yoneda w) = Yoneda (\k -> k <<< f <<< liftYoneda <<= w id)
extend f (Yoneda w) = Yoneda (\k -> k <<< f <<< liftYoneda <<= w identity)

instance comonadYoneda :: Comonad w => Comonad (Yoneda w) where
extract = extract <<< lowerYoneda
Expand All @@ -65,7 +65,7 @@ liftYoneda m = Yoneda (\k -> k <$> m)

-- | Lower a value of type `Yoneda f a` to the type constructor `f`.
lowerYoneda :: forall f a. Yoneda f a -> f a
lowerYoneda (Yoneda k) = k id
lowerYoneda (Yoneda k) = k identity

-- | Use a natural transformation to change the generating type constructor of a
-- | `Yoneda`.
Expand Down
17 changes: 8 additions & 9 deletions test/Test/Control/Monad/Free/Coproduct.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,10 @@ module Test.Control.Monad.Free.Coproduct where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Free (Free, liftF, hoistFree, foldFree)

import Data.Functor.Coproduct (Coproduct, coproduct, left, right)
import Effect (Effect)
import Effect.Console (log)

data Teletype1F a = Print1 String a

Expand Down Expand Up @@ -45,20 +44,20 @@ t = hoistFree (right <<< right) (print3 "3")
u :: T Unit
u = r *> s *> t

teletype1N :: forall eff. Teletype1F ~> Eff (console :: CONSOLE | eff)
teletype1N :: Teletype1F ~> Effect
teletype1N (Print1 x a) = const a <$> log ("teletype1: " <> x)

teletype2N :: forall eff. Teletype2F ~> Eff (console :: CONSOLE | eff)
teletype2N :: Teletype2F ~> Effect
teletype2N (Print2 x a) = const a <$> log ("teletype2: " <> x)

teletype3N :: forall eff. Teletype3F ~> Eff (console :: CONSOLE | eff)
teletype3N :: Teletype3F ~> Effect
teletype3N (Print3 x a) = const a <$> log ("teletype3: " <> x)

tN :: forall eff. TF ~> Eff (console :: CONSOLE | eff)
tN :: TF ~> Effect
tN = coproduct teletype1N $ coproduct teletype2N teletype3N

run :: forall eff. T ~> Eff (console :: CONSOLE | eff)
run :: T ~> Effect
run = foldFree tN

main :: forall eff. Eff (console :: CONSOLE | eff) Unit
main :: Effect Unit
main = run u
20 changes: 9 additions & 11 deletions test/Test/Control/Monad/Free/Stratified.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,9 @@ module Test.Control.Monad.Free.Stratified where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Free (Free, foldFree, liftF)

import Data.NaturalTransformation (NaturalTransformation)
import Effect (Effect)
import Effect.Console (log)

-- | Target DSL that we will actually run
data TeletypeF a
Expand All @@ -19,13 +17,13 @@ putStrLn :: String -> Teletype Unit
putStrLn s = liftF $ PutStrLn s unit

getLine :: Teletype String
getLine = liftF $ GetLine id
getLine = liftF $ GetLine identity

-- | Interpreter for `Teletype`, producing an effectful output
runTeletype :: forall eff. NaturalTransformation Teletype (Eff (console :: CONSOLE | eff))
runTeletype :: Teletype ~> Effect
runTeletype = foldFree go
where
go :: NaturalTransformation TeletypeF (Eff (console :: CONSOLE | eff))
go :: TeletypeF ~> Effect
go (PutStrLn s next) = log s $> next
go (GetLine k) = pure (k "fake input")

Expand All @@ -37,7 +35,7 @@ data InitialF a
type Initial = Free InitialF

greet :: Initial String
greet = liftF $ Greet id
greet = liftF $ Greet identity

farewell :: Initial Unit
farewell = liftF $ Farewell unit
Expand All @@ -46,10 +44,10 @@ farewell = liftF $ Farewell unit
-- | us to map one action in `InitialF` to multiple actions in `TeletypeF` (see
-- | the `Greet` case - we're expanding one `InitialF` action into 3 `TeletypeF`
-- | actions).
runInitial :: NaturalTransformation Initial Teletype
runInitial :: Initial ~> Teletype
runInitial initial = foldFree go initial
where
go :: NaturalTransformation InitialF Teletype
go :: InitialF ~> Teletype
go (Greet k) = do
name <- getLine
putStrLn $ "Hello " <> name
Expand All @@ -65,7 +63,7 @@ test = do
pure name

-- Run the thing
main :: forall eff. Eff (console :: CONSOLE | eff) Unit
main :: Effect Unit
main = do
a <- runTeletype (runInitial test)
log $ "Input name while running: " <> a
14 changes: 6 additions & 8 deletions test/Test/Control/Monad/Free/Teletype.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,10 @@ module Test.Control.Monad.Free.Teletype where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Effect (Effect)
import Effect.Console (log)
import Control.Monad.Free (Free, foldFree, liftF)

import Data.NaturalTransformation (NaturalTransformation)

data TeletypeF a = PutStrLn String a | GetLine (String -> a)

type Teletype a = Free TeletypeF a
Expand All @@ -16,13 +14,13 @@ putStrLn :: String -> Teletype Unit
putStrLn s = liftF (PutStrLn s unit)

getLine :: Teletype String
getLine = liftF (GetLine id)
getLine = liftF (GetLine identity)

teletypeN :: forall eff. NaturalTransformation TeletypeF (Eff (console :: CONSOLE | eff))
teletypeN :: TeletypeF ~> Effect
teletypeN (PutStrLn s a) = const a <$> log s
teletypeN (GetLine k) = pure (k "fake input")

run :: forall eff. NaturalTransformation Teletype (Eff (console :: CONSOLE | eff))
run :: Teletype ~> Effect
run = foldFree teletypeN

echo :: Teletype String
Expand All @@ -32,7 +30,7 @@ echo = do
putStrLn "Finished"
pure $ a <> a

main :: forall eff. Eff (console :: CONSOLE | eff) Unit
main :: Effect Unit
main = do
a <- run $ echo
log a
7 changes: 3 additions & 4 deletions test/Test/Main.purs
View file
Open in desktop