[Haskell-cafe] Re: new Haskell hacker seeking peer review

Andreas Farre d00farre at dtek.chalmers.se
Wed Feb 23 09:56:45 EST 2005


Bjorn Bringert said:
>
> Or why not the two characters shorter, but much less readable:
>
> pointsFreeCat' = getArgs >>= mapM_ ((>>= putStr) . readFile)
>
> or maybe:
>
> pointsFreeCat'' = getArgs >>= mapM_ (putStr >>. readFile)
>
> (>>.) :: (b -> IO c) -> (a -> IO b) -> a -> IO c
> (>>.) = (.) . flip (>>=)
>
> Is (>>.) in the standard libs? If not, should it be? I'm sure there is a
> shorter definition of (>>.) that I haven't thought of.
>
> /Bjorn

Or even:

k :: Monad m => (a -> m b) -> Kleisli m a b
k = Kleisli

runKleisli :: Monad m => Kleisli m a b -> (a -> m b)
runKleisli (Kleisli f) = f

cat :: IO ()
cat = getArgs >>= (runKleisli $ (k $ mapM readFile) >>> (k $ mapM_ putStr))

after noticing that (>>.) is pretty similar to (<<<) when we lift (a -> IO
b) to (Kleisli IO a b). It is pretty disappointing that runKleisli isn't
defined so that I can be cool and completely point free too ;)

/Andreas

-- 
some cannot be created more equal than others



More information about the Haskell-Cafe mailing list