diff --git a/29-io/29-io.md b/29-io/29-io.md new file mode 100644 index 0000000..42192b6 --- /dev/null +++ b/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! \ No newline at end of file diff --git a/29-io/src/IniDir.hs b/29-io/src/IniDir.hs new file mode 100644 index 0000000..bb52a10 --- /dev/null +++ b/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." \ No newline at end of file diff --git a/29-io/src/Vigenere.hs b/29-io/src/Vigenere.hs new file mode 100644 index 0000000..3debdaa --- /dev/null +++ b/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) ." + +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) ." diff --git a/29-io/src/WhatHappens.hs b/29-io/src/WhatHappens.hs new file mode 100644 index 0000000..dcb4113 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/29-io/src/ini/dontparse.txt b/29-io/src/ini/dontparse.txt new file mode 100644 index 0000000..98d8c3f --- /dev/null +++ b/29-io/src/ini/dontparse.txt @@ -0,0 +1 @@ +don't parse me! diff --git a/29-io/src/ini/example1.ini b/29-io/src/ini/example1.ini new file mode 100644 index 0000000..0ef22a5 --- /dev/null +++ b/29-io/src/ini/example1.ini @@ -0,0 +1,6 @@ +[Main] +answer=42 +name=gael ; this is a test + +[SubSection] +description=hmmm diff --git a/29-io/src/ini/example2.ini b/29-io/src/ini/example2.ini new file mode 100644 index 0000000..13bd069 --- /dev/null +++ b/29-io/src/ini/example2.ini @@ -0,0 +1,7 @@ +# boy o boy + +[Phasers] +set=stun + +[Second] +first=last