Merge branch 'topic/implementation'

Author: ethul

.gitignore

@@ -1,7 +1,6 @@
+.psci
+.psci_modules/
 node_modules
 bower_components
-js
-externs
 dist
-output
 tmp

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2014 Eric Thul
+
+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:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+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.

README.md

@@ -0,0 +1,81 @@
+# Module Documentation
+
+## Module Data.Coyoneda
+
+### Types
+
+    newtype Coyoneda f a where
+      Coyoneda :: forall i. { fi :: f i, k :: i -> a } -> Coyoneda f a
+
+    type Natural f g = forall a. f a -> g a
+
+
+### Type Class Instances
+
+    instance applicativeCoyoneda :: (Applicative f) => Applicative (Coyoneda f)
+
+    instance applyCoyoneda :: (Apply f) => Apply (Coyoneda f)
+
+    instance bindCoyoneda :: (Bind f) => Bind (Coyoneda f)
+
+    instance comonadCoyoneda :: (Comonad w) => Comonad (Coyoneda w)
+
+    instance extendCoyoneda :: (Extend w) => Extend (Coyoneda w)
+
+    instance functorCoyoneda :: Functor (Coyoneda f)
+
+    instance monadCoyoneda :: (Monad f) => Monad (Coyoneda f)
+
+    instance monadTransCoyoneda :: MonadTrans Coyoneda
+
+
+### Values
+
+    coyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b
+
+    liftCoyoneda :: forall f a. f a -> Coyoneda f a
+
+    liftCoyonedaT :: forall f g. Natural f g -> Natural (Coyoneda f) (Coyoneda g)
+
+    liftCoyonedaTF :: forall f g. (Functor g) => Natural f g -> Natural (Coyoneda f) g
+
+    lowerCoyoneda :: forall f a. (Functor f) => Coyoneda f a -> f a
+
+
+## Module Data.Yoneda
+
+### Types
+
+    newtype Yoneda f a where
+      Yoneda :: forall b. (a -> b) -> f b -> Yoneda f a
+
+
+### Type Class Instances
+
+    instance applicativeYoneda :: (Applicative f) => Applicative (Yoneda f)
+
+    instance applyYoneda :: (Apply f) => Apply (Yoneda f)
+
+    instance bindCoyoneda :: (Bind f) => Bind (Yoneda f)
+
+    instance comonadYoneda :: (Comonad w) => Comonad (Yoneda w)
+
+    instance extendYoneda :: (Extend w) => Extend (Yoneda w)
+
+    instance functorYoneda :: Functor (Yoneda f)
+
+    instance monadTransYoneda :: MonadTrans Yoneda
+
+    instance monadYoneda :: (Monad f) => Monad (Yoneda f)
+
+
+### Values
+
+    liftYoneda :: forall f a. (Functor f) => f a -> Yoneda f a
+
+    lowerYoneda :: forall f a. Yoneda f a -> f a
+
+    runYoneda :: forall f a b. Yoneda f a -> (a -> b) -> f b
+
+
+

bower.json

@@ -0,0 +1,21 @@
+{
+  "name": "purescript-yoneda",
+  "version": "0.0.0",
+  "homepage": "https://github.com/ethul/purescript-yoneda",
+  "description": "Yoneda/Coyoneda",
+  "keywords": [
+    "purescript"
+  ],
+  "license": "MIT",
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "examples",
+    "dist"
+  ],
+  "dependencies": {
+    "purescript-control": "0.2.1",
+    "purescript-transformers": "0.1.1"
+  }
+}

examples/Teletype.purs

