Skip to content

Instantly share code, notes, and snippets.

View simonmichael's full-sized avatar

Simon Michael simonmichael

239 followers · 4 following
View GitHub Profile
@simonmichael
simonmichael / gist:145979
Created July 13, 2009 07:05
import Network.Loli
import Hack.Handler.Happstack
import qualified Hack.Contrib.Response as Response
import qualified Control.Monad.State as State
import Ledger
import Options hiding (value)
import Commands.Register
tcpport = 3000
@simonmichael
simonmichael / gist:146526
Created July 13, 2009 23:30
roundup=> SELECT * FROM pg_locks;
locktype | database | relation | page | tuple | transactionid | classid | objid | objsubid | transaction | pid | mode | granted
---------------+----------+----------+------+-------+---------------+---------+-------+----------+-------------+-------+-----------------+---------
transactionid | | | | | 16482841 | | | | 16482841 | 18882 | ExclusiveLock | t
relation | 16593 | 10342 | | | | | | | 16498184 | 17322 | AccessShareLock | t
relation | 16593 | 16697 | | | | | | | 16482841 | 18882 | AccessShareLock | t
relation | 16593 | 16663 | | | | | | | 16482841 | 18882 | AccessShareLock | t
relation | 16593 | 16701 | | | | | | | 16482841 | 18882 | AccessShar
@simonmichael
simonmichael / gist:147064
Created July 14, 2009 17:11
(ih,oh,eh,ph) ← runInteractiveCommand cmd
when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return ()
o_actual ← hGetContents oh
e_actual ← hGetContents eh
-- force some evaluation here to avoid occasional waitForProcess hangs. cf http://hackage.haskell.org/trac/ghc/ticket/3369
putStr $ printf "%d,%d" (length o_actual) (length e_actual)
x_actual ← waitForProcess ph
-- first cut at an mvar version
@simonmichael
simonmichael / gist:147118
Created July 14, 2009 19:09
-- run the command, passing it the stdin if any, and reading the
-- stdout/stderr/exit code. This has to be done carefully.
(ih,oh,eh,ph) ← runInteractiveCommand cmd
when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return ()
o ← newEmptyMVar
forkIO $ hGetContents oh >>= λs → length s `seq` putMVar o s
e ← newEmptyMVar
forkIO $ hGetContents eh >>= λs → length s `seq` putMVar e s
x ← newEmptyMVar
forkIO $ waitForProcess ph >>= λs → s `seq` putMVar x s
@simonmichael
simonmichael / gist:147264
Created July 14, 2009 22:49
hGetContentsStrictlyAnd ∷ Handle → (String → IO b) → IO b
hGetContentsStrictlyAnd h f = hGetContents h >>= λc → length c `seq` f c
@simonmichael
simonmichael / gist:147269
Created July 14, 2009 22:51
-- run the command, passing it the stdin if any, and reading the
-- stdout/stderr/exit code. This has to be done carefully.
(ih,oh,eh,ph) ← runInteractiveCommand cmd
when (isJust i) $ forkIO (hPutStr ih $ fromJust i) >> return ()
o ← newEmptyMVar
e ← newEmptyMVar
forkIO $ oh `hGetContentsStrictlyAnd` putMVar o
forkIO $ eh `hGetContentsStrictlyAnd` putMVar e
x_actual ← waitForProcess ph
o_actual ← takeMVar o
@simonmichael
simonmichael / gist:159440
Created July 31, 2009 20:43
hsptest' =
<html>
<body>
<b>HSP output</b>
</body>
</html>
@simonmichael
simonmichael / gist:159504
Created July 31, 2009 23:17
-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -F -pgmFtrhsx #-}
import Data.IORef (newIORef, atomicModifyIORef)
import Data.Maybe (fromMaybe)
import Control.Applicative
import Control.Monad
-- import Data.Monoid
-- import Network.CGI
-- import qualified Text.XHtml.Strict as X
@simonmichael
simonmichael / gist:166246
Created August 12, 2009 01:36
run $ -- run :: (Env -> IO Response) -> IO ()
loli $ do -- loli :: State Loli () -> (Env -> IO Response)
get "/balance" $ command showBalanceReport -- get :: String -> ReaderT Env (StateT Response IO) () -> State Loli ()
@simonmichael
simonmichael / gist:168167
Created August 15, 2009 00:13
fetchItems :: String -> IO [Item]
fetchItems url = do
-- f <- openAsFeed url
-- let is = either (const []) feedItems f
-- return $ nubBy matchingTitles is
-- heap keeps growing.. experiment
s <- openURIString url
let s' = either (const "") id s
x = parseXMLDoc s'
f = maybe Nothing (Just . feedFromXML) x