Let's play Haskell! - #6 - IO

.gitignore

io
redis
*.hi
*.o
bin
config
vendor

bootstrap

#!/bin/bash

REDIS_VERSION=redis-2.6.7
URL=http://redis.googlecode.com/files/$REDIS_VERSION.tar.gz

if [ ! -d "vendor" ]; then
	mkdir vendor
	pushd vendor
	if which wget > /dev/null; then
		wget $URL
	else
		curl -O $URL
	fi
	tar xvf $REDIS_VERSION.tar.gz
	pushd $REDIS_VERSION
	make
	popd
	popd
fi

if [ ! -d "config" ]; then
	mkdir config
	cp vendor/$REDIS_VERSION/redis.conf config/
fi

if [ ! -d "bin" ]; then
	mkdir bin
	cp vendor/$REDIS_VERSION/src/redis-server bin/
	cp vendor/$REDIS_VERSION/src/redis-cli bin/
fi

io.hs

import System.IO
import Data.Char

-- http://www.haskell.org/ghc/docs/7.4.2/html/libraries/base-4.5.1.0/System-IO.html


main :: IO ()
main = fileStuff

consoleStuff = do
     putStrLn "Greetings, mortal! What's your name?"
     name <- getLine
     putStrLn $ "Hello and welcome, " ++ name ++ ". I wanna play a game!"

fileStuff = do
          inh <- openFile "sample.haiku" ReadMode
          outh <- openFile "/tmp/haiku.upper" WriteMode
          haiku <- hGetContents inh
          putStrLn haiku
          hPutStr outh $ uppercase haiku
          hClose inh
          hClose outh

fileStuffShort = do
          haiku <- readFile "sample.haiku"
          putStrLn haiku
          writeFile "/tmp/haiku.upper" $ uppercase haiku

uppercase :: String -> String
uppercase = map toUpper

redis.hs

import Data.Char (toUpper)
import Data.List (intercalate)
import Network
import System.IO

main :: IO ()
main = do
     r1 <- request (command ["GET", "foo"])
     putStrLn $ "foo is " ++ r1
     request (command ["SET", "foo", "bar"])
     r2 <- request (command ["GET", "foo"])
     putStrLn $ "foo's new value is " ++ r1

command :: [String] -> String
command params@(cmd:args) = header ++ cmdPart ++ argsPart 
        where header = line $ "*" ++ show (length params)
              cmdPart = prepareArg $ map toUpper cmd
              argsPart = intercalate "" $ map prepareArg args
              prepareArg arg = line ("$" ++ show (length arg)) ++ line (arg)
              line s = s ++ crlf
              crlf = "\r\n"

request :: String -> IO String
request query = do
        socket <- connectTo "localhost" (PortNumber 6379)
        hSetBuffering socket LineBuffering
        hPutStr socket query
        resp <- hGetContents socket 
        resp `seq` hClose socket
        return resp

sample.haiku

As the wind does blow
        Across the trees, I see the
                Buds blooming in May          
 
I walk across sand
And find myself blistering
In the hot, hot heat
 
Falling to the ground,
        I watch a leaf settle down
In a bed of brown.
 
It’s cold—and I wait
For someone to shelter me
And take me from here.
 
I hear crackling
Crunch, of today’s new found day
And know it won’t last
So I will leave it
At bay; and hope for the best
This bitter new day