Inner join in persistent or should I use esqueleto? - haskell

I have this fragment describing Notification and Notified entities:
Notification
type NotiType
release ReleaseId
date UTCTime
Notified
aboutWhat NotificationId
unread Bool
user UserId
Now I want to write this:
-- | Mark specified notification as already seen by specific user. Note that
-- we use 'ReleaseId' to select notification, so this may result in several
-- notifications marked as “read” if they happen to be about the same
-- release. This is generally what you want.
markAsRead
:: ReleaseId -- ^ Release in question
-> UserId -- ^ User who has seen mentioned release
-> SqlPersistM ()
markAsRead release user = do
ns <- selectKeysList [ NotificationRelease ==. release ] []
updateWhere [ NotifiedAboutWhat <-. ns
, NotifiedUnread ==. True
, NotifiedUser ==. user ]
[ NotifiedUnread =. False ]
This works, but extracting list of notifications as list and then using it to select things in another table… well that's not exactly right. Obviously I need a join here and then I will be able to update everything efficiently.
How to do it in pure persistent? Is it possible and is it a good idea in this case to stay with persistent for this sort of task? Should I use esqueleto instead? It looks like I'll need to learn different DSL to work with it, so I'm not sure whether to switch or not.
How to write markAsRead properly with persistent (if possible)?

As Greg mentioned, Esqueleto is the way to go. You can try reading its main module documentation.
Currently Esqueleto doesn't support joins on UPDATEs. However, you can use subqueries to the same effect.
Untested code to get you started:
-- | Mark specified notification as already seen by specific user. Note that
-- we use 'ReleaseId' to select notification, so this may result in several
-- notifications marked as “read” if they happen to be about the same
-- release. This is generally what you want.
markAsRead
:: ReleaseId -- ^ Release in question
-> UserId -- ^ User who has seen mentioned release
-> SqlPersistM ()
markAsRead release user =
update $ \n -> do
set n [ NotifiedUnread =. val False ]
where_ $
n ^. NotifiedUnread ==. val True &&.
n ^. NotifiedUser ==. val user &&.
n ^. NotifiedAboutWhat `in_`
(subList_select $
from $ \t -> do
where_ $ t ^. NotificationRelease ==. val release
return $ t ^. NotificationId)

Yes Esqueleto if you want to do joins. Persistent works well with embedding data if your DB and your data modelling support that.

Related

Message passing concurrency in Haskell with multiple senders and receivers

