I have a function that looks like:
sinkFocus :: StackSet i l a s sd -> Maybe (StackSet i l a s sd)
sinkFocus = (fmap . flip sink) <*> peek
However I would like an X () so that I can use it. For example additionalKeys uses an X ().
The documentation says that X is a IO with some state and reader transformers, so I am under the impression that the StackSet is contained within the state of X. So in theory it should be possible to modify the relevant part of the state. However the state accessible is XState not the StackState I want, so I need to be able to turn my function on StackState to one on XState.
This would be easy enough if I had a function of the type
(StackSet i l a s sd -> StackSet i l a s sd) -> X ()
However after digging around in the documentation I haven't been able to piece together a way to do this yet. Is there a way to take a function on StackSet and make an X () that performs that function?
The X monad has an instance of MonadState
instance MonadState XState X
So we can use modify as
modify :: (XState -> XState) -> X ()
So we need to turn out function to one on XStates. And if we look at the definition
XState
windowset :: !WindowSet
mapped :: !(Set Window)
waitingUnmap :: !(Map Window Int)
dragging :: !(Maybe (Position -> Position -> X (), X ()))
numberlockMask :: !KeyMask
extensibleState :: !(Map String (Either String StateExtension))
we will see WindowSet which is a type alias for a particular StackState. So you can turn a function from StackStates into one on XStates like so:
overWindowSet :: (WindowSet -> WindowSet) -> XState -> XState
overWindowSet f xState = xState { windowset = f (windowset xState) }
This can be combined with modify to make the complete function you would like:
modify . overWindowSet
I have some traverse/accessor functions to work with my mesh type:
cell :: Mesh a -> Int -> Maybe (Cell a)
neighbour :: Mesh a -> Int -> Cell a -> Maybe (Cell a)
owner :: Mesh a -> Cell a -> Maybe (Cell a)
To avoid passing mesh to each function and to handle fails I've created monadic version of them via this compound monad:
type MMesh a b = MaybeT (State (Mesh a)) b
So, I have such monadic accessors:
getMesh = get :: MMesh a (Mesh a) -- just to remove type declarations
cellM id = getMesh >>= (MaybeT . return) <$> (\m -> cell m id)
neighbourM idx cell = getMesh >>= (MaybeT . return) <$> (\m -> neighbour m idx cell)
ownerM cell = getMesh >>= (MaybeT . return) <$> (\m -> owner m cell)
They obviously follow the same pattern and I would be glad to move common part to some external function, say liftMesh to rewrite the code above as:
cellM = liftMesh cell
neighbourM = liftMesh neighbour
ownerM - liftMesh owner
But this first needs the functions to be rewritten in pointfree style to omit variable number of arguments. And that's where I'm stuck, so could anyone help to convert this to pointfree or find other ways achive the same result?
Upd: adding the full text here: http://pastebin.com/nmJVNx93
Just use gets, which returns a projection of the state specified by an arbitrary function on it, and MaybeT:
cellM ix = MaybeT (gets (\m -> cell m ix))
neighbourM ix c = MaybeT (gets (\m -> neighbour m ix c))
owner c = MaybeT (gets (\m -> owner m c))
(N.B.: I recommend not naming things id. The standard id function is too important, which makes the name clash very confusing.)
To make that more pointfree, reorder the arguments of your functions as appropriate. For instance:
cell :: Int -> Mesh a -> Maybe (Cell a)
cellM ix = MaybeT (gets (cell ix))
(You could go all the way and write cellM = MaybeT . gets . cell instead, but I feel that would excessively obscure what cellM does.)
P.S.: Given that you are using State, odds are you are also interested in functions that modify a mesh. If you aren't, however, Reader would be more appropriate than State.
Sometimes it is necessary to perform some complex routines in order to retrieve or save data, which is being processed. In this case one wants to separate data generation and data processing logic. The common way is to use iteratee-like functionality. There are lots of decent libraries: pipes, conduit, etc. In most cases they will do the thing. But AFAIK they are (except, maybe, pipes) limited by the order of processing.
But consider a log viewer example: human may desire to ramble back and forth randomly. He also may zoom in and out. I fear iteratees can't help here.
A straightforward solution may look like this:
-- True is for 'right', 'up', etc. and vice versa
type Direction = Bool
class Frame (f :: * -> *) where
type Dimension f :: *
type Origin f :: * -> *
grow', shrink' move' :: Monad m => Dimension f -> Direction -> f a -> m (f a)
move' dim dir f = grow' dim dir f >>= shrink' dim (not dir)
liftF' :: (Origin f a -> b) -> f a -> b
class Frame f => MFrame f where
liftMF' :: (Origin f a -> (b, Origin f a)) -> f a -> (b, f a)
-- Example instance: infinite stream.
data LF a = LF [a] [a] [a]
instance Frame LF where
type Dimension LF = () -- We have only one dimension to move in...
type Origin LF = [] -- User see piece of stream as a plain list
liftF' f (LF _ m _) = f m
grow' () True (LF l m (h:r)) = return $ LF l (m++[h]) r
...
Then one may wrap this into StateT and so on. So, the questions:
0) Did I miss the point of iteratees completely, and they are applicable here?
1) Did I just reinvent a well-known wheel?
2) It is obvious, that grow and shrink operations are pretty uneffective, as their complexity is proportional to the frame size. Is there a better way to extend zippers like this?
You want lenses, specifically the sequenceOf function. Here is an example of targeted loading of a 3-tuple:
sequenceOf _2 :: (IO a, IO b, IO c) -> IO (IO a, b, IO c)
sequenceOf takes a lens to a polymorphic field that contains a loading action, runs the action, then replaces the field with the result of the action. You can use sequenceOf on your own custom types by just making your type polymorphic in the fields you want to load, like this:
data Asset a b = Asset
{ _art :: a
, _sound :: b
}
... and also making your lenses use the full four type parameters (this is one reason why they exist):
art :: Lens (Asset a1 b) (Asset a2 b) a1 a2
art k (Asset x y) = fmap (\x' -> Asset x' y) (k x)
sound :: Lens (Asset a b1) (Asset a b2) b1 b2
sound k (Asset x y) = fmap (\y' -> Asset x y') (k y)
... or you can auto generate lenses using makeLenses and they will be sufficiently general.
Then you can just write:
sequenceOf art :: Asset (IO Art) b -> IO (Asset Art b)
... and loading multiple assets is as simple as composing Kleisli arrows::
sequenceOf art >=> sequenceOf sound
:: Asset (IO Art) (IO Sound) -> IO (Asset Art Sound)
... and of course you can nest assets and compose lenses to reach nested assets and everything still "just works".
Now you have a pure Asset type that you can process using pure functions, and all the loading logic is factored out into lenses.
I wrote this on my phone so there may be several errors, but I will fix them later.
What I mean by first-order constraint
First, I'll explain what I mean by first-order constraint on arrows:
Due to the way arrows desugar, you cannot use a locally bound name where an arrow command is expected in the arrow do-notation.
Here is an example to illustrate:
proc x -> f -< x + 1 desugars to arr (\x -> x + 1) >>> f and similarly proc x -> g x -< () would desugar to arr (\x -> ()) >>> g x, where the second x is a free variable. The GHC user guide explains this and says that when your arrow is also a monad you may make an instance of ArrowApply and use app to get around this. Something like, proc x -> g x -<< () becomes arr (\x -> (g x, ())) >>> app.
My Question
Yampa defines the accumHold function with this type: a -> SF (Event (a -> a)) a.
Due to this first-order limitation of arrows, I'm struggling to write the following function:
accumHoldNoiseR :: (RandomGen g, Random a) => (a,a) -> g -> SF (Event (a -> a)) a
accumHoldNoiseR r g = proc f -> do
n <- noiseR r g -< ()
accumHold n -< f
The definition above doesn't work because n is not in scope after desugaring.
Or, similarly this function, where the first part of the pair to SF is meant to be the initial value passed to accumHold
accumHold' :: SF (a,Event (a -> a)) -> a
accumHold' = ...
Is there some combinator or trick that I'm missing? Or is it not possible to write these definitions without an ArrowApply instance?
tl;dr: Is it possible to define accumHoldNoiseR :: (RandomGen g, Random a) => (a,a) -> g -> SF (Event (a -> a)) a or accumHold' :: SF (a,Event (a -> a)) -> a in yampa?
Note: There is no instance of ArrowApply for SF. My understanding is that it doesn't make sense to define one either. See "Programming with Arrows" for details.
This is a theoretical answer. Look to Roman Cheplyaka's answer to this question, which deals more with the practical details of what you're trying to achieve.
The reason n is out of scope is that for it to be in scope to use there, you would have the equivalent of bind or >>= from monads. It's the use of the results of a previous computation as a functional input to the next which makes something as powerful as a monad.
Hence you can supply n as a function argument to a subsequent arrow exactly when you can make an ArrowApply instance.
Chris Kuklewicz correctly points out in his comment that -<< would bring n into scope - it also uses app, so you need an ArrowApply instance.
Summary
Not unless you use ArrowApply. This is what ArrowApply is for.
noiseR is a signal function; it produces a stream of random numbers, not just one random number (for that, you'd just use randomR from System.Random).
On the other hand, the first argument of accumHold is just one, initial, value.
So this is not just some limitation — it actually prevents you from committing a type error.
If I understand correctly what you're trying to do, then simply using randomR should do the trick. Otherwise, please clarify why you need noiseR.
To help others understand how I worked around this I'll answer my own question.
I was trying to implement the game pong. I wanted the ball to start with a random velocity each round. I wanted to use accumHold to define the ball's velocity. I had some code like this:
ballPos = proc e -> mdo -- note the recursive do
{- some clipping calculations using (x,y) -}
...
vx <- accumHold 100 -< e `tag` collisionResponse paddleCollision
vy <- accumHold 100 -< e `tag` collisionResponse ceilingFloorCollision
(x,y) <- integral -< (vx,vy)
returnA -< (x,y)
I wanted to replace the 100s with random values (presumably from noiseR).
How I solved this instead is to accumulate over the direction, where collisionResponse just flips the sign (eventually I'll want to use the angle of the velocity relative to wall/paddle):
ballPos = proc (initV, e) -> mdo
{- some clipping calculations using (x,y) -}
...
(iVx,iVy) <- hold (0,0) -< initV
vx <- accumHold 1 -< e `tag` collisionResponse paddleCollision
vy <- accumHold 1 -< e `tag` collisionResponse ceilingFloorCollision
(x,y) <- integral -< (iVx*vx,iVy*vy)
returnA -< (x,y)
Lesson Learned:
You can often separate the value/state you want to accumulate into a behavior describing how it changes and a "magnitude" that describes its current value taking the behavior as input. In my case, I separate out the magnitude of the initial velocity, pass that as input to the signal function, and use accumHold to compute the affect on the ball (the behavior) of having collisions. So regardless of what the initial velocity was, hitting the walls "reflects" the ball. And that's exactly what the accumHold is accumulating.
I'm working on a Haskell project that involves tying a big knot: I'm parsing a serialized representation of a graph, where each node is at some offset into the file, and may reference another node by its offset. So I need to build up a map from offsets to nodes while parsing, which I can feed back to myself in a do rec block.
I have this working, and kinda-sorta-reasonably abstracted into a StateT-esque monad transformer:
{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}
import qualified Control.Monad.State as S
data Knot s = Knot { past :: s, future :: s }
newtype RecStateT s m a = RecStateT (S.StateT (Knot s) m a) deriving
( Alternative
, Applicative
, Functor
, Monad
, MonadCont
, MonadError e
, MonadFix
, MonadIO
, MonadPlus
, MonadReader r
, MonadTrans
, MonadWriter w )
runRecStateT :: RecStateT s m a -> Knot s -> m (a, Knot s)
runRecStateT (RecStateT st) = S.runStateT st
tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie m s = do
rec (a, Knot s' _) <- runRecStateT m (Knot s s')
return (a, s')
get :: Monad m => RecStateT s m (Knot s)
get = RecStateT S.get
put :: Monad m => s -> RecStateT s m ()
put s = RecStateT $ S.modify $ \ ~(Knot _ s') -> Knot s s'
The tie function is where the magic happens: the call to runRecStateT produces a value and a state, which I feed it as its own future. Note that get allows you to read from both the past and future states, but put only allows you to modify the "present."
Question 1: Does this seem like a decent way to implement this knot-tying pattern in general? Or better still, has somebody implemented a general solution to this, that I overlooked when snooping through Hackage? I beat my head against the Cont monad for a while, since it seemed possibly more elegant (see similar post from Dan Burton), but I just couldn't work it out.
Totally subjective Question 2: I'm not totally thrilled with the way my calling code ends up looking:
do
Knot past future <- get
let {- ... -} = past
{- ... -} = future
node = {- ... -}
put $ {- ... -}
return node
Implementation details here omitted, obviously, the important point being that I have to get the past and future state, pattern-match them inside a let binding (or explicitly make the previous pattern lazy) to extract whatever I care about, then build my node, update my state and finally return the node. Seems unnecessarily verbose, and I particularly dislike how easy it is to accidentally make the pattern that extracts the past and future states strict. So, can anybody think of a nicer interface?
I've been playing around with stuff, and I think I've come up with something... interesting. I call it the "Seer" monad, and it provides (aside from Monad operations) two primitive operations:
see :: Monoid s => Seer s s
send :: Monoid s => s -> Seer s ()
and a run operation:
runSeer :: Monoid s => Seer s a -> a
The way this monad works is that see allows a seer to see everything, and send allows a seer to "send" information to all other seers for them to see. Whenever any seer performs the see operation, they are able to see all of the information that has been sent, and all of the information that will be sent. In other words, within a given run, see will always produce the same result no matter where or when you call it. Another way of saying it is that see is how you get a working reference to the "tied" knot.
This is actually very similar to just using fix, except that all of the sub-parts are added incrementally and implicitly, rather than explicitly. Obviously, seers will not work correctly in the presence of a paradox, and sufficient laziness is required. For example, see >>= send may cause an explosion of information, trapping you in a time loop.
A dumb example:
import Control.Seer
import qualified Data.Map as M
import Data.Map (Map, (!))
bar :: Seer (Map Int Char) String
bar = do
m <- see
send (M.singleton 1 $ succ (m ! 2))
send (M.singleton 2 'c')
return [m ! 1, m ! 2]
As I said, I've just been toying around, so I have no idea if this is any better than what you've got, or if it's any good at all! But it's nifty, and relevant, and if your "knot" state is a Monoid, then it just might be useful to you. Fair warning: I built Seer by using a Tardis.
https://github.com/DanBurton/tardis/blob/master/Control/Seer.hs
I wrote up an article on this topic at entitled Assembly: Circular Programming with Recursive do where I describe two methods for building an assembler using knot tying. Like your problem, an assembler has to be able to resolve address of labels that may occur later in the file.
Regarding the implementation, I would make it a composition of a Reader monad (for the future) and a State monad (for past/present). The reason is that you set your future only once (in tie) and then don't change it.
{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}
import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative
newtype RecStateT s m a = RecStateT (StateT s (ReaderT s m) a) deriving
( Alternative
, Applicative
, Functor
, Monad
, MonadPlus
)
tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie (RecStateT m) s = do
rec (a, s') <- flip runReaderT s' $ flip runStateT s m
return (a, s')
getPast :: Monad m => RecStateT s m s
getPast = RecStateT get
getFuture :: Monad m => RecStateT s m s
getFuture = RecStateT ask
putPresent :: Monad m => s -> RecStateT s m ()
putPresent = RecStateT . put
Regarding your second question, it'd help to know your dataflow (i.e. to have a minimal example of your code). It's not true that strict patterns always lead to loops. It's true that you need to be careful so as not to create a non-producing loop, but the exact restrictions depend on what and how you're building.
I had a similar problem recently, but I chose a different approach. A recursive data structure can be represented as a type fixed point on a data type functor. Loading data can be then split into two parts:
Load the data into a structure that references other nodes only by some kind of identifier. In the example it's Loader Int (NodeF Int), which constructs a map of values of type NodeF Int Int.
Tie the knot by creating a recursive data structure by replacing the identifiers with actual data. In the example the resulting data structures have type Fix (NodeF Int), and they are later converted to Node Int for convenience.
It's lacking a proper error handling etc., but the idea should be clear from that.
-- Public Domain
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
-- Fixed point operator on types and catamohism/anamorphism methods
-- for constructing/deconstructing them:
newtype Fix f = Fix { unfix :: f (Fix f) }
catam :: Functor f => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix
anam :: Functor f => (a -> f a) -> (a -> Fix f)
anam f = Fix . fmap (anam f) . f
anam' :: Functor f => (a -> f a) -> (f a -> Fix f)
anam' f = Fix . fmap (anam f)
-- The loader itself
-- A representation of a loader. Type parameter 'k' represents the keys by
-- which the nodes are represented. Type parameter 'v' represents a functor
-- data type representing the values.
data Loader k v = Loader (Map k (v k))
-- | Creates an empty loader.
empty :: Loader k v
empty = Loader $ Map.empty
-- | Adds a new node into a loader.
update :: (Ord k) => k -> v k -> Loader k v -> Loader k v
update k v = update' k (const v)
-- | Modifies a node in a loader.
update' :: (Ord k) => k -> (Maybe (v k) -> (v k)) -> Loader k v -> Loader k v
update' k f (Loader m) = Loader $ Map.insertWith (const (f . Just)) k (f Nothing) $ m
-- | Does the actual knot-tying. Creates a new data structure
-- where the references to nodes are replaced by the actual data.
tie :: (Ord k, Functor v) => Loader k v -> Map k (Fix v)
tie (Loader m) = Map.map (anam' $ \k -> fromJust (Map.lookup k m)) m
-- -----------------------------------------------------------------
-- Usage example:
data NodeF n t = NodeF n [t]
instance Functor (NodeF n) where
fmap f (NodeF n xs) = NodeF n (map f xs)
-- A data structure isomorphic to Fix (NodeF n), but easier to work with.
data Node n = Node n [Node n]
deriving Show
-- The isomorphism that does the conversion.
nodeunfix :: Fix (NodeF n) -> Node n
nodeunfix = catam (\(NodeF n ts) -> Node n ts)
main :: IO ()
main = do
-- Each node description consist of an integer ID and a list of other nodes
-- it references.
let lss =
[ (1, [4])
, (2, [1])
, (3, [2, 1])
, (4, [3, 2, 1])
, (5, [5])
]
print lss
-- Fill a new loader with the data:
let
loader = foldr f empty lss
f (label, dependsOn) = update label (NodeF label dependsOn)
-- Tie the knot:
let tied' = tie loader
-- And convert Fix (NodeF n) into Node n:
let tied = Map.map nodeunfix tied'
-- For each node print the label of the first node it references
-- and the count of all referenced nodes.
print $ Map.map (\(Node n ls#((Node n1 _) : _)) -> (n1, length ls)) tied
I'm kind of overwhelmed by the amount of Monad usage.
I might not understand the past/future things, but I guess you are just trying to express the lazy+fixpoint binding. (Correct me if I'm wrong.)
The RWS Monad usage with R=W is kind of funny, but you do not need the State and the loop, when you can do the same with fmap. There is no point in using Monads if they do not make things easier. (Only very few Monads represent chronological order, anyway.)
My general solution to tying the knot:
I parse everything to a List of nodes,
convert that list to a Data.Vector for O(1) access to boxed (=lazy) values,
bind that result to a name using let or the fix or mfix function,
and access that named Vector inside the parser. (see 1.)
That example solution in your blog, where you write sth. like this:
data Node = Node {
value :: Int,
next :: Node
} deriving Show
…
tie = …
parse = …
data ParserState = …
…
example :: Node
example =
let (_, _, m) = tie parse $ ParserState 0 [(0, 1), (1, 2), (2, 0)]
in (m Map.! 0)
I would have written this way:
{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector
example :: Node
example =
let node :: Int -> Node
node = (Vector.!) $ Vector.fromList $
[ Node{value,next}
| (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
]
in (node 0)
or shorter:
{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector
example :: Node
example = (\node->(Vector.fromList[ Node{value,next}
| (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
] Vector.!)) `fix` 0