Last active
August 29, 2015 14:10
-
-
Save ethul/8e4853c99b3b1737b58d to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Data.Foreign (Foreign()) | |
import Data.Maybe (Maybe(..)) | |
import Data.Options | |
import Debug.Trace | |
data Shape = Circle | Square | Triangle | |
instance shapeShow :: Show Shape where | |
show Circle = "circle" | |
show Square = "square" | |
show Triangle = "triangle" | |
instance shapeIsOption :: IsOption Shape where | |
(:=) k a = (optionFn k) := show a | |
foreign import data Foo :: * | |
foreign import foo "var foo = 'foo';" :: Option Foo String | |
foreign import bar "var bar = 'bar';" :: Option Foo Number | |
foreign import baz "var baz = 'baz';" :: Option Foo (Maybe String) | |
foreign import fiz "var fiz = 'fiz';" :: Option Foo (Maybe String) | |
foreign import biz "var biz = 'biz';" :: Option Foo Shape | |
opts = foo := "aaa" <> | |
bar := 10 <> | |
baz := Just "c" <> | |
fiz := Nothing <> | |
biz := Square | |
main = (trace <<< showForeign <<< options) opts | |
foreign import showForeign | |
""" | |
function showForeign(a){ | |
return JSON.stringify(a); | |
} | |
""" :: Foreign -> String |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Data.Options where | |
import Data.Foreign (Foreign()) | |
import Data.Function (Fn2(), runFn2) | |
import Data.Maybe (Maybe(..)) | |
import Data.Monoid (Monoid) | |
foreign import data Options :: * -> * | |
foreign import data Option :: * -> * -> * | |
infixr 6 := | |
class IsOption r where | |
(:=) :: forall a. Option a r -> r -> Options a | |
foreign import optionFn "function optionFn(a){return a;}" :: forall r s a. Option a r -> Option a s | |
instance optionsSemigroup :: Semigroup (Options a) where | |
(<>) = runFn2 appendFn | |
instance optionsMonoid :: Monoid (Options a) where | |
mempty = memptyFn | |
instance stringIsOption :: IsOption String where | |
(:=) = runFn2 primIsOptionFn | |
instance numberIsOption :: IsOption Number where | |
(:=) = runFn2 primIsOptionFn | |
instance maybeIsOption :: (IsOption a) => IsOption (Maybe a) where | |
(:=) k Nothing = memptyFn | |
(:=) k (Just a) = (optionFn k) := a | |
foreign import appendFn | |
""" | |
function appendFn(o1, o2){ | |
return o1.concat(o2); | |
} | |
""" :: forall a. Fn2 (Options a) (Options a) (Options a) | |
foreign import memptyFn "var memptyFn = [];" :: forall a. Options a | |
foreign import primIsOptionFn | |
""" | |
function primIsOptionFn(k, v) { | |
return [[k, v]]; | |
} | |
""" :: forall b a. Fn2 (Option b a) a (Options b) | |
foreign import options | |
""" | |
function options(o){ | |
var res = {}; | |
var i = -1; | |
var n = o.length; | |
while(++i < n) { | |
var k = o[i][0]; | |
var v = o[i][1]; | |
res[k] = v; | |
} | |
return res; | |
} | |
""" :: forall a. Options a -> Foreign |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
$ node dist/psc.js
{"foo":"aaa","bar":10,"baz":"c","biz":"square"}