I am trying to solve a problem involving multiple senders and receivers, and would like some feedback on whether my approach is on the right track.
Problem: We have N leaders and M followers, who must all be represented by individual threads. Everyone is a dancer, and has an associated "dance card" with the names of 8 different dances. each leader must ask a follower if they can dance a specific dance. Followers wait for invitations from leaders and accept only if they are not already dancing that dance and if they have not agreed to dance with this leader for 2 other dances. If the leaders hears back that their invite was accepted, they move on trying to secure a match for the next dance. Otherwise, they continue trying to find a match for the same dance. At the end, the leaders "dance card" is printed with each dance and the ID of the follower with whom they are dancing that dance.
Approach: I have created two functions: leader and follower. In main, I use forkIO to call leader n times and follower m times. However, I'm running into the issue of how I will keep state (specifically the dancecard). I was thinking of creating a type class "Dancer" and then two instances of it : Leader and Follower. Each leader and each follower would have a unique ID (anything from 1 to N or M). Each would also need an mvar to serve as its own personal mailbox . Leaders would somehow need to "get" a follower's mvar in order to put something in it so that that same follower can take it out and respond yes or no to the invite. Regarding the dancecard, I think it would it be best to incorporate the state monad. For example, when a leader invites a follower to a dance, a follower should be able to look at their dancecard and verify that they don't already have a partner for that dance.
Wow, you already have a typeclass, two instances, and a state monad, and you haven't even settled on the types of your MVars! Things are getting complicated.
I worry that you may be falling into the Haskell-as-Java trap, where you've come up with an object-oriented solution in your head, and you're now trying to translate that directly into Haskell, thinking about your dancers as stateful objects with shared methods wrapped up in a "class", etc., etc.
I would suggest a different approach. Dancers aren't "things"; they're tasks. Implement them as straightforward functions and use argument passing and recursion in place of "state", as is typical for idiomatic Haskell.
Spoilers follow, but here is a simple way to define a "follower" that has an id, responds to requests via a pair of request/response MVars, and maintains a dance card using a recursive core loop. Note that the Follower data type isn't supposed to be a "follower object" (e.g., it has no dance card); it's just a convenient way of documenting the return value from follower which serves as a "handle" for identifying and communicating with the follower task:
type LeaderId = Int
type FollowerId = Int
type Dance = Int
-- |A dance card for a follower with a list of dance/leader pairs.
data Card = Card { getCard :: [(Dance, LeaderId)] } deriving (Show)
emptyCard = Card []
-- |Follower handle giving its id and request/response MVars
data Follower =
Follower { followerId :: FollowerId
, request :: MVar (Dance, LeaderId)
, response :: MVar Bool
}
-- |Create a new follower task with given id.
follower :: FollowerId -> IO Follower
follower followerId_ = do
req <- newEmptyMVar
res <- newEmptyMVar
let loop (Card xs) = do
-- get next request
(dance, leaderId_) <- takeMVar req
case lookup dance xs of
-- if dance is free and we haven't danced too often w/ this leader
Nothing | length (filter ((==leaderId_) . snd) xs) < 2
-- then say yes and update dance card
-> do putMVar res True
loop (Card $ (dance, leaderId_) : xs)
-- otherwise, refuse
_ -> do putMVar res False
loop (Card xs)
forkIO $ loop emptyCard
return $ Follower followerId_ req res
You can create and test out a couple of followers by asking them to dance:
> f1 <- follower 1 -- follower #1
> f2 <- follower 2 -- follower #2
> putMVar (request f1) (1, 10) -- dance #1 w/ leader #10
> takeMVar (response f1)
True -- hooray!
> putMVar (request f1) (1, 14) -- dance #1 w/ leader #14
> takeMVar (response f1)
False -- wah! dance is taken
> putMVar (request f2) (1, 14) -- try different follower
> takeMVar (response f2)
True -- hooray!
>
Note that these particular followers can neither be queried for their dance cards nor told to exit their infinite loops. You don't need that for this application (we only need the dance cards from the leaders and don't care if there are a bunch of stuck lightweight threads when we get the answer), but you could always add a couple of MVars if you did.
Similarly, you should be able to implement a leader as a function with a simple recursive core loop. Note that, if the leader tries to just fill its dance card in order, it doesn't actually need to keep track of the dance card as it goes -- the final dance card (and "core loop") is just a mapM over trying to fill dance slots 1 to 8.
How do you provide the leaders with the ability to request dances from followers? Well, create the full set of followers first and pass a list of follower handles ([Follower]) as an argument to the leader creation function. How do you get dance cards back from the leaders? The leader function should return an MVar for the card, and the main function can mapM takeMVar leadersDanceCards to get the full list of dance cards.

Haskell Records- setting/getting using string fieldname