@@ -0,0 +1,37 @@
+module Teletype where
+
+import Control.Monad.Eff
+import Control.Monad.Free
+import Data.Coyoneda
+import Debug.Trace
+
+type FreeC f a = Free (Coyoneda f) a
+
+data TeletypeF a = PutStrLn String a | GetLine (String -> a)
+
+type Teletype a = FreeC TeletypeF a
+
+type TeletypeC a = Coyoneda TeletypeF a
+
+putStrLn :: String -> Teletype Unit
+putStrLn s = liftF $ liftCoyoneda $ PutStrLn s unit
+
+getLine :: Teletype String
+getLine = liftF $ liftCoyoneda $ GetLine id
+
+teletypeNat :: forall e. Natural TeletypeF (Eff (trace :: Trace))
+teletypeNat (PutStrLn s a) = (\_ -> a) <$> trace s
+teletypeNat (GetLine k) = return $ k "fake input"
+
+run :: forall a. Teletype a -> Eff (trace :: Trace) a
+run = goEff (liftCoyonedaTF teletypeNat)
+
+echo = do
+  a <- getLine
+  putStrLn a
+  putStrLn "Finished"
+  return $ a ++ a
+
+main = do
+  a <- run $ echo
+  trace a

gulpfile.js

@@ -0,0 +1,80 @@
+var gulp = require('gulp')
+  , clean = require('gulp-clean')
+  , gutil = require('gulp-util')
+  , plumber = require('gulp-plumber')
+  , purescript = require('gulp-purescript')
+  , sequence = require('run-sequence')
+  , config = {
+      clean: ['dist', 'js', 'externs'],
+      purescript: {
+        src: [
+          'bower_components/purescript-*/src/**/*.purs*',
+          'src/**/*.purs'
+        ],
+        examples: 'examples/**/*.purs',
+        docgen: 'README.md',
+        dest: 'dist',
+        options: {
+          main: 'Teletype'
+        }
+      }
+    }
+;
+
+function error(e) {
+  gutil.log(gutil.colors.magenta('>>>> Error <<<<') + '\n' + e.toString().trim());
+  this.emit('end');
+}
+
+gulp.task('clean', function(){
+  return (
+    gulp.src(config.clean, {read: false}).
+      pipe(clean())
+  );
+});
+
+gulp.task('examples', function(){
+  return (
+    gulp.src([config.purescript.examples].concat(config.purescript.src)).
+    pipe(plumber()).
+    pipe(purescript.psc(config.purescript.options)).
+    on('error', error).
+    pipe(gulp.dest(config.purescript.dest))
+  );
+});
+
+gulp.task('make', function(){
+  return (
+    gulp.src(config.purescript.src).
+    pipe(plumber()).
+    pipe(purescript.pscMake({output: config.purescript.dest})).
+    on('error', error)
+  );
+});
+
+gulp.task('psci', function(){
+  return (
+    gulp.src(config.purescript.src).
+    pipe(plumber()).
+    pipe(purescript.dotPsci()).
+    on('error', error)
+  );
+});
+
+gulp.task('docgen', function(){
+  return (
+    gulp.src(config.purescript.src[1]).
+    pipe(plumber()).
+    pipe(purescript.docgen()).
+    on('error', error).
+    pipe(gulp.dest(config.purescript.docgen))
+  );
+});
+
+gulp.task('watch', function(cb){
+  gulp.watch(config.purescript.src, ['make']);
+});
+
+gulp.task('default', function(){
+  sequence('clean', 'make', ['psci', 'docgen']);
+});

package.json

@@ -0,0 +1,12 @@
+{
+  "name": "purescript-kan",
+  "private": true,
+  "devDependencies": {
+    "gulp": "3.8.7",
+    "gulp-clean": "0.2.4",
+    "gulp-plumber": "0.5.6",
+    "gulp-purescript": "0.0.10",
+    "gulp-util": "2.2.14",
+    "run-sequence": "0.3.6"
+  }
+}

src/Data/Coyoneda.purs

