Add remaining haskell book exercises

Haskell-book/26/Exercises/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+Exercises.cabal
+*~

Haskell-book/26/Exercises/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

Haskell-book/26/Exercises/app/Main.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Data.IORef
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as TL
+import System.Environment (getArgs)
+import Web.Scotty.Trans ( ScottyT(..)
+                        , ActionT(..)
+                        , scottyT
+                        , get
+                        , html
+                        , param )
+
+data Config =
+    Config {
+        -- that's one, one click!
+        -- two...two clicks!
+        -- Three BEAUTIFUL clicks! ah ah ahhhh
+        counts :: IORef (M.Map Text Integer)
+      , prefix :: Text
+    }
+
+type Scotty = ScottyT Text (ReaderT Config IO)
+
+bumpBoomp :: Text
+    -> M.Map Text Integer
+    -> (M.Map Text Integer, Integer)
+bumpBoomp k m =
+    let (maybeCount, newMap) = M.insertLookupWithKey (\_ _ oldCount -> oldCount + 1) k 1 m
+    in case maybeCount of
+        Nothing -> (newMap, 1)
+        Just oldCount -> (newMap, oldCount + 1)
+
+app :: Scotty ()
+app =
+    get "/:key" $ do
+        unprefixed <- param "key"
+        prefix <- lift $ asks prefix
+        let key' = mappend prefix unprefixed
+        counts <- lift $ asks counts
+        (newMap, newInteger) <- liftIO $ bumpBoomp key' <$> readIORef counts
+        liftIO $ writeIORef counts newMap
+        html $ mconcat [ "<h1>Success! Count was: "
+                       , TL.pack $ show (newInteger :: Integer)
+                       , "</h1>"
+                       ]
+
+main :: IO ()
+main = do
+    [prefixArg] <- getArgs
+    counter <- newIORef M.empty
+    let config = Config {counts = counter, prefix = TL.pack prefixArg}
+        runR = flip runReaderT config
+    scottyT 3000 runR app

Haskell-book/26/Exercises/package.yaml

@@ -0,0 +1,37 @@
+name:                Exercises
+version:             0.1.0.0
+license:             BSD3
+author:              "Eugen Wissner"
+maintainer:          "belka@caraus.de"
+copyright:           "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- containers
+- scotty
+- transformers
+- text
+
+library:
+  source-dirs: src
+
+executables:
+  HitCounter:
+    main:        Main.hs
+    source-dirs: app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+
+tests:
+  Exercises-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - Exercises
+    - hspec

Haskell-book/26/Exercises/src/Exercises.hs

@@ -0,0 +1,75 @@
+module Exercises where
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Reader (Reader(..), ReaderT(..), runReader, runReaderT)
+import Control.Monad.Trans.State (StateT(..))
+import Data.Functor.Identity (Identity(..))
+
+-- 1. rDec is a function that should get its argument in the context of
+-- Reader and return a value decremented by one.
+--
+-- Note that “Reader” from transformers is ReaderT of Identity and
+-- that runReader is a convenience function throwing away the
+-- meaningless structure for you. Play with runReaderT if you like.
+rDec :: Num a => Reader a a
+rDec = ReaderT $ dec
+    where dec :: Num a => a -> Identity a
+          dec = return . (flip (-) 1)
+
+-- 2. Once you have an rDec that works, make it and any inner lamb-
+-- das pointfree if that’s not already the case.
+
+
+-- 3. rShow is show, but in Reader.
+rShow :: Show a => Reader a String
+rShow = ReaderT $ toString
+    where toString = return . show
+
+-- 4. Once you have an rShow that works, make it pointfree.
+
+
+-- 5. rPrintAndInc will first print the input with a greeting, then return
+-- the input incremented by one.
+rPrintAndInc :: (Num a, Show a) => ReaderT a IO a
+rPrintAndInc = ReaderT print
+    where print x = do
+            liftIO $ putStrLn $ "Hi: " ++ show x
+            return $ x + 1
+
+-- Prelude> runReaderT rPrintAndInc 1
+-- Hi: 1
+-- 2
+-- Prelude> traverse (runReaderT rPrintAndInc) [1..10]
+-- Hi: 1
+-- Hi: 2
+-- Hi: 3
+-- Hi: 4
+-- Hi: 5
+-- Hi: 6
+-- Hi: 7
+-- Hi: 8
+-- Hi: 9
+-- Hi: 10
+-- [2,3,4,5,6,7,8,9,10,11]
+
+
+-- 6. sPrintIncAccum first prints the input with a greeting, then puts
+-- the incremented input as the new state, and returns the original
+-- input as a String.
+sPrintIncAccum :: (Num a, Show a) => StateT a IO String
+sPrintIncAccum = StateT print
+    where print x = do
+            liftIO $ putStrLn $ "Hi: " ++ show x
+            return $ (show x, x + 1)
+
+-- Prelude> runStateT sPrintIncAccum 10
+-- Hi: 10
+-- ("10",11)
+-- Prelude> mapM (runStateT sPrintIncAccum) [1..5]
+-- Hi: 1
+-- Hi: 2
+-- Hi: 3
+-- Hi: 4
+-- Hi: 5
+-- [("1",2),("2",3),("3",4),("4",5),("5",6)]

Haskell-book/26/Exercises/src/Fix.hs

@@ -0,0 +1,24 @@
+module Fix where
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Maybe
+import Control.Monad
+
+isValid :: String -> Bool
+isValid v = '!' `elem` v
+
+maybeExcite :: MaybeT IO String
+maybeExcite = do
+    v <- liftIO getLine
+    guard $ isValid v
+    return v
+
+doExcite :: IO ()
+doExcite = do
+    putStrLn "say something excite!"
+    excite <- runMaybeT maybeExcite
+    case excite of
+      Nothing -> putStrLn "MOAR EXCITE"
+      Just e ->
+          putStrLn
+            ("Good, was very excite: " ++ e)

Haskell-book/26/Exercises/stack.yaml

@@ -0,0 +1,65 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-11.8
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#  subdirs:
+#  - auto-update
+#  - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# using the same syntax as the packages field.
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

Haskell-book/26/Exercises/test/Spec.hs

@@ -0,0 +1,19 @@
+import Control.Monad.Trans.Reader
+import Exercises
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+    describe "rDec" $ do
+        it "returns a value decremented by one" $ do
+            runReader rDec 1 `shouldBe` 0
+
+        it "decrements all elements of a list" $ do
+            (fmap (runReader rDec) [1..10]) `shouldBe` [0,1,2,3,4,5,6,7,8,9]
+
+    describe "rShow" $ do
+        it "shows a number" $ do
+            runReader rShow 1 `shouldBe` "1"
+
+        it "shows a list" $ do
+            (fmap (runReader rShow) [1..10]) `shouldBe` ["1","2","3","4","5","6","7","8","9","10"]