git.iko.soy/rowtype-yoga/purescript-native
on ff2ddf1 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Supply.hs
56 lines 1.6 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Supply
4-- Copyright : (c) Phil Freeman 2014
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Fresh variable supply
13--
14-----------------------------------------------------------------------------
16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17{-# LANGUAGE FlexibleInstances #-}
18{-# LANGUAGE MultiParamTypeClasses #-}
19{-# LANGUAGE UndecidableInstances #-}
21module Language.PureScript.Supply where
23import Data.Functor.Identity
25import Control.Applicative
26import Control.Monad.State
27import Control.Monad.Error.Class
29newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a } deriving (Functor, Applicative, Monad, MonadTrans)
31runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
32runSupplyT n = flip runStateT n . unSupplyT
34evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a
35evalSupplyT n = fmap fst . runSupplyT n
37type Supply = SupplyT Identity
39runSupply :: Integer -> Supply a -> (a, Integer)
40runSupply n = runIdentity . runSupplyT n
42evalSupply :: Integer -> Supply a -> a
43evalSupply n = runIdentity . evalSupplyT n
45fresh :: (Monad m) => SupplyT m Integer
46fresh = SupplyT $ do
47 n <- get
48 put (n + 1)
49 return n
51freshName :: (Functor m, Monad m) => SupplyT m String
52freshName = ('_' :) . show <$> fresh
54instance (MonadError e m) => MonadError e (SupplyT m) where
55 throwError = SupplyT . throwError
56 catchError e f = SupplyT $ catchError (unSupplyT e) (unSupplyT . f)