@@ -0,0 +1,58 @@
+module Data.Coyoneda
+  ( Coyoneda(..)
+  , Natural(..)
+  , coyoneda
+  , liftCoyoneda
+  , lowerCoyoneda
+  , liftCoyonedaT
+  , liftCoyonedaTF
+  ) where
+
+import Control.Comonad
+import Control.Extend
+import Control.Monad.Trans
+import Data.Tuple
+
+newtype Coyoneda f a = Coyoneda (forall i. { k :: i -> a , fi :: f i })
+
+type Natural f g = forall a. f a -> g a
+
+instance functorCoyoneda :: Functor (Coyoneda f) where
+  (<$>) f (Coyoneda v) = Coyoneda v { k = f <<< v.k }
+
+instance applyCoyoneda :: (Apply f) => Apply (Coyoneda f) where
+  (<*>) f g = liftCoyoneda $ lowerCoyoneda f <*> lowerCoyoneda g
+
+instance applicativeCoyoneda :: (Applicative f) => Applicative (Coyoneda f) where
+  pure = liftCoyoneda <<< pure
+
+instance bindCoyoneda :: (Bind f) => Bind (Coyoneda f) where
+  (>>=) (Coyoneda v) k = liftCoyoneda $ v.fi >>= lowerCoyoneda <<< k <<< v.k
+
+instance monadCoyoneda :: (Monad f) => Monad (Coyoneda f)
+
+instance monadTransCoyoneda :: MonadTrans Coyoneda where
+  lift = liftCoyoneda
+
+instance extendCoyoneda :: (Extend w) => Extend (Coyoneda w) where
+  (<<=) f (Coyoneda w) = liftCoyoneda $ f <<< coyoneda w.k <<= w.fi
+
+instance comonadCoyoneda :: (Comonad w) => Comonad (Coyoneda w) where
+  extract (Coyoneda w) = w.k $ extract w.fi
+
+coyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b
+coyoneda k fi = k <$> liftCoyoneda fi
+
+--liftCoyoneda :: forall f a. f a -> Coyoneda f a
+--liftCoyoneda fa = Coyoneda { k: id , fi: fa }
+foreign import liftCoyoneda "function liftCoyoneda(fa){return {k: function(a){return a;}, fi: fa};}"
+  :: forall f a. f a -> Coyoneda f a
+
+lowerCoyoneda :: forall f a. (Functor f) => Coyoneda f a -> f a
+lowerCoyoneda (Coyoneda v) = v.k <$> v.fi
+
+liftCoyonedaT :: forall f g. Natural f g -> Natural (Coyoneda f) (Coyoneda g)
+liftCoyonedaT nat = \(Coyoneda v) -> Coyoneda v { fi = nat v.fi }
+
+liftCoyonedaTF :: forall f g. (Functor g) => Natural f g -> Natural (Coyoneda f) g
+liftCoyonedaTF nat = lowerCoyoneda <<< liftCoyonedaT nat

src/Data/Yoneda.purs

@@ -0,0 +1,44 @@
+module Data.Yoneda
+  ( Yoneda(..)
+  , runYoneda
+  , liftYoneda
+  , lowerYoneda
+  ) where
+
+import Control.Comonad
+import Control.Extend
+import Control.Monad.Trans
+
+newtype Yoneda f a = Yoneda (forall b. (a -> b) -> f b)
+
+instance functorYoneda :: Functor (Yoneda f) where
+  (<$>) f m = Yoneda (\k -> runYoneda m (k <<< f))
+
+instance applyYoneda :: (Apply f) => Apply (Yoneda f) where
+  (<*>) (Yoneda f) (Yoneda g) = Yoneda (\k -> (f $ (<<<) k) <*> g id)
+
+instance applicativeYoneda :: (Applicative f) => Applicative (Yoneda f) where
+  pure = liftYoneda <<< pure
+
+instance bindCoyoneda :: (Bind f) => Bind (Yoneda f) where
+  (>>=) (Yoneda f) g = Yoneda (\k -> f id >>= \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
+  (<<=) f (Yoneda w) = Yoneda (\k -> k <<< f <<< liftYoneda <<= w id)
+
+instance comonadYoneda :: (Comonad w) => Comonad (Yoneda w) where
+  extract = extract <<< lowerYoneda
+
+runYoneda :: forall f a b. Yoneda f a -> (a -> b) -> f b
+runYoneda (Yoneda f) k = f k
+
+liftYoneda :: forall f a. (Functor f) => f a -> Yoneda f a
+liftYoneda m = Yoneda (\k -> k <$> m)
+
+lowerYoneda :: forall f a. Yoneda f a -> f a
+lowerYoneda (Yoneda k) = k id