git.iko.soy/rowtype-yoga/purescript-native
on ae58255 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/DoNotation.hs
52 lines 2.1 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.DoNotation
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.DoNotation (
16 desugarDo
17) where
19import Data.Data
20import Data.Generics
22import Language.PureScript.Values
23import Language.PureScript.Names
24import Language.PureScript.Scope
26desugarDo :: (Data d) => d -> Either String d
27desugarDo = everywhereM (mkM replace)
28 where
29 replace :: Value -> Either String Value
30 replace (Do monad els) = go monad els
31 replace other = return other
32 go :: Value -> [DoNotationElement] -> Either String Value
33 go _ [] = error "The impossible happened in desugarDo"
34 go monad [DoNotationReturn val] = return $ App (Accessor "ret" monad) [val]
35 go _ (DoNotationReturn _ : _) = Left "Return statement must be the last statement in a do block"
36 go _ [DoNotationValue val] = return val
37 go monad (DoNotationValue val : rest) = do
38 rest' <- go monad rest
39 return $ App (App (Accessor "bind" monad) [val]) [Abs [Ident "_"] rest']
40 go _ [DoNotationBind _ _] = Left "Bind statement cannot be the last statement in a do block"
41 go monad (DoNotationBind NullBinder val : rest) = go monad (DoNotationValue val : rest)
42 go monad (DoNotationBind (VarBinder ident) val : rest) = do
43 rest' <- go monad rest
44 return $ App (App (Accessor "bind" monad) [val]) [Abs [ident] rest']
45 go monad (DoNotationBind binder val : rest) = do
46 rest' <- go monad rest
47 let ident = head $ unusedNames rest'
48 return $ App (App (Accessor "bind" monad) [val]) [Abs [ident] (Case [Var (Qualified Nothing ident)] [([binder], Nothing, rest')])]
49 go _ [DoNotationLet _ _] = Left "Let statement cannot be the last statement in a do block"
50 go monad (DoNotationLet binder val : rest) = do
51 rest' <- go monad rest
52 return $ Case [val] [([binder], Nothing, rest')]