chan-split is a haskell library that is a wrapper around Control.Concurrent.Chans that separates a Chan into a readable side and a writable side.

We also provide two other modules: Data.Cofunctor (because there didn’t seem to be one anywhere), and Control.Concurrent.Chan.Class. The latter creates two classes: ReadableChan and WritableChan, making the fundamental chan functions polymorphic, and defining an instance for standard Chan as well as MVar (an MVar is a singleton bounded channel, wanna fight about it?).

Why?

Having separate read/write sides makes it easier to reason about your code, supports doing some cool things (defining Functor and Cofunctor instances), and makes more sense (e.g. the function of dupChan in the base library is much easier to understand as an operation that happens on an OutChan).

Also I use it in (the coming new, less stupid version of) my module simple-actors.

Where?

You can get it with a:

cabal install chan-split

And check out the docs on hackage. Or check out the source on github and send me pull requests.

Usage

Let’s write the numbers 1 – 10 to the InChan and read them as a stream in the OutChan:

 1 module Main
 2     where
 3 
 4 import Control.Concurrent.Chan.Split
 5 import Control.Concurrent(forkIO)
 6 
 7 main = do
 8     -- Instead of a single Chan, we initialize a pair of (InChan,OutChan)
 9     (inC,outC) <- newSplitChan
10     -- fork a writer on the InChan
11     forkIO $ writeStuffTo inC [1..10]
12     -- read from the OutChan in the main thread:
13     getStuffOutOf outC >>=
14       mapM_ print . take 10 

And we’ll make writeStuffTo and getStuffOutOf, simply be the standard functions. Note that writeListToChan is actually polymorphic.

16 writeStuffTo :: InChan Int -> [Int] -> IO ()
17 writeStuffTo = writeList2Chan
18 
19 getStuffOutOf :: OutChan Int -> IO [Int]
20 getStuffOutOf = getChanContents

Now I’ll demonstrate the use of our Functor and Cofunctor instances by re-defining those two functions above, after importing our Cofunctor class

17 import Data.Cofunctor
18 
19 ...
20 
21 -- we could convert the [Int] to [String] here but will instead demonstrate the
22 -- Cofmap instance:
23 writeStuffTo :: InChan String -> [Int] -> IO ()
24 writeStuffTo = writeList2Chan . cofmap show
25 
26 -- likewise this demonstrates the Functor instance of OutChan:
27 getStuffOutOf :: OutChan String -> IO [Int]
28 getStuffOutOf = getChanContents . fmap read

All right, leave your love or hate and stay tuned for the new (less stupider) simple-actors lib.

This is a bit of literate haskell code that works through a system for running concurrent IO computations that are synchronized on a stream. So we have many “nodes” of the type :: a -> IO () running concurrently on a single stream, where we would like each node to wait until all nodes have processed a stream element before any are allowed to proceed onto the next element.

This was motivated by the desire to simulate a system in which many nodes are interacting independently according to a time-synchronized algorithm. So the “stream” the nodes process is time.

I wanted to use real concurrency because it sounded fun. It would of course be possible to simulate a time-synchronized system without using real concurrency.

0.10.0

• Eq and Ord instances now compare on free “contents” type variable
• we provide `equalShape` function for comparison of shape and filenames
  of arbitrary trees (ignoring free “contents” variable)
• provide a comparingShape used in sortDirShape
• provide a `sortDirShape` function that sorts a tree, taking into
  account the free file “contents” data

Now that equality and comparison functions that ignore the contents of Files are out of the Eq and Ord instances, we can make those types of comparisons on DirTrees of different types.

You can pick it up with a

$ cabal install directory-tree

To adapt the module to a problem, one defines the following:

1. a type Case into which we will parse a test case (i.e. problem)
2. a type SolvedCase, representing a solution to a test case
3. our algorithm :: Case -> SolvedCase
4. a Parser caseParser which can parse a single test case (n.b. not the whole file) into the Case type
5. a function formatCase :: SolvedCase -> String which brings the solution to the state where it can be prepended with the standard “Case #1: ” string

Here is the module, filled in to solve the Minimum Scalar Product practice problem. You can download the code here:

module Main
    where

import Text.ParserCombinators.Parsec
import IO hiding (try)
import System.Environment

-- PROBLEM-SPECIFIC IMPORTS --
import Data.List (sort)
import Control.Arrow
------------------------------


-- the input file will be parsed into a list of some type representing
-- individual cases to be solved by our algorithm:
type Input = [Case] 

-- our algorithms will produce a list of some type SolutionCase:
type Solution = [SolvedCase] 

