Skip to content

Instantly share code, notes, and snippets.

@tonyday567
Created September 18, 2014 03:17
Show Gist options
  • Save tonyday567/8bae17a7899dc87a5b2e to your computer and use it in GitHub Desktop.
Save tonyday567/8bae17a7899dc87a5b2e to your computer and use it in GitHub Desktop.
{-# language OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module TestMVC where
import Control.Category hiding ((.),id)
import qualified MVC.Prelude as MVC
import MVC
import qualified Pipes.Prelude as Pipes
import Control.Applicative
import qualified Pipes.ByteString as PB
import qualified Data.ByteString.Char8 as C
import qualified Control.Monad.Trans.State.Strict as S
import Control.Monad (forever)
testFold :: IO ()
testFold = runMVC () (asFold (+) 0 id <<< asPipe (Pipes.takeWhile (<6))) ((,) <$> pure (contramap show MVC.stdoutLines) <*> MVC.producer Single (each [1..]))
vcStd :: Managed (View C.ByteString, Controller C.ByteString)
vcStd = ((,) <$> pure (contramap show MVC.stdoutLines) <*> fmap C.pack <$> MVC.stdinLines)
testGetter :: IO ()
testGetter = runMVC () (asPipe (Pipes.takeWhile (/= "q")) >>> asGetter (PB.intersperse 55)) vcStd
testWords :: IO ()
testWords = runMVC () (asPipe (Pipes.takeWhile (/= "q")) >>> asGetter (PB.concats . PB.words)) vcStd
addCount :: Monad m => Pipe a (Int,a) (S.StateT Int m) ()
addCount = forever $ do
a <- await
lift $ S.modify (+1)
n <- lift S.get
yield (n,a)
testWordAndCount :: IO Int
testWordAndCount =
runMVC 0
(asPipe (Pipes.takeWhile (/= "q")) >>>
asGetter (\p -> (PB.concats . PB.words) p >-> addCount))
((,) <$> pure (contramap show MVC.stdoutLines) <*> fmap C.pack <$> MVC.stdinLines)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment