Skip to content

Instantly share code, notes, and snippets.

@michaelt
Forked from snoyberg/.project-settings.yml
Last active August 29, 2015 14:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save michaelt/88b89b7fcab5bd8a47a7 to your computer and use it in GitHub Desktop.
Save michaelt/88b89b7fcab5bd8a47a7 to your computer and use it in GitHub Desktop.
server user timestamp event
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
foo 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
bar 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
bar 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
bar 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
bar 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Something else", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Something else", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Something else", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Login", "contents": {"foo": "bar"}}
baz 1 2014-10-10 {"tag": "Something else", "contents": {"foo": "bar"}}
{-# LANGUAGE OverloadedStrings #-}
import Pipes
import Pipes.Group
import qualified Pipes.Prelude as P
import qualified Pipes.ByteString as PB
import qualified Pipes.Attoparsec as PA
import Data.Aeson
import Data.Aeson.Parser
import Data.Aeson.Types
import Data.Monoid
import Control.Monad.Trans.State.Strict
import Data.Text (Text)
import Lens.Family -- from `lens-family`or Control.Lens from `lens`
import qualified Pipes.Internal as I -- for the missing fold'
main = runEffect $ toData PB.stdin >-> P.print
where toData = concats . maps parseLogin . drops 1 . view PB.lines
parseLogin p = do
let divided = p ^. PB.break (== 9) . PB.splitAt 80 . to concat_bytes
(server, rest) <- lift divided
good <- rest >-> P.drain -- drop any excess that comes before tab
(me,p) <- lift $ runStateT (PA.parse json) $ skip_fields good
case me of Just (Right a) ->
case parseEither (withObject "" (.: "tag")) a of
Right tag | tag == login -> yield (server, 1::Int)
_ -> yield (server, 0)
_ -> return ()
p >-> P.drain
where login = "Login" :: Text
concat_bytes = fold' (<>) mempty id
skip_field = PB.drop 1 . PB.dropWhile (/= 9)
skip_fields = skip_field . skip_field . PB.drop 1
-- sensible combinator:
fold' :: Monad m
=> (x -> a -> x) -> x -> (x -> b)
-> Producer a m r -> m (b,r)
fold' step begin done p0 = loop p0 begin
where
loop p x = case p of
I.Request v _ -> I.closed v
I.Respond a fu -> loop (fu ()) $! step x a
I.M m -> m >>= \p' -> loop p' x
I.Pure r -> return (done x, r)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment