The goal would be to write stream transformers you can evaluate in Haskell, QuickCheck or produce Objective-C ReactiveCocoa code. Currently, Map *doesn't* go from a -> b, so it is fairly useless. See https://alpha.app.net/maxpow4h/post/5088051/photo/1 for an example. MIT license, Copyright 2013 Maxwell Swadling

Magic.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, IncoherentInstances, MultiParamTypeClasses, NoMonomorphismRestriction #-}
module Magic (objc, run, filter, map, hasPrefix, uppercaseString, length, RACs, Free, show) where

-- todo: quickcheck

import Control.Monad.Free
import Prelude hiding (filter, map, length, show, Show)
import qualified Prelude as P
import Data.Char
import qualified Data.List as L


-- FUNCTIONS
-- You can apply these inside RACs
data Function a = HasPrefix a (a -> Bool) | UppercaseString (String -> String) | Length (a -> Int) | Show (a -> String)

-- for eval only
class Fn a b where
  fnOf :: Function a -> b

instance Fn a (a -> Bool) where
  fnOf (HasPrefix _ f) = f

instance Fn a (a -> Int) where
  fnOf (Length f) = f

instance Fn String (String -> String) where
  fnOf (UppercaseString f) = f

instance Fn a (a -> String) where
  fnOf (Show f) = f

show :: P.Show a => Function a
show = Show $ P.show

hasPrefix :: Eq a => [a] -> Function [a]
hasPrefix s = HasPrefix s (L.isPrefixOf s)

uppercaseString :: Function String
uppercaseString = UppercaseString $ P.map toUpper

length :: Function [a]
length = Length $ P.length

class ObjC a where
  code :: a -> String -- XXX: this should be the objc quoter
  typeOf :: a -> String

instance ObjC (Function String) where
  code (HasPrefix p _) = "return [x hasPrefix:" ++ code p ++ "];"
  code (UppercaseString _) = "return [x uppercaseString];"
  code (Length _) = "return [x length];"
  code (Show _) = "return x;"
  typeOf _ = "NSString *" -- type of argument

instance ObjC (Function [Int]) where
  code (HasPrefix p _) = "return [x hasPrefix:" ++ code p ++ "];"
  code (Show _) = "return [NSString stringWithFormat:@\"%@\", x];"
  typeOf _ = "NSNumber *"

-- primitive types
-- set these to undefined, to make it clear they can't be used as function types
instance ObjC String where
  code s = "@\"" ++ s ++ "\""
  typeOf = undefined

instance ObjC Int where
  code s = "@(" ++ P.show s ++ ")"
  typeOf = undefined

instance ObjC [String] where
  code s = "@[" ++ (L.intercalate ", " (P.map code s)) ++ "]"
  typeOf = undefined

instance ObjC [Int] where
  code s = "@[" ++ (L.intercalate ", " (P.map code s)) ++ "]"
  typeOf = undefined

-- RACs operate on signals
data RACs a f where
            Filter :: Function a -> [a] -> ([a] -> f) -> RACs a f
            Map    :: Fn a (a -> b) => Function a -> [a] -> ([b] -> f) -> RACs a f
            --  | FlattenMap ([a] -> a) [a] (a -> f)
          --    | Map ([a] -> [a]) [a] (a -> f)
            --  | SubscribeNext (Real)

instance Functor (RACs a) where
  fmap f (Filter fn xs t) = Filter fn xs (f . t)
  fmap f (Map fn xs t) = Map fn xs (f . t)

filter :: Function a -> [a] -> Free (RACs a) [a]
filter f xs = liftF $ Filter f xs id

map :: Fn a (a -> b) => Function a -> [a] -> Free (RACs a) [b]
map f xs = liftF $ Map f xs id


-- run it in haskell
run :: Monad m => Free (RACs a1) a -> m a
run (Pure a) = return a
run (Free (Filter fn xs next))  = run $ next (P.filter (fnOf fn) xs)
run (Free (Map fn xs next))     = run $ next (P.map (fnOf fn) xs)

-- emit objc
-- objc :: ObjC (Function t1) => ObjC (Function t) => Free (RACs t1) t -> [String]
objc (Pure a) = []
objc (Free (Filter fn _ next)) = ("  filter:^(" ++ typeOf fn ++ " x) {\n    " ++ code fn ++ "\n  }]") :
                                  objc (next undefined)
objc (Free (Map fn _ next))    = ("  map:^(" ++ typeOf fn ++ " x) {\n    " ++ code fn ++ "\n}]") :
                                  objc (next undefined)

-- words
--describe :: (P.Show a) => Free (RACs a) a -> [String]
describe (Pure a) = ["value: " ++ (P.show a)]
describe (Free (Filter fn xs next)) = ("filter: " ++ P.show xs) :
                                      describe (next (P.filter (fnOf fn) xs))
--describe (Free (Map fn xs next))    = ("map: " ++ P.show xs) :
--                                      describe (next (P.map (fnOf fn) xs))

-- quickcheck
check = undefined

Main.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
import qualified Magic as M

-- try runProgram, showProgram program, runProgramInt, showProgram programInt

program :: [String] -> M.Free (M.RACs String) [String]
program x = M.filter (M.hasPrefix "f") x >>= M.map M.uppercaseString

programInt :: [[Int]] -> M.Free (M.RACs [Int]) [[Int]]
programInt x = M.filter (M.hasPrefix [1]) x

-- RUN doesn't work, the types aren't moving after each step of map, still a
-- string
programLen :: [String] -> M.Free (M.RACs String) [Int]
programLen x = M.filter (M.hasPrefix "f") x >>= M.map M.length >>= M.map M.show
-- pFine x = M.filter (M.hasPrefix 1) x
-- pBad x = M.filter (M.hasPrefix 1) x >>= M.map M.uppercaseString

runProgram = M.run (program ["masdf", "fds"])
runProgramInt = M.run (programInt [[1, 2, 3]])

showProgram p = putStrLn (ls ++ ";")
                  where ls = foldl (\s -> \n -> '[' : s ++ ('\n' : n)) "RACAble(self.thing)" $ M.objc $ p undefined