1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Control.Monad.Trans.Select
-- Copyright : (c) Ross Paterson 2017
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : R.Paterson@city.ac.uk
-- Stability : experimental
-- Portability : portable
--
-- Selection monad transformer, modelling search algorithms.
--
-- * Martin Escardo and Paulo Oliva.
-- "Selection functions, bar recursion and backward induction",
-- /Mathematical Structures in Computer Science/ 20:2 (2010), pp. 127-168.
-- <https://www.cs.bham.ac.uk/~mhe/papers/selection-escardo-oliva.pdf>
--
-- * Jules Hedges. "Monad transformers for backtracking search".
-- In /Proceedings of MSFP 2014/. <https://arxiv.org/abs/1406.2058>
-----------------------------------------------------------------------------
module Control.Monad.Trans.Select (
-- * The Select monad
Select,
select,
runSelect,
mapSelect,
-- * The SelectT monad transformer
SelectT(SelectT),
runSelectT,
mapSelectT,
-- * Monad transformation
selectToContT,
selectToCont,
) where
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Data.Functor.Identity
-- | Selection monad.
type Select r = SelectT r Identity
-- | Constructor for computations in the selection monad.
select :: ((a -> r) -> a) -> Select r a
select f = SelectT $ \ k -> Identity (f (runIdentity . k))
{-# INLINE select #-}
-- | Runs a @Select@ computation with a function for evaluating answers
-- to select a particular answer. (The inverse of 'select'.)
runSelect :: Select r a -> (a -> r) -> a
runSelect m k = runIdentity (runSelectT m (Identity . k))
{-# INLINE runSelect #-}
-- | Apply a function to transform the result of a selection computation.
--
-- * @'runSelect' ('mapSelect' f m) = f . 'runSelect' m@
mapSelect :: (a -> a) -> Select r a -> Select r a
mapSelect f = mapSelectT (Identity . f . runIdentity)
{-# INLINE mapSelect #-}
-- | Selection monad transformer.
--
-- 'SelectT' is not a functor on the category of monads, and many operations
-- cannot be lifted through it.
newtype SelectT r m a = SelectT ((a -> m r) -> m a)
-- | Runs a @SelectT@ computation with a function for evaluating answers
-- to select a particular answer. (The inverse of 'select'.)
runSelectT :: SelectT r m a -> (a -> m r) -> m a
runSelectT (SelectT g) = g
{-# INLINE runSelectT #-}
-- | Apply a function to transform the result of a selection computation.
-- This has a more restricted type than the @map@ operations for other
-- monad transformers, because 'SelectT' does not define a functor in
-- the category of monads.
--
-- * @'runSelectT' ('mapSelectT' f m) = f . 'runSelectT' m@
mapSelectT :: (m a -> m a) -> SelectT r m a -> SelectT r m a
mapSelectT f m = SelectT $ f . runSelectT m
{-# INLINE mapSelectT #-}
instance (Functor m) => Functor (SelectT r m) where
fmap f (SelectT g) = SelectT (fmap f . g . (. f))
{-# INLINE fmap #-}
instance (Functor m, Monad m) => Applicative (SelectT r m) where
pure = lift . return
{-# INLINE pure #-}
SelectT gf <*> SelectT gx = SelectT $ \ k -> do
let h f = liftM f (gx (k . f))
f <- gf ((>>= k) . h)
h f
{-# INLINE (<*>) #-}
m *> k = m >>= \_ -> k
{-# INLINE (*>) #-}
instance (Functor m, MonadPlus m) => Alternative (SelectT r m) where
empty = mzero
{-# INLINE empty #-}
(<|>) = mplus
{-# INLINE (<|>) #-}
instance (Monad m) => Monad (SelectT r m) where
#if !(MIN_VERSION_base(4,8,0))
return = lift . return
{-# INLINE return #-}
#endif
SelectT g >>= f = SelectT $ \ k -> do
let h x = runSelectT (f x) k
y <- g ((>>= k) . h)
h y
{-# INLINE (>>=) #-}
#if MIN_VERSION_base(4,9,0)
instance (Fail.MonadFail m) => Fail.MonadFail (SelectT r m) where
fail msg = lift (Fail.fail msg)
{-# INLINE fail #-}
#endif
instance (MonadPlus m) => MonadPlus (SelectT r m) where
mzero = SelectT (const mzero)
{-# INLINE mzero #-}
SelectT f `mplus` SelectT g = SelectT $ \ k -> f k `mplus` g k
{-# INLINE mplus #-}
instance MonadTrans (SelectT r) where
lift = SelectT . const
{-# INLINE lift #-}
instance (MonadIO m) => MonadIO (SelectT r m) where
liftIO = lift . liftIO
{-# INLINE liftIO #-}
-- | Convert a selection computation to a continuation-passing computation.
selectToContT :: (Monad m) => SelectT r m a -> ContT r m a
selectToContT (SelectT g) = ContT $ \ k -> g k >>= k
{-# INLINE selectToCont #-}
-- | Deprecated name for 'selectToContT'.
{-# DEPRECATED selectToCont "Use selectToContT instead" #-}
selectToCont :: (Monad m) => SelectT r m a -> ContT r m a
selectToCont = selectToContT
|
