Complete chapter 29

29-io/29-io.md

@@ -0,0 +1,26 @@
+# 29 IO
+
+## 29.9 Chapter Exercises
+
+### File I/O with Vigenère
+
+see [src/Vigenere.hs](./src/Vigenere.hs)
+
+```shell
+> echo "this is a test!" | ./Vigenere -e blah | ./Vigenere -d blah
+this is a test!
+```
+
+### Add timeouts to your utility
+
+see [src/Vigenere.hs](./src/Vigenere.hs)
+
+The `hWaitForInput` does not work so well though. It needs a newline to not
+timeout. Or, of course, an EOF.
+
+### Config Directories
+
+see [src/IniDir.hs](./src/IniDir.hs)
+
+There are some bugs in my parser (e.g. comments after values), but the logic
+of checking the dirctory works!

29-io/src/IniDir.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Main where
+
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Data.Char (isAlpha)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Text.Trifecta
+import System.Directory (listDirectory)
+import System.FilePath (takeExtension)
+import Control.Exception (try)
+import System.Environment (getArgs)
+
+newtype Header = Header String deriving (Eq, Ord, Show)
+
+parseBracketPair :: Parser a -> Parser a
+parseBracketPair p = char '[' *> p <* char ']'
+
+parseHeader :: Parser Header
+parseHeader = parseBracketPair (Header <$> some letter)
+
+assignmentEx :: ByteString
+assignmentEx = "woot=1"
+
+type Name = String
+type Value = String
+type Assignments = Map Name Value
+
+parseAssignment :: Parser (Name, Value)
+parseAssignment = do
+    name <- some letter
+    _ <- char '='
+    val <- some (noneOf "\n")
+    skipEOL -- important!
+    return (name, val)
+
+    -- | Skip end of lien and whitespace beyond.
+skipEOL :: Parser ()
+skipEOL = skipMany (oneOf "\n")
+
+-- | Skip comments starting at the beginning of the line
+skipComments :: Parser ()
+skipComments = skipMany $ do
+    _ <- char ';' <|> char '#'
+    skipMany (noneOf "\n")
+    skipEOL
+
+data Section = Section Header Assignments deriving (Eq, Show)
+
+newtype Config = Config (Map Header Assignments) deriving (Eq, Show)
+
+skipWhitespace :: Parser ()
+skipWhitespace = skipMany (char ' ' <|> char '\n')
+
+parseSection :: Parser Section
+parseSection = do
+    skipWhitespace
+    skipComments
+    h <- parseHeader
+    skipEOL
+    assignments <- some parseAssignment
+    return $ Section h (M.fromList assignments)
+
+rollup :: Section -> Map Header Assignments -> Map Header Assignments
+rollup (Section h a) m = M.insert h a m
+
+parseIni :: Parser Config
+parseIni = do
+    sections <- some parseSection
+    let mapOfSections = foldr rollup M.empty sections
+    return $ Config mapOfSections
+
+parseIniFromFile :: FilePath -> IO (Maybe Config)
+parseIniFromFile fp = do
+    s <- readFile fp
+    let parsed = parseString parseIni mempty s
+    case parsed of
+        (Success a) -> return $ Just a
+        _ -> return Nothing
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [dir] -> do
+            l <- Control.Exception.try $ listDirectory dir
+            case l of
+                Left e -> ioError e
+                Right xs -> do
+                    let xs' = filter ((==) ".ini" . takeExtension) xs
+                        f x = sequenceA (x, parseIniFromFile (dir ++ "/" ++ x))
+                        xs'' = sequenceA $ fmap f xs'
+                    xs''' <- xs''
+                    print $ M.fromList xs'''
+        _ -> putStrLn "Need directory as argument."

29-io/src/Vigenere.hs

@@ -0,0 +1,78 @@
+module Main where
+
+import Data.Char
+import System.Environment (getArgs)
+import System.IO (hPutStr, hGetChar, stdout, stdin, hWaitForInput
+                 , stderr, interact)
+import System.Exit (exitFailure)
+import Control.Exception (try)
+import System.IO.Error (isEOFError, ioError)
+
+alphaIndex :: Char -> Int
+alphaIndex c
+    | elem c ['a'..'z'] = ord c - ord 'a'
+    | elem c ['A'..'Z'] = ord c - ord 'A'
+    | otherwise = 0
+
+shift :: (Int -> Int -> Int) -> Char -> Char -> Char
+shift f c k
+    | elem c ['a'..'z'] = go c k 'a'
+    | elem c ['A'..'Z'] = go c k 'A'
+    | otherwise = c
+    where go p key base = let rel = f (alphaIndex p) (alphaIndex key)
+                              r = 26
+                              b = ord base
+                          in chr $ (mod rel r) + b
+
+-- wrote own zipWith variant which maps only when isAlpha
+vigenere :: (Int -> Int -> Int) -> [Char] -> [Char] -> [Char]
+vigenere _ xs [] = xs -- necessary to avoid bottom
+vigenere f xs ys = myZipWith (shift f) xs ys
+    where myZipWith _ [] _  = []
+          myZipWith f s [] = myZipWith f s ys
+          myZipWith f (a:as) k@(b:bs) =
+            if isAlpha a
+            then f a b : myZipWith f as bs
+            else     a : myZipWith f as k
+
+readAll :: IO String
+readAll = do
+    b <- try $ hWaitForInput stdin 5000
+    case b of
+        Left e -> if isEOFError e
+                  then return ""
+                  else ioError e
+        Right False -> do
+            hPutStr stderr $ "Timeout."
+            exitFailure
+        Right True -> do
+            c <- hGetChar stdin
+            fmap (c:) readAll
+
+encrypt :: String -> IO ()
+encrypt key = do
+    s <- readAll
+    let s' = vigenere (+) s key
+    hPutStr stdout s'
+
+decrypt :: String -> IO ()
+decrypt key = do
+    s <- readAll
+    let s' = vigenere (-) s key
+    hPutStr stdout s'
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        ["-e", key] -> encrypt key
+        ["-d", key] -> decrypt key
+        otherwise -> putStrLn "Invalid arguments. Use (-d|-e) <key>."
+
+anotherWay :: IO ()
+anotherWay = do
+    args <- getArgs
+    case args of
+        ["-e", key] -> interact $ flip (vigenere (+)) key
+        ["-d", key] -> interact $ flip (vigenere (-)) key
+        otherwise -> putStrLn "Invalid arguments. Use (-d|-e) <key>."

29-io/src/WhatHappens.hs

@@ -0,0 +1,15 @@
+module WhatHappens where
+
+import Control.Concurrent
+
+myData :: IO (MVar Int)
+myData = newEmptyMVar
+
+main :: IO ()
+main = do
+    mv <- myData
+    putMVar mv 0
+    mv' <- myData
+    putMVar mv' 0
+    zero <- takeMVar mv'
+    print zero

29-io/src/ini/dontparse.txt

@@ -0,0 +1 @@
+don't parse me!

29-io/src/ini/example1.ini

@@ -0,0 +1,6 @@
+[Main]
+answer=42
+name=gael ; this is a test
+
+[SubSection]
+description=hmmm

29-io/src/ini/example2.ini

@@ -0,0 +1,7 @@
+# boy o boy
+
+[Phasers]
+set=stun
+
+[Second]
+first=last