-- we convert each solved case into a String, which is zipped with
--  the standard "Case #x: " strings for the final output
type Output = [String]





-- --------------- BEGIN EDITING --------------- --



-- DEFINE A TYPE TO REPRESENT A SINGLE UNSOLVED TEST CASE: --
type Case =
    -- EXAMPLE: a pair of lists of Ints (our "vectors"):
    ([Int],[Int])


-- DEFINE A TYPE TO REPRESENT A SINGLE SOLVED TEST CASE: --
type SolvedCase = 
    -- EXAMPLE: our Minimum Scalar Product as an Int:
    Int


     -- -- -- ALGORITHMS -- -- --


-- SOLVE A TEST CASE HERE:
algorithm :: Case -> SolvedCase
algorithm = 
    -- EXAMPLE: simply sort both lists, reverse one, and combine:
    sum . uncurry (zipWith (*)) . (reverse . sort *** sort)



    -- -- -- PARSING INPUT -- -- --


-- DEFINE PARSER FOR A TEST CASE: --
caseParser :: Parser Case
caseParser = do
     -- EXAMPLE: parses a case consisting of 3 lines: the first describes the
     --  number n of elements in the following two lines, the next two lines
     -- have n space-separated elements:
    w <- word
    let n = read w
    as <- count n word
    bs <- count n word
    return  (map read as, map read bs)



     -- -- -- FORMAT OUTPUT -- -- --


-- DEFINE A FUNCTION FROM AN INDIVIDUAL SolvedCase -> String.
formatCase :: SolvedCase -> String
formatCase sol = 
    -- EXAMPLE: nothing to speak of here:
    show sol
    
  

-- --------------- STOP EDITING --------------- --



    --------------------
    -- IO BOILERPLATE --
    --------------------


main = do
    
     -- pass the input file name to our program:
    (f:_) <- getArgs
    file  <- readFile f

     -- start parsing, solve problem, and prepare output:
    let inp  = parseWith mainParser file
        solution        = map algorithm inp
        solutionStrings = map formatCase solution
        outp = zipWith (++) prefixes solutionStrings
    
     -- write the prepared output to screen:
    putStr $ unlines outp


-- dies with error, or returns some datatype with our parsed data:
parseWith p = either (error . show) id . parse p "" 

-- to begin parsing, we read in a line containing the number of test cases
-- to follow. We parse them with caseParser, returning a list:
mainParser :: Parser Input
mainParser = do
    n  <- word
    ms <- count (read n) caseParser 
    return ms
    <?> "mainParser"

-- strings to prepend to output:
prefixes = [ "Case #" ++ show n ++ ": " | n <- [1..]]





    ---------------------
    -- VARIOUS PARSERS --
    ---------------------


-- -- LINE PARSERS -- --


-- a single line String, up to the newline:
wholeLine :: Parser String
wholeLine = manyTill anyChar (try newline) <?> "wholeLine"

-- parse a String with whitespace-separated values into [String]
whiteSepLine = manyTill spaceSepWord newline <?> "whiteSepLine"


-- -- WORD PARSERS -- --


-- a single word followed by whitespace (space, newline, etc.):
word = do
    w <- many1 nonWhite
    spaces
    return w
    <?> "word"

-- a single word followed by one or more ' ' characters (won't consume '\n')
spaceSepWord = do
    w <- many1 nonWhite
    many (char ' ')
    return w
    <?> "spaceSepWord"

-- e.g. "hello:world" ---> ("hello","world")
-- won't consume newlines
twoWordsSepBy c = do
    x <- manyTill nonWhite (try$ char c)
    y <- many1 nonWhite
    many (char ' ')
    return (x,y)
    <?> "twoWordsSepBy"


-- -- CHARACTER PARSERS -- --


-- nonWhitespace character:
nonWhite = noneOf " \v\f\t\r\n" <?> "nonWhite"

It’s very likely there are some bugs, especially related to cross platform issues with file names and paths. The module is also fairly bare, so please send me any requests for functionality that I haven’t thought of, as well as any bugs you might find.

You can install it with:

$ cabal install directory-tree

And get the source with:

$ darcs get http://coder.bsimmons.name/code/DirectoryTree/

I hope this is useful to someone!

UPDATE: I’ve just released v0.9.0 of this package which has a number of sneaky changes and additions, most notably the inclusion of a readDirectoryWithL function that allows for lazy directory reading IO. This will let users work with a DirTree read from disk just as if it was a pure lazy data structure, while IO is done in the background as needed. No more exploding code! (hopefully)