In many cases it would be useful to be able to set/get a record field via its name as a string (for instance, converting records to/from command line arguments, HTTP headers, SQL query results, or store widgets in a GUI tree in an easy to use record, etc). The functions could have the types
setField::String->Val->Record->Record
getField::String->Record->Val
getFieldNames::Record->[String]
where Val could be something that could convert to other types (string, glib GValue, or even the Convertables I described here)
I've started writing a library that does this, with plans contribute it to the community (it will need some GHC extensions, probably including TemplateHaskell)....
My question- Does something like this already exist? Is there a better way to populate Records from external name/value pairs? I've looked all over and can't find it. (lenses are related, but don't use the string name).
I think this would be useful, but don't want to reinvent the wheel.
You might do something like this using Vinyl, though you'll still need to create strongly type accessors. The advantage is that the type system contains enough information to ensure that you never need to runtime handle Maybe-wrapped lookup failures.
Copying some relevant examples from that link
name = Field :: "name" ::: String
age = Field :: "age" ::: Int
sleeping = Field :: "sleeping" ::: Bool
jon = name =: "jon"
<+> age =: 20
<+> sleeping =: True
type LifeForm = ["name" ::: String, "age" ::: Int, "sleeping" ::: Bool]
jon :: PlainRec LifeForm
wakeUp :: (("sleeping" ::: Bool) ∈ fields) => PlainRec fields -> PlainRec fields
wakeUp = sleeping `rPut` False
jon' = wakeUp jon
> rGet name jon'
"jon"
> rGet sleeping jon
True
> rGet sleeping jon'
False
If you're not willing to do something akin to this, then you're probably going to end up with some kind of runtime failure which means you might as well have type Record = Map String Val.

Use of Hamlet's $case with records and ADTs

It would seem that Hamlet's $case expression should be remarkably useful, but I can't figure out how one would match against an record type with multiple constructors short of pattern matching (with a unique name) each of the fields. Say I have a data type,
data A = A1 { v1,v2,v3 :: Int }
| A2 { g :: Double}
In my template, I would want to render A1 values differently from A2 values. One would think I could simply do,
$case myA
$of a#(A1 {})
<p>This is an A1: #{show $ v1 a}
$of a#(A2 {})
<p>This is an A2: #{show $ g a}
Unfortunately, this snippet fails to compile with a syntax error, suggesting that the # syntax isn't supported. If I remove the a#, I get another syntax error, this time suggesting that the record brace notation also isn't supported.
Finally, in desperation, once can try,
$case myA
$of A1 _ _ _
...
But alas, even this doesn't compile (conflicting definitions of _). Consequently, it seems that the only option is,
$case myA
$of A1 v1 v2 v3
...
This sort of order-based pattern matching gets extremely tiresome with large datatypes, especially when one is forced to name every field.
So, what am I missing here? Is case analysis in Hamlet really as limited as it seems? What is the recommended way to match against the constructors of a ADT (and later refer to fields)? Is the fact that I even want to do this sort of matching a sign that I'm Doing It Wrong(TM)?
You can track hamlet processing.
The answer is in the non-exposed module Text.Hamlet.Parse where
controlOf = do
_ <- try $ string "$of"
pat <- many1 $ try $ spaces >> ident
_ <- spaceTabs
eol
return $ LineOf pat
where
ident = Ident <$> many1 (alphaNum <|> char '_' <|> char '\'')
so only a sequence of one or more (spaces followed by (identifier or wildcard)) is accepted.
You may extend it from here.
Cheers!

can xmonad's logHook be run at set intervals rather than in (merely) response to layout events?

I'm using dynamicLogWithPP from XMonad.Hooks.DynamicLog together with dzen2 as a status bar under xmonad. One of the things I'd like to have displayed in the bar is the time remaining in the currently playing track in audacious (if any). Getting this information is easy:
audStatus :: Player -> X (Maybe String)
audStatus p = do
info <- liftIO $ tryS $ withPlayer p $ do
ispaused <- paused
md <- getMetadataString
timeleftmillis <- (-) <$> (getCurrentTrack >>= songFrames) <*> time
let artist = md ! "artist"
title = md ! "title"
timeleft = timeleftmillis `quot` 1000
(minutes, seconds) = timeleft `quotRem` 60
disp = artist ++ " - " ++ title ++ " (-"++(show minutes)++":"++(show seconds)++")" -- will be wrong if seconds < 10
audcolor False = dzenColor base0 base03
audcolor True = dzenColor base1 base02
return $ wrap "^ca(1, pms p)" "^ca()" (audcolor ispaused disp)
return $ either (const Nothing) Just info
So I can stick that in ppExtras and it works fine—except it only gets run when the logHook gets run, and that happens only when a suitable event comes down the pike. So the display is potentially static for a long time, until I (e.g.) switch workspaces.
It seems like some people just run two dzen bars, with one getting output piped in from a shell script. Is that the only way to have regular updates? Or can this be done from within xmonad (without getting too crazy/hacky)?
ETA: I tried this, which seems as if it should work better than it does:
create a TChan for updates from XMonad, and another for updates from a function polling Audacious;
set the ppOutput field in the PP structure from DynamicLog to write to the first TChan;
fork the audacious-polling function and have it write to the second TChan;
fork a function to read from both TChans (checking that they aren't empty, first), and combining the output.
Updates from XMonad are read from the channel and processed in a timely fashion, but updates from Audacious are hardly registered at all—every five or so seconds at best. It seems as if some approach along these lines ought to work, though.
I know this is an old question, but I came here looking for an answer to this a few days ago, and I thought I'd share the way I solved it. You actually can do it entirely from xmonad. It's a tiny bit hacky, but I think it's much nicer than any of the alternatives I've come across.
Basically, I used the XMonad.Util.Timer library, which will send an X event after a specified time period (in this case, one second). Then I just wrote an event hook for it, which starts the timer again, and then manually runs the log hook.
I also had to use the XMonad.Util.ExtensibleState library, because Timer uses an id variable to make sure it's responding to the right event, so I have to store that variable between events.
Here's my code:
{-# LANGUAGE DeriveDataTypeable #-}
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Timer
...
-- wrapper for the Timer id, so it can be stored as custom mutable state
data TidState = TID TimerId deriving Typeable
instance ExtensionClass TidState where
initialValue = TID 0
...
-- put this in your startupHook
-- start the initial timer, store its id
clockStartupHook = startTimer 1 >>= XS.put . TID
-- put this in your handleEventHook
clockEventHook e = do -- e is the event we've hooked
(TID t) <- XS.get -- get the recent Timer id
handleTimer t e $ do -- run the following if e matches the id
startTimer 1 >>= XS.put . TID -- restart the timer, store the new id
ask >>= logHook.config -- get the loghook and run it
return Nothing -- return required type
return $ All True -- return required type
Pretty straightforward. I hope this is helpful to someone.
It cannot be done from within xmonad; xmonad's current threading model is a bit lacking (and so is dzen's). However, you can start a separate process that periodically polls your music player and then use one of the dzen multiplexers (e.g. dmplex) to combine the output from the two processes.
You may also want to look into xmobar and taffybar, which both have better threading stories than dzen does.
With regards to why your proposed TChan solution doesn't work properly, you might want to read the sections "Conventions", "Foreign Imports", and "The Non-Threaded Runtime" at my crash course on the FFI and gtk, keeping in mind that xmonad currently uses GHC's non-threaded runtime. The short answer is that xmonad's main loop makes an FFI call to Xlib that waits for an X event; this call blocks all other Haskell threads from running until it returns.

Data value dependencies, updates and memoisation

I'm sorry this problem description is so abstract: its for my job, and for commercial confidentiality reasons I can't give the real-world problem, just an abstraction.
I've got an application that receives messages containing key-value pairs. The keys are from a defined set of keywords, and each keyword has a fixed data type. So if "Foo" is an Integer and "Bar" is a date you might get a message like:
Foo: 234
Bar: 24 September 2011
A message may have any subset of keys in it. The number of keys is fairly large (several dozen). But lets stick with Foo and Bar for now.
Obviously there is a record like this corresponding to the messages:
data MyRecord {
foo :: Maybe Integer
bar :: Maybe UTCTime
-- ... and so on for several dozen fields.
}
The record uses "Maybe" types because that field may not have been received yet.
I also have many derived values that I need to compute from the current values (if they exist). For instance I want to have
baz :: MyRecord -> Maybe String
baz r = do -- Maybe monad
f <- foo r
b <- bar r
return $ show f ++ " " ++ show b
Some of these functions are slow, so I don't want to repeat them unnecessarily. I could recompute baz for each new message and memo it in the original structure, but if a message leaves the foo and bar fields unchanged then that is wasted CPU time. Conversely I could recompute baz every time I want it, but again that would waste CPU time if the underlying arguments have not changed since last time.
What I want is some kind of smart memoisation or push-based recomputation that only recomputes baz when the arguments change. I could detect this manually by noting that baz depends only on foo and bar, and so only recomputing it on messages that change those values, but for complicated functions that is error-prone.
An added wrinkle is that some of these functions may have multiple strategies. For instance you might have a value that can be computed from either Foo or Bar using 'mplus'.
Does anyone know of an existing solution to this? If not, how should I go about it?
I'll assume that you have one "state" record and these message all involve updating it as well as setting it. So if Foo is 12, it may later be 23, and therefore the output of baz would change. If any of this is not the case, then the answer becomes pretty trivial.
Let's start with the "core" of baz -- a function not on a record, but the values you want.
baz :: Int -> Int -> String
Now let's transform it:
data Cached a b = Cached (Maybe (a,b)) (a -> b)
getCached :: Eq a => Cached a b -> a -> (b,Cached a b)
getCached c#(Cached (Just (arg,res)) f) x | x == arg = (res,c)
getCached (Cached _ f) x = let ans = f x in (ans,Cached (Just (x,ans) f)
bazC :: Cached (Int,Int) String
bazC = Cached Nothing (uncurry baz)
Now whenever you would use a normal function, you use a cache-transformed function instead, substituting the resulting cache-transformed function back into your record. This is essentially a manual memotable of size one.
For the basic case you describe, this should be fine.
A fancier and more generalized solution involving a dynamic graph of dependencies goes under the name "incremental computation" but I've seen research papers for it more than serious production implementations. You can take a look at these for starters, and follow the reference trail forward:
http://www.carlssonia.org/ogi/Adaptive/
http://www.andres-loeh.de/Incrementalization/paper_final.pdf
Incremental computation is actually also very related to functional reactive programming, so you can take a look at conal's papers on that, or play with Heinrich Apfelmus' reactive-banana library: http://www.haskell.org/haskellwiki/Reactive-banana
In imperative languages, take a look at trellis in python: http://pypi.python.org/pypi/Trellis or Cells in lisp: http://common-lisp.net/project/cells/
You can build a stateful graph that corresponds to computations you need to do. When new values appear you push these into the graph and recompute, updating the graph until you reach the outputs. (Or you can store the value at the input and recompute on demand.) This is a very stateful solution but it works.
Are you perhaps creating market data, like yield curves, from live inputs of rates etc.?
What I want is some kind of smart memoisation or push-based recomputation that only recomputes baz when the arguments change.
It sounds to me like you want a variable that is sort of immutable, but allows a one-time mutation from "nothing computed yet" to "computed". Well, you're in luck: this is exactly what lazy evaluation gives you! So my proposed solution is quite simple: just extend your record with fields for each of the things you want to compute. Here's an example of such a thing, where the CPU-intensive task we're doing is breaking some encryption scheme:
data Foo = Foo
{ ciphertext :: String
, plaintext :: String
}
-- a smart constructor for Foo's
foo c = Foo { ciphertext = c, plaintext = crack c }
The point here is that calls to foo have expenses like this:
If you never ask for the plaintext of the result, it's cheap.
On the first call to plaintext, the CPU churns a long time.
On subsequent calls to plaintext, the previously computed answer is returned immediately.

Resources