TestMVC.hs

{-# 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)