Skip to content

Commit

Permalink
Merge pull request #97 from purescript/compiler/0.12
Browse files Browse the repository at this point in the history
Updates for 0.12
  • Loading branch information
garyb authored May 23, 2018
2 parents e1e3fd0 + 37d5b35 commit 7cefee5
Show file tree
Hide file tree
Showing 12 changed files with 87 additions and 90 deletions.
40 changes: 23 additions & 17 deletions LICENSE
Original file line number Diff line number Diff line change
@@ -1,20 +1,26 @@
Copyright (c) 2014 Eric Thul
Copyright 2018 PureScript

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), in the Software without restriction, including without
limitation the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons to
whom the Software is furnished to do so, subject to the following
conditions:
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.

3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software without
specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26 changes: 17 additions & 9 deletions bower.json
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 <[email protected]>",
"Brian McKenna <[email protected]>",
"John A. De Goes <[email protected]> (http://degoes.net)",
"Gary Burgess <[email protected]>",
"Phil Freeman <[email protected]>"
],
"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
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
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
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
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
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
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
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
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
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
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,13 @@ module Test.Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)

import Effect (Effect)
import Effect.Console (log)
import Test.Control.Monad.Free.Coproduct as C
import Test.Control.Monad.Free.Stratified as S
import Test.Control.Monad.Free.Teletype as T

main :: Eff (console :: CONSOLE) Unit
main :: Effect Unit
main = do
log "Teletype"
T.main
Expand Down

0 comments on commit 7cefee5

Please sign in to comment.