diff --git a/Haskell-book/12/Exercises.hs b/Haskell-book/12/Exercises.hs
new file mode 100644
index 0000000..73b81ba
--- /dev/null
+++ b/Haskell-book/12/Exercises.hs
@@ -0,0 +1,202 @@
+module Exercises where
+
+import Data.List
+
+--
+-- 1
+--
+notThe :: String -> Maybe String
+notThe x
+ | x == "the" = Nothing
+ | otherwise = Just x
+
+replaceThe :: String -> String
+replaceThe x = unwords $ map f (words x)
+ where f = f' . notThe
+ f' (Nothing) = "a"
+ f' (Just y) = y
+
+isVowel :: Char -> Bool
+isVowel c
+ | c == 'a' = True
+ | c == 'e' = True
+ | c == 'i' = True
+ | c == 'o' = True
+ | c == 'u' = True
+ | otherwise = False
+
+--
+-- 2
+--
+countTheBeforeVowel :: String -> Integer
+countTheBeforeVowel n = f False (words n)
+ where f _ [] = 0
+ f v (x:xs)
+ | x == "the" = f True xs
+ | v == True = (if isVowel (head x) then 1 else 0) + (f False xs)
+ | otherwise = f False xs
+
+--
+-- 3
+--
+countVowels :: String -> Integer
+countVowels s = fromIntegral $ length $ filter isVowel s
+
+--
+-- Validate the word
+--
+newtype Word' = Word' String deriving (Show, Eq)
+
+vowels :: String
+vowels = "aeiou"
+
+mkWord :: String -> Maybe Word'
+mkWord w = if (countVowels w) > (div (fromIntegral $ length w) 2)
+ then Nothing
+ else Just (Word' w)
+
+--
+-- It's only Natural
+--
+data Nat = Zero | Succ Nat deriving (Eq, Show)
+
+natToInteger :: Nat -> Integer
+natToInteger Zero = 0
+natToInteger (Succ n) = 1 + natToInteger n
+
+integerToNat :: Integer -> Maybe Nat
+integerToNat n
+ | n < 0 = Nothing
+ | n == 0 = Just Zero
+ | otherwise = Just (f n)
+ where f 0 = Zero
+ f n = Succ (f (n - 1))
+
+--
+-- Small library for Maybe
+--
+--
+-- 1
+--
+isJust :: Maybe a -> Bool
+isJust (Just _) = True
+isJust Nothing = False
+
+isNothing :: Maybe a -> Bool
+isNothing (Just _) = False
+isNothing Nothing = True
+
+--
+-- 2
+--
+mayybee :: b -> (a -> b) -> Maybe a -> b
+mayybee v f Nothing = v
+mayybee v f (Just x) = f x
+
+--
+-- 3
+--
+fromMaybe :: a -> Maybe a -> a
+fromMaybe x Nothing = x
+fromMaybe _ (Just x) = x
+
+--
+-- 4
+--
+listToMaybe :: [a] -> Maybe a
+listToMaybe [] = Nothing
+listToMaybe (x:xs) = Just x
+
+maybeToList :: Maybe a -> [a]
+maybeToList Nothing = []
+maybeToList (Just x) = [x]
+
+catMaybes :: [Maybe a] -> [a]
+catMaybes = foldr f []
+ where f Nothing xs = xs
+ f (Just x) xs = x : xs
+
+flipMaybe :: [Maybe a] -> Maybe [a]
+flipMaybe x = if (length x) == (length y) then (Just y) else Nothing
+ where y = catMaybes x
+
+lefts' :: [Either a b] -> [a]
+lefts' = foldr f []
+ where f (Left x) xs = x : xs
+ f _ xs = xs
+
+rights' :: [Either a b] -> [b]
+rights' = foldr f []
+ where f (Right x) xs = x : xs
+ f _ xs = xs
+
+partitionEithers' :: [Either a b] -> ([a], [b])
+partitionEithers' n = (lefts' n, rights' n)
+
+eitherMaybe' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe' _ (Left x) = Nothing
+eitherMaybe' f (Right x) = Just $ f x
+
+either' :: (a -> c) -> (b -> c) -> Either a b -> c
+either' f _ (Left x) = f x
+either' _ f (Right x) = f x
+
+eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c
+eitherMaybe'' f = either' (\_ -> Nothing) (\x -> Just $ f x)
+
+--
+-- Unfolds
+--
+mehSum :: Num a => [a] -> a
+mehSum xs = go 0 xs
+ where go :: Num a => a -> [a] -> a
+ go n [] = n
+ go n (x:xs) = (go (n + x) xs)
+
+niceSum :: Num a => [a] -> a
+niceSum = foldl' (+) 0
+
+mehProduct :: Num a => [a] -> a
+mehProduct xs = go 1 xs
+ where go :: Num a => a -> [a] -> a
+ go n [] = n
+ go n (x:xs) = (go (n*x) xs)
+
+niceProduct :: Num a => [a] -> a
+niceProduct = foldl' (*) 1
+
+mehConcat :: [[a]] -> [a]
+mehConcat xs = go [] xs
+ where go :: [a] -> [[a]] -> [a]
+ go xs' [] = xs'
+ go xs' (x:xs) = (go (xs' ++ x) xs)
+
+niceConcat :: [[a]] -> [a]
+niceConcat = foldr (++) []
+
+myIterate :: (a -> a) -> a -> [a]
+myIterate f x = go x
+ where go x = x : (go (f x))
+
+myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a]
+myUnfoldr f x = g (f x)
+ where g Nothing = []
+ g (Just (x, y)) = x : g (f y)
+
+betterIterate :: (a -> a) -> a -> [a]
+betterIterate f x = myUnfoldr (\y -> Just (y, f y)) x
+
+data BinaryTree a = Leaf
+ | Node (BinaryTree a) a (BinaryTree a)
+ deriving (Eq, Show)
+
+unfold :: (a -> Maybe (a, b, a)) -> a -> BinaryTree b
+unfold f x = g (f x)
+ where g Nothing = Leaf
+ g (Maybe (m, n, o)) = Node (BinaryTree m) n (BinaryTree o)
+
+treeBuild :: Integer -> BinaryTree Integer
+treeBuild = unfold f
+ where f n
+ | n <= 0 = Nothing
+ | otherwise = Just (k - 1, n, k - 1)
diff --git a/Haskell-book/12/Maybe.hs b/Haskell-book/12/Maybe.hs
new file mode 100644
index 0000000..e83176e
--- /dev/null
+++ b/Haskell-book/12/Maybe.hs
@@ -0,0 +1,19 @@
+module Maybe where
+
+--
+-- 1
+--
+isJust :: Maybe a -> Bool
+isJust (Just _) = True
+isJust Nothing = False
+
+isNothing :: Maybe a -> Bool
+isNothing (Just _) = False
+isNothing Nothing = True
+
+--
+-- 2
+--
+mayybee :: b -> (a -> b) -> Maybe a -> b
+mayybee v f Nothing = b
+mayybee v f (Maybe x) = f x
diff --git a/Haskell-book/13/Cipher.hs b/Haskell-book/13/Cipher.hs
new file mode 100644
index 0000000..55dc7c4
--- /dev/null
+++ b/Haskell-book/13/Cipher.hs
@@ -0,0 +1,16 @@
+module Cipher where
+
+import Data.Char
+import Data.List
+
+vigenere :: String -> String
+vigenere = f (cycle [0, 11, 11, 24])
+ where f _ [] = []
+ f ys (' ':xs) = ' ' : (f ys xs)
+ f (y:ys) (x:xs) = (decode (x, y)) : (f ys xs)
+ where decode (x, y) = chr ((mod ((ord x) - 65 + y) 26) + 65)
+
+main :: IO ()
+main = do
+ i <- getLine
+ putStrLn $ vigenere i
diff --git a/Haskell-book/13/Palindrome.hs b/Haskell-book/13/Palindrome.hs
new file mode 100644
index 0000000..439c980
--- /dev/null
+++ b/Haskell-book/13/Palindrome.hs
@@ -0,0 +1,20 @@
+module Palindrome where
+
+import Control.Monad
+import Data.Char
+import System.Exit
+
+format :: String -> String
+format s = filter (\x -> x >= 'a' && x <= 'z') (map toLower s)
+
+palindrome :: IO ()
+palindrome = forever $ do
+ line1 <- getLine
+ case ((format line1) == (format $ reverse line1)) of
+ True -> putStrLn "It's a palindrome!"
+ False -> do
+ putStrLn "Nope!"
+ exitSuccess
+
+main :: IO ()
+main = palindrome
diff --git a/Haskell-book/13/Person.hs b/Haskell-book/13/Person.hs
new file mode 100644
index 0000000..c104a53
--- /dev/null
+++ b/Haskell-book/13/Person.hs
@@ -0,0 +1,34 @@
+module Person where
+
+type Name = String
+type Age = Integer
+
+data Person = Person Name Age deriving Show
+
+data PersonInvalid = NameEmpty
+ | AgeTooLow
+ | PersonInvalidUnknown String
+ deriving (Eq, Show)
+
+mkPerson :: Name -> Age -> Either PersonInvalid Person
+mkPerson name age
+ | name /= "" && age > 0 = Right $ Person name age
+ | name == "" = Left NameEmpty
+ | not (age > 0) = Left AgeTooLow
+ | otherwise =
+ Left $ PersonInvalidUnknown $
+ "Name was: " ++ show name ++ " Age was: " ++ show age
+
+showPerson :: Either PersonInvalid Person -> String
+showPerson (Left NameEmpty) = "Name is empty"
+showPerson (Left AgeTooLow) = "Age is too low"
+showPerson (Left (PersonInvalidUnknown e)) = e
+showPerson (Right p) = "Yay! Successfully got a person: " ++ (show p)
+
+gimmePerson :: IO ()
+gimmePerson = do
+ putStr "Enter your name: "
+ name <- getLine
+ putStr "Enter your age: "
+ age <- getLine
+ putStrLn $ showPerson $ mkPerson name (read age)
diff --git a/Haskell-book/14/addition/Addition.hs b/Haskell-book/14/addition/Addition.hs
new file mode 100644
index 0000000..474eecd
--- /dev/null
+++ b/Haskell-book/14/addition/Addition.hs
@@ -0,0 +1,35 @@
+module Addition where
+
+import Test.Hspec
+import Test.QuickCheck
+
+dividedBy :: Integral a => a -> a -> (a, a)
+dividedBy num denom = go num denom 0
+ where go n d count
+ | n < d = (count, n)
+ | otherwise = go (n - d) d (count + 1)
+
+multiplyBy :: (Ord a, Eq a, Num a) => a -> a -> a
+multiplyBy a b
+ | a == 0 || b == 0 = 0
+ | a > 0 && b > 0 = multiplyBy' a b
+ | a < 0 && b < 0 = multiplyBy' (-a) (-b)
+ | a < 0 && b > 0 = -(multiplyBy' (-a) b)
+ | a > 0 && b < 0 = -(multiplyBy' a (-b))
+ where multiplyBy' c 1 = c
+ multiplyBy' c d = c + (multiplyBy c (d - 1))
+
+main :: IO ()
+main = hspec $ do
+ describe "Addition" $ do
+ it "15 divided by 3 is 5" $ do
+ dividedBy 15 3 `shouldBe` (5, 0)
+ it "22 divided by 5 is 4 remainder 2" $ do
+ dividedBy 22 5 `shouldBe` (4, 2)
+ it "x + 1 is always greater than x" $ do
+ property $ \x -> x + 1 > (x :: Int)
+ describe "Multiplication" $ do
+ it "15 multiplied by 3 is 45" $ do
+ multiplyBy 15 3 `shouldBe` 45
+ it "22 multiplied by 5 is 110" $ do
+ multiplyBy 22 5 `shouldBe` 110
\ No newline at end of file
diff --git a/Haskell-book/14/addition/LICENSE b/Haskell-book/14/addition/LICENSE
new file mode 100644
index 0000000..6a042c2
--- /dev/null
+++ b/Haskell-book/14/addition/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file
diff --git a/Haskell-book/14/addition/README.md b/Haskell-book/14/addition/README.md
new file mode 100644
index 0000000..543097e
--- /dev/null
+++ b/Haskell-book/14/addition/README.md
@@ -0,0 +1 @@
+# addition
diff --git a/Haskell-book/14/addition/Setup.hs b/Haskell-book/14/addition/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/14/addition/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/14/addition/addition.cabal b/Haskell-book/14/addition/addition.cabal
new file mode 100644
index 0000000..1dec256
--- /dev/null
+++ b/Haskell-book/14/addition/addition.cabal
@@ -0,0 +1,17 @@
+name: addition
+version: 0.1.0.0
+license-file: LICENSE
+author: Chicken Little
+maintainer: sky@isfalling.org
+category: Text
+build-type: Simple
+cabal-version: >=1.10
+
+library
+ exposed-modules: Addition
+ ghc-options: -Wall -fwarn-tabs
+ build-depends: base >= 4.7 && < 5
+ , hspec
+ , QuickCheck
+ hs-source-dirs: .
+ default-language: Haskell2010
diff --git a/Haskell-book/14/addition/stack.yaml b/Haskell-book/14/addition/stack.yaml
new file mode 100644
index 0000000..9e311c2
--- /dev/null
+++ b/Haskell-book/14/addition/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-9.14
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.5"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/14/addition/stack.yaml.lock b/Haskell-book/14/addition/stack.yaml.lock
new file mode 100644
index 0000000..75bf3ab
--- /dev/null
+++ b/Haskell-book/14/addition/stack.yaml.lock
@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+# https://docs.haskellstack.org/en/stable/topics/lock_files
+
+packages: []
+snapshots:
+- completed:
+ sha256: 9e880f85f76b7f35a2b6edd1af333ce7f7845d47e897c3509ddd18eaa2763779
+ size: 536352
+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/14.yaml
+ original: lts-9.14
diff --git a/Haskell-book/14/morse/.gitignore b/Haskell-book/14/morse/.gitignore
new file mode 100644
index 0000000..cf4a5cf
--- /dev/null
+++ b/Haskell-book/14/morse/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+morse.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/14/morse/ChangeLog.md b/Haskell-book/14/morse/ChangeLog.md
new file mode 100644
index 0000000..1ae7856
--- /dev/null
+++ b/Haskell-book/14/morse/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for morse
+
+## Unreleased changes
diff --git a/Haskell-book/14/morse/LICENSE b/Haskell-book/14/morse/LICENSE
new file mode 100644
index 0000000..da7b69b
--- /dev/null
+++ b/Haskell-book/14/morse/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/14/morse/README.md b/Haskell-book/14/morse/README.md
new file mode 100644
index 0000000..8b8c638
--- /dev/null
+++ b/Haskell-book/14/morse/README.md
@@ -0,0 +1 @@
+# morse
diff --git a/Haskell-book/14/morse/Setup.hs b/Haskell-book/14/morse/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/14/morse/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/14/morse/src/Main.hs b/Haskell-book/14/morse/src/Main.hs
new file mode 100644
index 0000000..1f73b90
--- /dev/null
+++ b/Haskell-book/14/morse/src/Main.hs
@@ -0,0 +1,59 @@
+module Main where
+
+import Control.Monad (forever, when)
+import Data.List (intercalate)
+import Data.Traversable (traverse)
+import Morse (stringToMorse, morseToChar)
+import System.Environment (getArgs)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (hGetLine, hIsEOF, stdin)
+
+convertToMorse :: IO ()
+convertToMorse = forever $ do
+ weAreDone <- hIsEOF stdin
+ when weAreDone exitSuccess
+
+ line <- hGetLine stdin
+ convertLine line
+
+ where convertLine line = do
+ let morse = stringToMorse line
+ case morse of
+ (Just str) -> putStrLn (intercalate " " str)
+ Nothing -> do
+ putStrLn $ "ERROR: " ++ line
+ exitFailure
+
+convertFromMorse :: IO ()
+convertFromMorse = forever $ do
+ weAreDone <- hIsEOF stdin
+ when weAreDone exitSuccess
+
+ line <- hGetLine stdin
+ convertLine line
+
+ where
+ convertLine line = do
+ let decoded :: Maybe String
+ decoded = traverse morseToChar (words line)
+
+ case decoded of
+ (Just s) -> putStrLn s
+ Nothing -> do
+ putStrLn $ "ERROR: " ++ line
+ exitFailure
+
+main :: IO ()
+main = do
+ mode <- getArgs
+ case mode of
+ [arg] ->
+ case arg of
+ "from" -> convertFromMorse
+ "to" -> convertToMorse
+ _ -> argError
+ _ -> argError
+
+ where argError = do
+ putStrLn "Please specify the first argument as being 'from' or 'to' morse, such as: morse to"
+ exitFailure
\ No newline at end of file
diff --git a/Haskell-book/14/morse/src/Morse.hs b/Haskell-book/14/morse/src/Morse.hs
new file mode 100644
index 0000000..03193e5
--- /dev/null
+++ b/Haskell-book/14/morse/src/Morse.hs
@@ -0,0 +1,68 @@
+module Morse
+ ( Morse
+ , charToMorse
+ , morseToChar
+ , stringToMorse
+ , letterToMorse
+ , morseToLetter
+ ) where
+
+import qualified Data.Map as M
+
+type Morse = String
+
+letterToMorse :: (M.Map Char Morse)
+letterToMorse = M.fromList [
+ ('a', ".-")
+ , ('b', "-...")
+ , ('c', "-.-.")
+ , ('d', "-..")
+ , ('e', ".")
+ , ('f', "..-.")
+ , ('g', "--.")
+ , ('h', "....")
+ , ('i', "..")
+ , ('j', ".---")
+ , ('k', "-.-")
+ , ('l', ".-..")
+ , ('m', "--")
+ , ('n', "-.")
+ , ('o', "---")
+ , ('p', ".--.")
+ , ('q', "--.-")
+ , ('r', ".-.")
+ , ('s', "...")
+ , ('t', "-")
+ , ('u', "..-")
+ , ('v', "...-")
+ , ('w', ".--")
+ , ('x', "-..-")
+ , ('y', "-.--")
+ , ('z', "--..")
+ , ('1', ".----")
+ , ('2', "..---")
+ , ('3', "...--")
+ , ('4', "....-")
+ , ('5', ".....")
+ , ('6', "-....")
+ , ('7', "--...")
+ , ('8', "---..")
+ , ('9', "----.")
+ , ('0', "-----")
+ ]
+
+morseToLetter :: M.Map Morse Char
+morseToLetter =
+ M.foldWithKey (flip M.insert) M.empty
+ letterToMorse
+
+charToMorse :: Char -> Maybe Morse
+charToMorse c =
+ M.lookup c letterToMorse
+
+stringToMorse :: String -> Maybe [Morse]
+stringToMorse s =
+ sequence $ fmap charToMorse s
+
+morseToChar :: Morse -> Maybe Char
+morseToChar m = M.lookup m morseToLetter
\ No newline at end of file
diff --git a/Haskell-book/14/morse/src/WordNumber.hs b/Haskell-book/14/morse/src/WordNumber.hs
new file mode 100644
index 0000000..5b25ee2
--- /dev/null
+++ b/Haskell-book/14/morse/src/WordNumber.hs
@@ -0,0 +1,26 @@
+module WordNumber where
+
+import Data.List (unfoldr, intercalate)
+import Data.Maybe (Maybe(..))
+
+digitToWord :: Int -> String
+digitToWord 0 = "zero"
+digitToWord 1 = "one"
+digitToWord 2 = "two"
+digitToWord 3 = "three"
+digitToWord 4 = "four"
+digitToWord 5 = "five"
+digitToWord 6 = "six"
+digitToWord 7 = "seven"
+digitToWord 8 = "eight"
+digitToWord 9 = "nine"
+digitToWord _ = ""
+
+digits :: Int -> [Int]
+digits n = reverse $ unfoldr unfold n
+ where unfold x
+ | x == 0 = Nothing
+ | otherwise = Just ((mod x 10), (div x 10))
+
+wordNumber :: Int -> String
+wordNumber n = intercalate "-" $ map digitToWord (digits n)
\ No newline at end of file
diff --git a/Haskell-book/14/morse/stack.yaml b/Haskell-book/14/morse/stack.yaml
new file mode 100644
index 0000000..22e3463
--- /dev/null
+++ b/Haskell-book/14/morse/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-9.17
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/14/morse/stack.yaml.lock b/Haskell-book/14/morse/stack.yaml.lock
new file mode 100644
index 0000000..6ee2e72
--- /dev/null
+++ b/Haskell-book/14/morse/stack.yaml.lock
@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+# https://docs.haskellstack.org/en/stable/topics/lock_files
+
+packages: []
+snapshots:
+- completed:
+ sha256: 82ff94eacdc32a857e5aec82268644fdc3d5bfca07692ceeeb97e2d8ce5726ef
+ size: 535915
+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/17.yaml
+ original: lts-9.17
diff --git a/Haskell-book/14/morse/tests/CoArbitrary.hs b/Haskell-book/14/morse/tests/CoArbitrary.hs
new file mode 100644
index 0000000..dc0da3d
--- /dev/null
+++ b/Haskell-book/14/morse/tests/CoArbitrary.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module CoArbitrary where
+
+import GHC.Generics
+import Test.QuickCheck
+
+data Bool' = True' | False' deriving (Generic)
+
+instance CoArbitrary Bool'
+
+trueGen :: Gen Int
+trueGen = coarbitrary True' arbitrary
+
+falseGen :: Gen Int
+falseGen = coarbitrary False' arbitrary
\ No newline at end of file
diff --git a/Haskell-book/14/morse/tests/WordNumberTest.hs b/Haskell-book/14/morse/tests/WordNumberTest.hs
new file mode 100644
index 0000000..d9623a9
--- /dev/null
+++ b/Haskell-book/14/morse/tests/WordNumberTest.hs
@@ -0,0 +1,24 @@
+module Main where
+
+import Test.Hspec
+import WordNumber (digitToWord, digits, wordNumber)
+
+main :: IO ()
+main = hspec $ do
+ describe "digitToWord" $ do
+ it "returns zero for 0" $ do
+ digitToWord 0 `shouldBe`"zero"
+ it "returns one for 1" $ do
+ digitToWord 1 `shouldBe` "one"
+
+ describe "digits" $ do
+ it "returns [1] for 1" $ do
+ digits 1 `shouldBe` [1]
+ it "returns [1, 0, 0] for 100" $ do
+ digits 100 `shouldBe` [1, 0, 0]
+
+ describe "wordNumber" $ do
+ it "one-zero-zero given 100" $ do
+ wordNumber 100 `shouldBe` "one-zero-zero"
+ it "nine-zero-zero-one for 9001" $ do
+ wordNumber 9001 `shouldBe` "nine-zero-zero-one"
\ No newline at end of file
diff --git a/Haskell-book/14/morse/tests/tests.hs b/Haskell-book/14/morse/tests/tests.hs
new file mode 100644
index 0000000..b27d3b3
--- /dev/null
+++ b/Haskell-book/14/morse/tests/tests.hs
@@ -0,0 +1,86 @@
+module Main where
+
+import qualified Data.Map as M
+import Morse
+import Test.QuickCheck
+import Test.QuickCheck.Gen (oneof)
+
+allowedChars :: [Char]
+allowedChars = M.keys letterToMorse
+
+allowedMorse :: [Morse]
+allowedMorse = M.elems letterToMorse
+
+charGen :: Gen Char
+charGen = elements allowedChars
+
+morseGen :: Gen Morse
+morseGen = elements allowedMorse
+
+prop_thereAndBackAgain :: Property
+prop_thereAndBackAgain =
+ forAll charGen (\c -> ((charToMorse c) >>= morseToChar) == Just c)
+
+main' :: IO ()
+main' = quickCheck prop_thereAndBackAgain
+
+data Trivial = Trivial deriving (Eq, Show)
+
+trivialGen :: Gen Trivial
+trivialGen = return Trivial
+
+instance Arbitrary Trivial where
+ arbitrary = trivialGen
+
+main :: IO ()
+main = do
+ sample trivialGen
+
+data Identity a = Identity a deriving (Eq, Show)
+
+identityGen :: Arbitrary a => Gen (Identity a)
+identityGen = do
+ a <- arbitrary
+ return (Identity a)
+
+instance Arbitrary a => Arbitrary (Identity a) where
+ arbitrary = identityGen
+
+identityGenInt :: Gen (Identity Int)
+identityGenInt = identityGen
+
+data Pair a b = Pair a b deriving (Eq, Show)
+
+pairGen :: (Arbitrary a, Arbitrary b) => Gen (Pair a b)
+pairGen = do
+ a <- arbitrary
+ b <- arbitrary
+ return (Pair a b)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
+ arbitrary = pairGen
+
+pairGenIntString :: Gen (Pair Int String)
+pairGenIntString = pairGen
+
+data Sum a b = First a | Second b deriving (Eq, Show)
+
+sumGenEqual :: Gen (Sum Char Int)
+sumGenEqual = do
+ a <- arbitrary
+ b <- arbitrary
+ oneof [return $ First a,
+ return $ Second b]
+
+sumGenCharInt :: Gen (Sum Char Int)
+sumGenCharInt = sumGenEqual
+
+sumGenFirstPls :: (Arbitrary a, Arbitrary b) => Gen (Sum a b)
+sumGenFirstPls = do
+ a <- arbitrary
+ b <- arbitrary
+ frequency [(10, return $ First a),
+ (1, return $ Second b)]
+
+sumGenCharIntFirst :: Gen (Sum Char Int)
+sumGenCharIntFirst = sumGenFirstPls
\ No newline at end of file
diff --git a/Haskell-book/14/qc/qc.cabal b/Haskell-book/14/qc/qc.cabal
new file mode 100644
index 0000000..f0b5b3a
--- /dev/null
+++ b/Haskell-book/14/qc/qc.cabal
@@ -0,0 +1,32 @@
+name: qc
+version: 0.1.0.0
+author: Eugen Wissner
+maintainer: belka@caraus.de
+category: Math
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+ hs-source-dirs: src
+ build-depends: base >= 4.7 && < 5
+ , QuickCheck
+ exposed-modules: UsingQuickCheck
+ ghc-options: -Wall
+ default-language: Haskell2010
+
+test-suite tests
+ type: exitcode-stdio-1.0
+ main-is: UsingQuickCheckTest.hs
+ hs-source-dirs: tests
+ ghc-options: -Wall
+ build-depends: base >= 4.7 && < 5
+ , QuickCheck
+ , qc
+
+test-suite idempotence
+ type: exitcode-stdio-1.0
+ main-is: Idempotence.hs
+ hs-source-dirs: tests
+ ghc-options: -Wall
+ build-depends: base >= 4.7 && < 5
+ , QuickCheck
\ No newline at end of file
diff --git a/Haskell-book/14/qc/src/UsingQuickCheck.hs b/Haskell-book/14/qc/src/UsingQuickCheck.hs
new file mode 100644
index 0000000..f0fa27f
--- /dev/null
+++ b/Haskell-book/14/qc/src/UsingQuickCheck.hs
@@ -0,0 +1,58 @@
+module UsingQuickCheck where
+
+import Test.QuickCheck
+
+--
+-- 1
+--
+half :: (Eq a, Fractional a) => a -> a
+half x = x / 2
+
+halfIdentity :: (Eq a, Fractional a) => a -> a
+halfIdentity = (*2) . half
+
+--
+-- 2
+--
+-- for any list you apply sort to
+-- this property should hold
+listOrdered :: (Ord a) => [a] -> Bool
+listOrdered xs =
+ snd $ foldr go (Nothing, True) xs
+ where go _ status@(_, False) = status
+ go y (Nothing, t) = (Just y, t)
+ go y (Just x, _) = (Just y, x >= y)
+
+--
+-- 3
+--
+plusAssociative :: (Ord a, Integral a) => a -> a -> a -> Bool
+plusAssociative x y z = x + (y + z) == (x + y) + z
+
+plusCommutative :: (Ord a, Integral a) => a -> a -> Bool
+plusCommutative x y = x + y == y + x
+
+--
+-- 4
+--
+mulAssociative :: (Ord a, Integral a) => a -> a -> a -> Bool
+mulAssociative x y z = x * (y * z) == (x * y) * z
+
+mulCommutative :: (Ord a, Integral a) => a -> a -> Bool
+mulCommutative x y = x * y == y * x
+
+data Fool = Fulse
+ | Frue
+ deriving (Eq, Show)
+
+data Fool' = Fulse' -- 2/3
+ | Frue' -- 1/3
+ deriving (Eq, Show)
+
+instance Arbitrary Fool where
+ arbitrary = oneof [ return Fulse
+ , return Frue ]
+
+instance Arbitrary Fool' where
+ arbitrary = frequency [ (3, return Fulse')
+ , (1, return Frue')]
\ No newline at end of file
diff --git a/Haskell-book/14/qc/stack.yaml b/Haskell-book/14/qc/stack.yaml
new file mode 100644
index 0000000..22e3463
--- /dev/null
+++ b/Haskell-book/14/qc/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-9.17
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/14/qc/tests/Idempotence.hs b/Haskell-book/14/qc/tests/Idempotence.hs
new file mode 100644
index 0000000..4b484d0
--- /dev/null
+++ b/Haskell-book/14/qc/tests/Idempotence.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import Data.Char
+import Data.List
+import Test.QuickCheck
+
+capitalizeWord :: String -> String
+capitalizeWord [] = []
+capitalizeWord (x:xs) = toUpper x : xs
+
+twice :: (a -> a) -> (a -> a)
+twice y = y . y
+
+fourTimes :: (a -> a) -> (a -> a)
+fourTimes = twice . twice
+
+f :: String -> Bool
+f x =
+ (capitalizeWord x == twice capitalizeWord x)
+ && (capitalizeWord x == fourTimes capitalizeWord x)
+
+f' :: Ord a => [a] -> Bool
+f' x =
+ (sort x == twice sort x)
+ && (sort x == fourTimes sort x)
+
+main :: IO ()
+main = do
+ quickCheck f
+ quickCheck (f' :: String -> Bool)
\ No newline at end of file
diff --git a/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
new file mode 100644
index 0000000..da5ddb5
--- /dev/null
+++ b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
@@ -0,0 +1,128 @@
+module Main where
+
+import Data.List (sort)
+import UsingQuickCheck
+import Test.QuickCheck
+
+prop_half :: (Eq a, Fractional a) => a -> Bool
+prop_half x = (halfIdentity x) == x
+
+associativeGen :: (Integer -> Integer -> Integer -> Bool) -> Gen Bool
+associativeGen f = do
+ x <- (arbitrary :: Gen Integer)
+ y <- (arbitrary :: Gen Integer)
+ z <- (arbitrary :: Gen Integer)
+ elements [f x y z]
+
+commutativeGen :: (Integer -> Integer -> Bool) -> Gen Bool
+commutativeGen f = do
+ x <- (arbitrary :: Gen Integer)
+ y <- (arbitrary :: Gen Integer)
+ elements [f x y]
+
+assocNotNegGen :: (Int -> Int -> Int -> Bool) -> Gen Bool
+assocNotNegGen f = do
+ x <- choose (1 :: Int, 100)
+ y <- choose (1 :: Int, 100)
+ z <- choose (1 :: Int, 100)
+ elements [f x y z]
+
+commutNotNegGen :: (Int -> Int -> Bool) -> Gen Bool
+commutNotNegGen f = do
+ x <- choose (1 :: Int, 100)
+ y <- choose (1 :: Int, 100)
+ elements [f x y]
+
+
+prop_quotRem :: Property
+prop_quotRem =
+ forAll (prop_quotRem') (\(x ,y) -> (quot x y) * y + (rem x y) == x)
+ where prop_quotRem' = do
+ x <- choose (1 :: Int, 10000)
+ y <- choose (1 :: Int, 10000)
+ return (x, y)
+
+prop_divMod :: Property
+prop_divMod =
+ forAll (prop_divMod') (\(x ,y) -> (div x y) * y + (mod x y) == x)
+ where prop_divMod' = do
+ x <- choose (1 :: Int, 10000)
+ y <- choose (1 :: Int, 10000)
+ return (x, y)
+
+prop_reverse :: Property
+prop_reverse =
+ forAll prop_reverse' (\xs -> (reverse . reverse) xs == id xs)
+ where prop_reverse' = do
+ x <- (arbitrary :: Gen [Integer])
+ return x
+
+prop_dollar :: Property
+prop_dollar =
+ forAll prop_dollar' (\x -> x)
+ where prop_dollar' = do
+ x <- (arbitrary :: Gen Integer)
+ return ((id $ x) == (id x))
+
+prop_point :: Property
+prop_point =
+ forAll prop_point' (\x -> x)
+ where prop_point' = do
+ x <- (arbitrary :: Gen Integer)
+ let pointFunc = negate . id
+ let appliedFunc = \y -> negate (id y)
+ return (pointFunc x == appliedFunc x)
+
+prop_foldr1 :: Property
+prop_foldr1 =
+ forAll prop_foldr1' (\x -> x)
+ where prop_foldr1' = do
+ x <- (arbitrary :: Gen [Integer])
+ y <- (arbitrary :: Gen [Integer])
+ return ((foldr (:) x y) == (x ++ y))
+
+prop_foldr2 :: Property
+prop_foldr2 =
+ forAll prop_foldr2' (\x -> x)
+ where prop_foldr2' = do
+ x <- (arbitrary :: Gen [[Integer]])
+ return ((foldr (++) [] x) == (concat x))
+
+prop_length :: Property
+prop_length =
+ forAll prop_length' (\x -> x)
+ where prop_length' = do
+ n <- (arbitrary :: Gen Int)
+ xs <- (arbitrary :: Gen [Integer])
+ return ((length (take n xs)) == n)
+
+prop_readShow :: Property
+prop_readShow =
+ forAll prop_readShow' (\x -> x)
+ where prop_readShow' = do
+ x <- (arbitrary :: Gen Integer)
+ return ((read (show x)) == x)
+
+main :: IO ()
+main = do
+ quickCheck (prop_half :: Double -> Bool)
+ quickCheck $ (listOrdered :: [Int] -> Bool) . sort
+
+ quickCheck $ associativeGen plusAssociative
+ quickCheck $ commutativeGen plusCommutative
+ quickCheck $ associativeGen mulAssociative
+ quickCheck $ commutativeGen mulCommutative
+
+ quickCheck prop_quotRem
+ quickCheck prop_divMod
+
+ quickCheck $ assocNotNegGen (\x y z -> x ^ (y ^ z) == (x ^ y) ^ z)
+ quickCheck $ commutNotNegGen (\x y -> x ^ y == y ^ x)
+
+ quickCheck prop_reverse
+ quickCheck prop_dollar
+ quickCheck prop_point
+ quickCheck prop_foldr1
+ quickCheck prop_foldr2
+ quickCheck prop_length
+ quickCheck prop_readShow
\ No newline at end of file
diff --git a/Haskell-book/15/Madness.hs b/Haskell-book/15/Madness.hs
new file mode 100644
index 0000000..9d6aa34
--- /dev/null
+++ b/Haskell-book/15/Madness.hs
@@ -0,0 +1,36 @@
+module Madness where
+
+import Data.Monoid
+
+type Verb = String
+type Adjective = String
+type Adverb = String
+type Noun = String
+type Exclamation = String
+
+madlibbin' :: Exclamation
+ -> Adverb
+ -> Noun
+ -> Adjective
+ -> String
+madlibbin' e adv noun adj =
+ e <> "! he said " <>
+ adv <> " as he jumped into his car " <>
+ noun <> " and drove off with his " <>
+ adj <> " wife."
+
+madlibbinBetter' :: Exclamation
+ -> Adverb
+ -> Noun
+ -> Adjective
+ -> String
+madlibbinBetter' e adv noun adj =
+ mconcat [ e
+ , "! he said "
+ , adv
+ , " as he jumped into his car "
+ , noun
+ , " and drove off with his "
+ , adj
+ , " wife."
+ ]
diff --git a/Haskell-book/15/optional.cabal b/Haskell-book/15/optional.cabal
new file mode 100644
index 0000000..1251d94
--- /dev/null
+++ b/Haskell-book/15/optional.cabal
@@ -0,0 +1,45 @@
+name: optional
+version: 0.1.0.0
+author: Eugen Wissner
+maintainer: belka@caraus.de
+copyright: 2018 Eugen Wissner
+license: BSD3
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+ hs-source-dirs:
+ src
+ build-depends:
+ base >=4.7 && <5
+ exposed-modules:
+ Optional
+ other-modules:
+ Paths_optional
+ default-language: Haskell2010
+
+test-suite optional-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs:
+ test
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ base >=4.7 && <5
+ , hspec
+ , optional
+ other-modules:
+ Paths_optional
+ default-language: Haskell2010
+
+test-suite first-test
+ type: exitcode-stdio-1.0
+ main-is: First.hs
+ hs-source-dirs:
+ app
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ base >=4.7 && <5
+ , QuickCheck
+ , optional
+ default-language: Haskell2010
diff --git a/Haskell-book/15/optional/.gitignore b/Haskell-book/15/optional/.gitignore
new file mode 100644
index 0000000..e0007e6
--- /dev/null
+++ b/Haskell-book/15/optional/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+optional.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/15/optional/Setup.hs b/Haskell-book/15/optional/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/15/optional/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/15/optional/app/First.hs b/Haskell-book/15/optional/app/First.hs
new file mode 100644
index 0000000..929cd6b
--- /dev/null
+++ b/Haskell-book/15/optional/app/First.hs
@@ -0,0 +1,48 @@
+module Main where
+
+import Data.Monoid
+import Optional
+import Test.QuickCheck
+
+newtype First' a =
+ First' { getFirst' :: Optional a }
+ deriving (Eq, Show)
+
+instance Monoid (First' a) where
+ mempty = First' Nada
+ mappend (First' Nada) x = x
+ mappend x _ = x
+
+instance Arbitrary a => Arbitrary (First' a) where
+ arbitrary = frequency [ (1, return $ First' Nada)
+ , (1, fmap (First' . Only) arbitrary) ]
+
+firstMappend :: First' a
+ -> First' a
+ -> First' a
+firstMappend = mappend
+
+type FirstMappend =
+ First' String
+ -> First' String
+ -> First' String
+ -> Bool
+
+type FstId =
+ First' String -> Bool
+
+monoidAssoc :: (Eq m, Monoid m) => m -> m -> m -> Bool
+monoidAssoc a b c =
+ (a <> (b <> c)) == ((a <> b) <> c)
+
+monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
+monoidLeftIdentity a = (mempty <> a) == a
+
+monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
+monoidRightIdentity a = (a <> mempty) == a
+
+main :: IO ()
+main = do
+ quickCheck (monoidAssoc :: FirstMappend)
+ quickCheck (monoidLeftIdentity :: FstId)
+ quickCheck (monoidRightIdentity :: FstId)
diff --git a/Haskell-book/15/optional/package.yaml b/Haskell-book/15/optional/package.yaml
new file mode 100644
index 0000000..87ac223
--- /dev/null
+++ b/Haskell-book/15/optional/package.yaml
@@ -0,0 +1,35 @@
+name: optional
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+ source-dirs: src
+
+tests:
+ optional-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - optional
+ - hspec
+
+ first-test:
+ main: First.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - optional
+ - QuickCheck
diff --git a/Haskell-book/15/optional/src/Optional.hs b/Haskell-book/15/optional/src/Optional.hs
new file mode 100644
index 0000000..d85d8a5
--- /dev/null
+++ b/Haskell-book/15/optional/src/Optional.hs
@@ -0,0 +1,12 @@
+module Optional where
+
+data Optional a =
+ Nada
+ | Only a
+ deriving (Eq, Show)
+
+instance Monoid a => Monoid (Optional a) where
+ mempty = Nada
+ mappend x Nada = x
+ mappend Nada x = x
+ mappend (Only x) (Only y) = Only (mappend x y)
diff --git a/Haskell-book/15/optional/stack.yaml b/Haskell-book/15/optional/stack.yaml
new file mode 100644
index 0000000..1de6a19
--- /dev/null
+++ b/Haskell-book/15/optional/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.2
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/15/optional/test/Spec.hs b/Haskell-book/15/optional/test/Spec.hs
new file mode 100644
index 0000000..189d143
--- /dev/null
+++ b/Haskell-book/15/optional/test/Spec.hs
@@ -0,0 +1,21 @@
+import Data.Monoid
+import Optional
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+ describe "Sum" $ do
+ it "1 + 1 is 2" $ do
+ Only (Sum 1) `mappend` Only (Sum 1) `shouldBe` Only (Sum {getSum = 2})
+ describe "Product" $ do
+ it "4 * 2 is 8" $ do
+ Only (Product 4) `mappend` Only (Product 2) `shouldBe` Only (Product {getProduct = 8})
+ describe "Sum with Nada" $ do
+ it "1 + Nada is 1" $ do
+ Only (Sum 1) `mappend` Nada `shouldBe` Only (Sum {getSum = 1})
+ describe "List" $ do
+ it "[1] <> Nada is [1]" $ do
+ Only [1] `mappend` Nada `shouldBe` Only [1]
+ describe "Nada with sum" $ do
+ it "Nada + 1 is 1" $ do
+ Nada `mappend` Only (Sum 1) `shouldBe` Only (Sum {getSum = 1})
diff --git a/Haskell-book/15/orphan-instance/Listy.hs b/Haskell-book/15/orphan-instance/Listy.hs
new file mode 100644
index 0000000..c99720a
--- /dev/null
+++ b/Haskell-book/15/orphan-instance/Listy.hs
@@ -0,0 +1,10 @@
+module Listy where
+
+newtype Listy a =
+ Listy [a]
+ deriving (Eq, Show)
+
+instance Monoid (Listy a) where
+ mempty = Listy []
+ mappend (Listy l) (Listy l') =
+ Listy $ mappend l l'
diff --git a/Haskell-book/15/orphan-instance/ListyInstances.hs b/Haskell-book/15/orphan-instance/ListyInstances.hs
new file mode 100644
index 0000000..39f7210
--- /dev/null
+++ b/Haskell-book/15/orphan-instance/ListyInstances.hs
@@ -0,0 +1,9 @@
+module ListyInstances where
+
+import Data.Monoid
+import Listy
+
+instance Monoid (Listy a) where
+ mempty = Listy []
+ mappend (Listy l) (Listy l') =
+ Listy $ mappend l l'
diff --git a/Haskell-book/15/semigroup/.gitignore b/Haskell-book/15/semigroup/.gitignore
new file mode 100644
index 0000000..b9db70a
--- /dev/null
+++ b/Haskell-book/15/semigroup/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+semigroup.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/15/semigroup/Setup.hs b/Haskell-book/15/semigroup/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/15/semigroup/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/15/semigroup/app/Main.hs b/Haskell-book/15/semigroup/app/Main.hs
new file mode 100644
index 0000000..237aefe
--- /dev/null
+++ b/Haskell-book/15/semigroup/app/Main.hs
@@ -0,0 +1,18 @@
+module Main where
+
+import Data.Monoid
+import Mem
+
+f' :: Num a => Mem a String
+f' = Mem $ \s -> ("hi", s + 1)
+
+main :: IO ()
+main = do
+ let rmzero = runMem mempty 0
+ rmleft = runMem (f' <> mempty) 0
+ rmright = runMem (mempty <> f') 0
+ print $ (rmleft :: (String, Int))
+ print $ (rmright :: (String, Int))
+ print $ (rmzero :: (String, Int))
+ print $ rmleft == runMem f' 0
+ print $ rmright == runMem f' 0
diff --git a/Haskell-book/15/semigroup/package.yaml b/Haskell-book/15/semigroup/package.yaml
new file mode 100644
index 0000000..8e3b72c
--- /dev/null
+++ b/Haskell-book/15/semigroup/package.yaml
@@ -0,0 +1,36 @@
+name: semigroup
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+ source-dirs: src
+ dependencies:
+ - QuickCheck
+
+executables:
+ semigroup-exe:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - semigroup
+
+tests:
+ semigroup-test:
+ main: Main.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - QuickCheck
+ - semigroup
diff --git a/Haskell-book/15/semigroup/src/Bool.hs b/Haskell-book/15/semigroup/src/Bool.hs
new file mode 100644
index 0000000..2efdd34
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Bool.hs
@@ -0,0 +1,30 @@
+module Bool where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+newtype BoolConj = BoolConj Bool deriving (Eq, Show)
+
+instance Semigroup BoolConj where
+ (BoolConj True) <> (BoolConj True) = BoolConj True
+ _ <> _ = BoolConj False
+
+instance Monoid BoolConj where
+ mempty = BoolConj True
+ mappend = (<>)
+
+instance Arbitrary BoolConj where
+ arbitrary = fmap BoolConj arbitrary
+
+newtype BoolDisj = BoolDisj Bool deriving (Eq, Show)
+
+instance Semigroup BoolDisj where
+ (BoolDisj False) <> (BoolDisj False) = BoolDisj False
+ _ <> _ = BoolDisj True
+
+instance Monoid BoolDisj where
+ mempty = BoolDisj False
+ mappend = (<>)
+
+instance Arbitrary BoolDisj where
+ arbitrary = fmap BoolDisj arbitrary
diff --git a/Haskell-book/15/semigroup/src/Combine.hs b/Haskell-book/15/semigroup/src/Combine.hs
new file mode 100644
index 0000000..fe420dd
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Combine.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE FlexibleInstances #-}
+module Combine where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+newtype Combine a b =
+ Combine { unCombine :: (a -> b) }
+
+instance Semigroup b => Semigroup (Combine a b) where
+ (Combine f1) <> (Combine f2) = Combine f
+ where f x = (f1 x) <> (f2 x)
+
+instance (Monoid b) => Monoid (Combine a b) where
+ mempty = Combine $ \_ -> mempty
+ mappend (Combine f1) (Combine f2) = Combine f
+ where f x = mappend (f1 x) (f2 x)
+
+instance (Num a, CoArbitrary a, Arbitrary b) => Arbitrary (Combine a b) where
+ arbitrary = do
+ f <- arbitrary
+ return $ Combine (\n -> f n)
+
+instance (Show a, Show b) => Show (Combine a b) where
+ show _ = "a -> b"
diff --git a/Haskell-book/15/semigroup/src/Comp.hs b/Haskell-book/15/semigroup/src/Comp.hs
new file mode 100644
index 0000000..f7224da
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Comp.hs
@@ -0,0 +1,22 @@
+module Comp where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+newtype Comp a =
+ Comp { unComp :: (a -> a) }
+
+instance Semigroup a => Semigroup (Comp a) where
+ (Comp f1) <> (Comp f2) = Comp f
+ where f x = (f1 x) <> (f2 x)
+
+instance Monoid a => Monoid (Comp a) where
+ mempty = Comp $ \_ -> mempty
+ mappend (Comp f1) (Comp f2) = Comp f
+ where f x = mappend (f1 x) (f2 x)
+
+instance (Arbitrary a, CoArbitrary a) => Arbitrary (Comp a) where
+ arbitrary = fmap Comp arbitrary
+
+instance Show (Comp a) where
+ show _ = "a -> a"
diff --git a/Haskell-book/15/semigroup/src/Identity.hs b/Haskell-book/15/semigroup/src/Identity.hs
new file mode 100644
index 0000000..cb7180a
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Identity.hs
@@ -0,0 +1,16 @@
+module Identity where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+newtype Identity a = Identity a deriving (Show, Eq)
+
+instance Semigroup a => Semigroup (Identity a) where
+ (Identity x) <> (Identity y) = Identity (x <> y)
+
+instance Monoid a => Monoid (Identity a) where
+ mempty = Identity mempty
+ mappend (Identity x) (Identity y) = Identity $ mappend x y
+
+instance Arbitrary a => Arbitrary (Identity a) where
+ arbitrary = fmap Identity arbitrary
diff --git a/Haskell-book/15/semigroup/src/Mem.hs b/Haskell-book/15/semigroup/src/Mem.hs
new file mode 100644
index 0000000..575e82d
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Mem.hs
@@ -0,0 +1,11 @@
+module Mem where
+
+newtype Mem s a =
+ Mem {
+ runMem :: s -> (a,s)
+ }
+
+instance Monoid a => Monoid (Mem s a) where
+ mempty = Mem $ \x -> (mempty, x)
+ mappend (Mem f1) (Mem f2) = Mem f
+ where f x = ((mappend (fst $ f1 x) (fst $ f2 x)), snd $ f2 $ snd $ f1 x)
diff --git a/Haskell-book/15/semigroup/src/Or.hs b/Haskell-book/15/semigroup/src/Or.hs
new file mode 100644
index 0000000..17d4801
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Or.hs
@@ -0,0 +1,19 @@
+module Or where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+data Or a b =
+ Fst a
+ | Snd b
+ deriving (Eq, Show)
+
+instance Semigroup (Or a b) where
+ (Snd x) <> _ = Snd x
+ _ <> x = x
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Or a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ frequency [ (1, return $ Fst x), (1, return $ Snd y) ]
diff --git a/Haskell-book/15/semigroup/src/Trivial.hs b/Haskell-book/15/semigroup/src/Trivial.hs
new file mode 100644
index 0000000..de9a1ad
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Trivial.hs
@@ -0,0 +1,16 @@
+module Trivial where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+data Trivial = Trivial deriving (Eq, Show)
+
+instance Semigroup Trivial where
+ _ <> _ = Trivial
+
+instance Arbitrary Trivial where
+ arbitrary = return Trivial
+
+instance Monoid Trivial where
+ mempty = undefined
+ mappend = (<>)
diff --git a/Haskell-book/15/semigroup/src/Two.hs b/Haskell-book/15/semigroup/src/Two.hs
new file mode 100644
index 0000000..70c2760
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Two.hs
@@ -0,0 +1,53 @@
+module Two where
+
+import Data.Semigroup
+import Test.QuickCheck
+
+data Two a b = Two a b deriving (Eq, Show)
+
+data Three a b c = Three a b c deriving (Eq, Show)
+
+data Four a b c d = Four a b c d deriving (Eq, Show)
+
+instance (Semigroup a, Semigroup b) => Semigroup (Two a b) where
+ (Two x1 y1) <> (Two x2 y2) = Two (x1 <> x2) (y1 <> y2)
+
+instance (Monoid a, Monoid b) => Monoid (Two a b) where
+ mempty = Two mempty mempty
+ mappend (Two x1 y1) (Two x2 y2) = Two (mappend x1 x2) (mappend y1 y2)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Two x y
+
+instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (Three a b c) where
+ (Three x1 y1 z1) <> (Three x2 y2 z2) = Three (x1 <> x2) (y1 <> y2) (z1 <> z2)
+
+instance (Monoid a, Monoid b, Monoid c) => Monoid (Three a b c) where
+ mempty = Three mempty mempty mempty
+ mappend (Three x1 y1 z1) (Three x2 y2 z2) = Three (mappend x1 x2) (mappend y1 y2) (mappend z1 z2)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three x y z
+
+instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (Four a b c d) where
+ (Four x1 y1 z1 t1) <> (Four x2 y2 z2 t2) = Four (x1 <> x2) (y1 <> y2) (z1 <> z2) (t1 <> t2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (Four a b c d) where
+ mempty = Four mempty mempty mempty mempty
+ mappend (Four x1 y1 z1 t1) (Four x2 y2 z2 t2) =
+ Four (mappend x1 x2) (mappend y1 y2) (mappend z1 z2) (mappend t1 t2)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Four a b c d) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Four x y z t
diff --git a/Haskell-book/15/semigroup/src/Validation.hs b/Haskell-book/15/semigroup/src/Validation.hs
new file mode 100644
index 0000000..a5d1c9c
--- /dev/null
+++ b/Haskell-book/15/semigroup/src/Validation.hs
@@ -0,0 +1,17 @@
+module Validation where
+
+import Data.Semigroup
+import Test.QuickCheck (arbitrary, Arbitrary(..), frequency)
+
+data Validation a b = Failure a | Success b deriving (Eq, Show)
+
+instance Semigroup a => Semigroup (Validation a b) where
+ (Success x) <> _ = Success x
+ _ <> (Success x) = Success x
+ (Failure x) <> (Failure y) = Failure $ x <> y
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Validation a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ frequency [ (1, return $ Success x), (1, return $ Failure y) ]
diff --git a/Haskell-book/15/semigroup/stack.yaml b/Haskell-book/15/semigroup/stack.yaml
new file mode 100644
index 0000000..1de6a19
--- /dev/null
+++ b/Haskell-book/15/semigroup/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.2
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/15/semigroup/test/Main.hs b/Haskell-book/15/semigroup/test/Main.hs
new file mode 100644
index 0000000..146ffdc
--- /dev/null
+++ b/Haskell-book/15/semigroup/test/Main.hs
@@ -0,0 +1,72 @@
+import Trivial
+import Identity
+import Two
+import Test.QuickCheck
+import Bool
+import Or
+import Combine
+import Data.Semigroup
+import Comp
+import Validation
+
+semigroupAssoc :: (Eq m, Semigroup m) => m -> m -> m -> Bool
+semigroupAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c)
+
+type TrivAssoc =
+ Trivial -> Trivial -> Trivial -> Bool
+
+type TwoType = Two Trivial Trivial
+type ThreeType = Three Trivial Trivial Trivial
+type FourType = Four Trivial Trivial Trivial Trivial
+
+type CombineType = Combine Int (Sum Int)
+semigroupCombineAssoc :: CombineType -> CombineType -> CombineType -> Bool
+semigroupCombineAssoc a b c =
+ ((unCombine (a <> (b <> c))) 8) == ((unCombine ((a <> b) <> c)) 8)
+
+semigroupCompAssoc :: Comp (Sum Int) -> Comp (Sum Int) -> Comp (Sum Int) -> Bool
+semigroupCompAssoc a b c =
+ ((unComp (a <> (b <> c))) (Sum 8)) == ((unComp ((a <> b) <> c)) (Sum 8))
+
+monoidLeftIdentity :: (Eq m, Monoid m)
+ => m
+ -> Bool
+monoidLeftIdentity a = (mappend mempty a) == a
+
+monoidRightIdentity :: (Eq m, Monoid m)
+ => m
+ -> Bool
+monoidRightIdentity a = (mappend a mempty) == a
+
+
+
+main :: IO ()
+main = do
+ quickCheck (semigroupAssoc :: TrivAssoc)
+ quickCheck (monoidLeftIdentity :: Trivial -> Bool)
+ quickCheck (monoidRightIdentity :: Trivial -> Bool)
+
+ quickCheck (semigroupAssoc :: Identity Trivial -> Identity Trivial -> Identity Trivial -> Bool)
+ quickCheck (monoidLeftIdentity :: Identity (Sum Int)-> Bool)
+ quickCheck (monoidRightIdentity :: Identity (Sum Int) -> Bool)
+
+ quickCheck (semigroupAssoc :: TwoType -> TwoType -> TwoType -> Bool)
+ quickCheck (monoidLeftIdentity :: TwoType -> Bool)
+ quickCheck (monoidRightIdentity :: TwoType -> Bool)
+ quickCheck (semigroupAssoc :: ThreeType -> ThreeType -> ThreeType -> Bool)
+ quickCheck (monoidLeftIdentity :: ThreeType -> Bool)
+ quickCheck (monoidRightIdentity :: ThreeType -> Bool)
+ quickCheck (semigroupAssoc :: FourType -> FourType -> FourType -> Bool)
+ quickCheck (monoidLeftIdentity :: FourType -> Bool)
+ quickCheck (monoidRightIdentity :: FourType -> Bool)
+
+ quickCheck (semigroupAssoc :: BoolConj -> BoolConj -> BoolConj -> Bool)
+ quickCheck (monoidLeftIdentity :: BoolConj -> Bool)
+ quickCheck (monoidRightIdentity :: BoolConj -> Bool)
+ quickCheck (semigroupAssoc :: BoolDisj -> BoolDisj -> BoolDisj -> Bool)
+ quickCheck (monoidLeftIdentity :: BoolDisj -> Bool)
+ quickCheck (monoidRightIdentity :: BoolDisj -> Bool)
+ quickCheck (semigroupAssoc :: Or Trivial Trivial -> Or Trivial Trivial -> Or Trivial Trivial -> Bool)
+ quickCheck semigroupCombineAssoc
+ quickCheck semigroupCompAssoc
+ quickCheck (semigroupAssoc :: Validation String Int -> Validation String Int -> Validation String Int -> Bool)
diff --git a/Haskell-book/16/Exercises.hs b/Haskell-book/16/Exercises.hs
new file mode 100644
index 0000000..f07b7ea
--- /dev/null
+++ b/Haskell-book/16/Exercises.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+module Exercises where
+
+-- Rearrange.
+--
+-- 1
+--
+data Sum a b =
+ First b
+ | Second a
+
+instance Functor (Sum e) where
+ fmap f (First a) = First (f a)
+ fmap f (Second b) = Second b
+
+--
+-- 2
+--
+data Company a c b =
+ DeepBlue a c
+ | Something b
+
+instance Functor (Company e e') where
+ fmap f (Something b) = Something (f b)
+ fmap _ (DeepBlue a c) = DeepBlue a c
+
+--
+-- 3
+--
+data More b a =
+ L a b a
+ | R b a b
+ deriving (Eq, Show)
+
+instance Functor (More x) where
+ fmap f (L a b a') = L (f a) b (f a')
+ fmap f (R b a b') = R b (f a) b'
+
+-- Write Functor instances.
+--
+-- 1
+--
+data Quant a b =
+ Finance
+ | Desk a
+ | Bloor b
+
+instance Functor (Quant a) where
+ fmap f (Bloor b) = Bloor (f b)
+ fmap _ Finance = Finance
+ fmap _ (Desk x) = Desk x
+
+--
+-- 2
+--
+newtype K a b =
+ K a
+
+instance Functor (K a) where
+ fmap _ (K x) = K x
+
+--
+-- 3
+--
+newtype Flip f a b =
+ Flip (f b a)
+ deriving (Eq, Show)
+
+instance Functor (Flip K a) where
+ fmap f (Flip (K a))= Flip $ K $ f a
+
+--
+-- 4
+--
+data EvilGoateeConst a b =
+ GoatyConst b
+
+instance Functor (EvilGoateeConst a) where
+ fmap f (GoatyConst x) = GoatyConst $ f x
+
+--
+-- 5
+--
+data LiftItOut f a = LiftItOut (f a)
+
+instance Functor f => Functor (LiftItOut f) where
+ fmap f (LiftItOut g) = LiftItOut $ fmap f $ g
+
+--
+-- 6
+--
+data Parappa f g a =
+ DaWrappa (f a) (g a)
+
+instance (Functor f, Functor g) => Functor (Parappa f g) where
+ fmap f (DaWrappa f1 f2) = DaWrappa (fmap f f1) (fmap f f2)
+
+--
+-- 7
+--
+data IgnoreOne f g a b =
+ IgnoringSomething (f a) (g b)
+
+instance Functor g => Functor (IgnoreOne f g a) where
+ fmap f (IgnoringSomething f1 f2) = IgnoringSomething f1 $ fmap f f2
+
+--
+-- 8
+--
+data Notorious g o a t =
+ Notorious (g o) (g a) (g t)
+
+instance Functor g => Functor (Notorious g o a) where
+ fmap f (Notorious f1 f2 f3) = Notorious f1 f2 $ fmap f f3
+
+--
+-- 9
+--
+data List a = Nil | Cons a (List a)
+
+instance Functor List where
+ fmap f (Cons x y) = Cons (f x) (fmap f y)
+ fmap _ Nil = Nil
+
+--
+-- 10
+--
+data GoatLord a =
+ NoGoat
+ | OneGoat a
+ | MoreGoats (GoatLord a)
+ (GoatLord a)
+ (GoatLord a)
+
+instance Functor GoatLord where
+ fmap _ NoGoat = NoGoat
+ fmap f (OneGoat x) = OneGoat $ f x
+ fmap f (MoreGoats x y z) = MoreGoats (g x) (g y) (g z)
+ where g t = fmap f t
+
+--
+-- 11
+--
+data TalkToMe a =
+ Halt
+ | Print String a
+ | Read (String -> a)
+
+instance Functor TalkToMe where
+ fmap _ Halt = Halt
+ fmap f (Print x y) = Print x $ f y
+ fmap f (Read g) = Read (f . g)
diff --git a/Haskell-book/16/HeavyLifting.hs b/Haskell-book/16/HeavyLifting.hs
new file mode 100644
index 0000000..e92f875
--- /dev/null
+++ b/Haskell-book/16/HeavyLifting.hs
@@ -0,0 +1,16 @@
+module HeavyLifting where
+
+a = fmap (+1) $ read "[1]" :: [Int]
+
+b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"])
+
+c = fmap (*2) (\x -> x - 2)
+
+d =
+ fmap ((return '1' ++) . show)
+ (\x -> [x, 1..3])
+
+e :: IO Integer
+e = let ioi = readIO "1" :: IO Integer
+ changed = fmap read $ fmap ("123" ++) $ fmap show ioi
+ in fmap (*3) changed
diff --git a/Haskell-book/16/Possibly.hs b/Haskell-book/16/Possibly.hs
new file mode 100644
index 0000000..bf92540
--- /dev/null
+++ b/Haskell-book/16/Possibly.hs
@@ -0,0 +1,10 @@
+module Possibly where
+
+data Possibly a =
+ LolNope
+ | Yeppers a
+ deriving (Eq, Show)
+
+instance Functor Possibly where
+ fmap f LolNope = LolNope
+ fmap f (Yeppers x) = Yeppers $ f x
diff --git a/Haskell-book/16/Short.hs b/Haskell-book/16/Short.hs
new file mode 100644
index 0000000..f6ecd66
--- /dev/null
+++ b/Haskell-book/16/Short.hs
@@ -0,0 +1,10 @@
+module Short where
+
+data Sum a b =
+ First a
+ | Second b
+ deriving (Eq, Show)
+
+instance Functor (Sum a) where
+ fmap f (Second x) = Second $ f x
+ fmap f (First x) = First x
diff --git a/Haskell-book/16/func/.gitignore b/Haskell-book/16/func/.gitignore
new file mode 100644
index 0000000..d1d1f0a
--- /dev/null
+++ b/Haskell-book/16/func/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+func.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/16/func/Setup.hs b/Haskell-book/16/func/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/16/func/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/16/func/app/Main.hs b/Haskell-book/16/func/app/Main.hs
new file mode 100644
index 0000000..de1c1ab
--- /dev/null
+++ b/Haskell-book/16/func/app/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc
diff --git a/Haskell-book/16/func/package.yaml b/Haskell-book/16/func/package.yaml
new file mode 100644
index 0000000..9595fb3
--- /dev/null
+++ b/Haskell-book/16/func/package.yaml
@@ -0,0 +1,34 @@
+name: func
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- QuickCheck
+
+library:
+ source-dirs: src
+
+# executables:
+# func-exe:
+# main: Main.hs
+# source-dirs: app
+# ghc-options:
+# - -threaded
+# - -rtsopts
+# - -with-rtsopts=-N
+# dependencies:
+# - func
+
+tests:
+ func-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - func
diff --git a/Haskell-book/16/func/src/Func.hs b/Haskell-book/16/func/src/Func.hs
new file mode 100644
index 0000000..920ab80
--- /dev/null
+++ b/Haskell-book/16/func/src/Func.hs
@@ -0,0 +1,89 @@
+module Func where
+
+import Test.QuickCheck
+
+-- class Functor f where
+-- fmap :: (a -> b) -> f a -> f b
+
+newtype Identity a = Identity a deriving (Eq, Show)
+
+instance Functor Identity where
+ fmap f (Identity a) = Identity $ f a
+
+instance Arbitrary a => Arbitrary (Identity a) where
+ arbitrary = fmap Identity arbitrary
+
+data Pair a = Pair a a deriving (Eq, Show)
+
+instance Functor Pair where
+ fmap f (Pair x y) = Pair (f x) (f y)
+
+instance Arbitrary a => Arbitrary (Pair a) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Pair x y
+
+data Two a b = Two a b deriving (Eq, Show)
+
+instance Functor (Two a) where
+ fmap f (Two x y) = Two x (f y)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Two x y
+
+data Three a b c = Three a b c deriving (Eq, Show)
+
+instance Functor (Three a b) where
+ fmap f (Three x y z) = Three x y (f z)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three x y z
+
+data Three' a b = Three' a b b deriving (Eq, Show)
+
+instance Functor (Three' a) where
+ fmap f (Three' x y z) = Three' x (f y) (f z)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three' x y z
+
+data Four a b c d = Four a b c d deriving (Eq, Show)
+
+instance Functor (Four a b c) where
+ fmap f (Four x y z t) = Four x y z (f t)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
+ => Arbitrary (Four a b c d) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Four x y z t
+
+data Four' a b = Four' a a a b deriving (Eq, Show)
+
+instance Functor (Four' a) where
+ fmap f (Four' x y z t) = Four' x y z (f t)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Four' x y z t
+
+data Trivial = Trivial
diff --git a/Haskell-book/16/func/stack.yaml b/Haskell-book/16/func/stack.yaml
new file mode 100644
index 0000000..005cfcf
--- /dev/null
+++ b/Haskell-book/16/func/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.3
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/16/func/test/Spec.hs b/Haskell-book/16/func/test/Spec.hs
new file mode 100644
index 0000000..14de325
--- /dev/null
+++ b/Haskell-book/16/func/test/Spec.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE ViewPatterns #-}
+
+import Func
+import Test.QuickCheck
+import Test.QuickCheck.Function
+
+functorIdentity :: (Functor f, Eq (f a)) => f a -> Bool
+functorIdentity f = fmap id f == f
+
+functorCompose :: (Eq (f c), Functor f) =>
+ (a -> b)
+ -> (b -> c)
+ -> f a
+ -> Bool
+functorCompose f g x =
+ (fmap g (fmap f x)) == (fmap (g . f) x)
+
+functorCompose' :: (Eq (f c), Functor f) =>
+ f a
+ -> Fun a b
+ -> Fun b c
+ -> Bool
+functorCompose' x (Fun _ f) (Fun _ g) =
+ (fmap (g . f) x) == (fmap g . fmap f $ x)
+
+main :: IO ()
+main = do
+ quickCheck (functorIdentity :: Identity Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Identity Int -> Bool)
+ quickCheck (functorCompose' :: Identity Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Pair Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Pair Int -> Bool)
+ quickCheck (functorCompose' :: Pair Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Two Int Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Two Int Int -> Bool)
+ quickCheck (functorCompose' :: Two Int Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Three Int Int Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Three Int Int Int -> Bool)
+ quickCheck (functorCompose' :: Three Int Int Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Three' Int Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Three' Int Int -> Bool)
+ quickCheck (functorCompose' :: Three' Int Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Four Int Int Int Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Four Int Int Int Int -> Bool)
+ quickCheck (functorCompose' :: Four Int Int Int Int -> Fun Int Int -> Fun Int Int -> Bool)
+
+ quickCheck (functorIdentity :: Four' Int Int -> Bool)
+ quickCheck ((functorCompose (+1) (*2)) :: Four' Int Int -> Bool)
+ quickCheck (functorCompose' :: Four' Int Int -> Fun Int Int -> Fun Int Int -> Bool)
diff --git a/Haskell-book/17/Combinations.hs b/Haskell-book/17/Combinations.hs
new file mode 100644
index 0000000..9e13e1e
--- /dev/null
+++ b/Haskell-book/17/Combinations.hs
@@ -0,0 +1,12 @@
+module Combinations where
+
+import Control.Applicative (liftA3)
+
+stops :: String
+stops = "pbtdkg"
+
+vowels :: String
+vowels = "aeiou"
+
+combos :: [a] -> [b] -> [c] -> [(a, b, c)]
+combos = liftA3 (\x y z -> (x, y, z))
diff --git a/Haskell-book/17/Constant.hs b/Haskell-book/17/Constant.hs
new file mode 100644
index 0000000..f25da54
--- /dev/null
+++ b/Haskell-book/17/Constant.hs
@@ -0,0 +1,13 @@
+module Constant where
+
+newtype Constant a b =
+ Constant { getConstant :: a }
+ deriving (Eq, Ord, Show)
+
+instance Functor (Constant a) where
+ fmap _ (Constant x) = Constant x
+
+instance Monoid a
+ => Applicative (Constant a) where
+ pure x = Constant mempty
+ (Constant x) <*> (Constant y) = Constant $ mappend x y
diff --git a/Haskell-book/17/Exercises/.gitignore b/Haskell-book/17/Exercises/.gitignore
new file mode 100644
index 0000000..3834f98
--- /dev/null
+++ b/Haskell-book/17/Exercises/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Exercises.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/17/Exercises/Setup.hs b/Haskell-book/17/Exercises/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/17/Exercises/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/17/Exercises/app/Main.hs b/Haskell-book/17/Exercises/app/Main.hs
new file mode 100644
index 0000000..43979f0
--- /dev/null
+++ b/Haskell-book/17/Exercises/app/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Exercises
+
+main :: IO ()
+main = return ()
diff --git a/Haskell-book/17/Exercises/package.yaml b/Haskell-book/17/Exercises/package.yaml
new file mode 100644
index 0000000..f7e3630
--- /dev/null
+++ b/Haskell-book/17/Exercises/package.yaml
@@ -0,0 +1,35 @@
+name: Exercises
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- QuickCheck
+- checkers
+
+library:
+ source-dirs: src
+
+executables:
+ Exercises-exe:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - Exercises
+
+tests:
+ Exercises-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - Exercises
diff --git a/Haskell-book/17/Exercises/src/Exercises.hs b/Haskell-book/17/Exercises/src/Exercises.hs
new file mode 100644
index 0000000..1ea70e3
--- /dev/null
+++ b/Haskell-book/17/Exercises/src/Exercises.hs
@@ -0,0 +1,124 @@
+module Exercises where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+--- 1
+data Pair a = Pair a a deriving (Show, Eq)
+
+instance Functor Pair where
+ fmap f (Pair x y) = Pair (f x) (f y)
+
+instance Applicative Pair where
+ pure f = Pair f f
+ (Pair f f') <*> (Pair x y) = Pair (f x) (f' y)
+
+instance Arbitrary a => Arbitrary (Pair a) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Pair x y
+
+instance Eq a => EqProp (Pair a) where
+ (=-=) = eq
+
+--- 2
+data Two a b = Two a b deriving (Show, Eq)
+
+instance Functor (Two a) where
+ fmap f (Two x y) = Two x (f y)
+
+instance Monoid a => Applicative (Two a) where
+ pure x = Two mempty $ x
+ (Two f f') <*> (Two x y) = Two (mappend f x) (f' y)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Two x y
+
+instance (Eq a, Eq b) => EqProp (Two a b) where
+ (=-=) = eq
+
+--- 3
+data Three a b c = Three a b c deriving (Show, Eq)
+
+instance Functor (Three a b) where
+ fmap f (Three x y z) = Three x y (f z)
+
+instance (Monoid a, Monoid b) => Applicative (Three a b) where
+ pure x = Three mempty mempty x
+ (Three f f' f'') <*> (Three x y z) = Three (mappend f x) (mappend f' y) (f'' z)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three x y z
+
+instance (Eq a, Eq b, Eq c) => EqProp (Three a b c) where
+ (=-=) = eq
+
+--- 4
+data Three' a b = Three' a b b deriving (Show, Eq)
+
+instance Functor (Three' a) where
+ fmap f (Three' x y z) = Three' x (f y) (f z)
+
+instance (Monoid a) => Applicative (Three' a) where
+ pure x = Three' mempty x x
+ (Three' f f' f'') <*> (Three' x y z) = Three' (mappend f x) (f' y) (f'' z)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three' x y z
+
+instance (Eq a, Eq b) => EqProp (Three' a b) where
+ (=-=) = eq
+
+--- 5
+data Four a b c d = Four a b c d deriving (Show, Eq)
+
+instance Functor (Four a b c) where
+ fmap f (Four x y z t) = Four x y z (f t)
+
+instance (Monoid a, Monoid b, Monoid c) => Applicative (Four a b c) where
+ pure x = Four mempty mempty mempty x
+ (Four f f' f'' f''') <*> (Four x y z t) = Four (mappend f x) (mappend f' y) (mappend f'' z) (f''' t)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Four a b c d) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Four x y z t
+
+instance (Eq a, Eq b, Eq c, Eq d) => EqProp (Four a b c d) where
+ (=-=) = eq
+
+--- 5
+data Four' a b = Four' a a a b deriving (Show, Eq)
+
+instance Functor (Four' a) where
+ fmap f (Four' x y z t) = Four' x y z (f t)
+
+instance (Monoid a) => Applicative (Four' a) where
+ pure x = Four' mempty mempty mempty x
+ (Four' f f' f'' f''') <*> (Four' x y z t) = Four' (mappend f x) (mappend f' y) (mappend f'' z) (f''' t)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Four' x y z t
+
+instance (Eq a, Eq b) => EqProp (Four' a b) where
+ (=-=) = eq
diff --git a/Haskell-book/17/Exercises/stack.yaml b/Haskell-book/17/Exercises/stack.yaml
new file mode 100644
index 0000000..005cfcf
--- /dev/null
+++ b/Haskell-book/17/Exercises/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.3
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/17/Exercises/test/Spec.hs b/Haskell-book/17/Exercises/test/Spec.hs
new file mode 100644
index 0000000..e1405c5
--- /dev/null
+++ b/Haskell-book/17/Exercises/test/Spec.hs
@@ -0,0 +1,26 @@
+import Data.Monoid
+import Exercises
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+
+main :: IO ()
+main = do
+ quickBatch $ functor $ Pair ('a', 'b', 'c') ('d', 'e', 'f')
+ quickBatch $ applicative $ Pair ('a', 'b', 'c') ('d', 'e', 'f')
+ quickBatch $ functor $ Two ('a', 'b', 'c') (1 :: Integer, 2 :: Integer, 3 :: Integer)
+ quickBatch $ applicative $ Two (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer))
+ quickBatch $ applicative $ Three (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer))
+ (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer))
+ quickBatch $ applicative $ Three' (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer))
+ (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer))
+ quickBatch $ applicative $ Four (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer))
+ (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer))
+ quickBatch $ applicative $ Four (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer))
+ (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer))
diff --git a/Haskell-book/17/FixerUpper.hs b/Haskell-book/17/FixerUpper.hs
new file mode 100644
index 0000000..b09877f
--- /dev/null
+++ b/Haskell-book/17/FixerUpper.hs
@@ -0,0 +1,6 @@
+module FixerUpper where
+
+a = const <$> Just <$> "Hello" <*> "World"
+
+b = (,,,) <$> Just 90
+ <*> Just 10 <*> Just "Tierness" <*> pure [1, 2, 3]
diff --git a/Haskell-book/17/Identity.hs b/Haskell-book/17/Identity.hs
new file mode 100644
index 0000000..6b5f9a9
--- /dev/null
+++ b/Haskell-book/17/Identity.hs
@@ -0,0 +1,9 @@
+newtype Identity a = Identity a
+ deriving (Eq, Show, Ord)
+
+instance Functor Identity where
+ fmap f (Identity x) = Identity $ f x
+
+instance Applicative Identity where
+ pure x = Identity x
+ (Identity f) <*> (Identity y) = Identity $ f y
diff --git a/Haskell-book/17/ListApplicative/.gitignore b/Haskell-book/17/ListApplicative/.gitignore
new file mode 100644
index 0000000..296aa3a
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+ListApplicative.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/17/ListApplicative/Setup.hs b/Haskell-book/17/ListApplicative/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/17/ListApplicative/app/Main.hs b/Haskell-book/17/ListApplicative/app/Main.hs
new file mode 100644
index 0000000..66f0611
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/app/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import List
+
+main :: IO ()
+main = return ()
diff --git a/Haskell-book/17/ListApplicative/package.yaml b/Haskell-book/17/ListApplicative/package.yaml
new file mode 100644
index 0000000..5cfefdf
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/package.yaml
@@ -0,0 +1,35 @@
+name: ListApplicative
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- QuickCheck
+- checkers
+
+library:
+ source-dirs: src
+
+executables:
+ ListApplicative-exe:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ListApplicative
+
+tests:
+ ListApplicative-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ListApplicative
diff --git a/Haskell-book/17/ListApplicative/src/List.hs b/Haskell-book/17/ListApplicative/src/List.hs
new file mode 100644
index 0000000..92cf8b9
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/src/List.hs
@@ -0,0 +1,46 @@
+module List where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data List a =
+ Nil
+ | Cons a (List a)
+ deriving (Eq, Show)
+
+instance Functor List where
+ fmap _ Nil = Nil
+ fmap f (Cons x y) = Cons (f x) (fmap f y)
+
+instance Applicative List where
+ pure f = Cons f Nil
+ Nil <*> _ = Nil
+ _ <*> Nil = Nil
+ f <*> x = flatMap (\f' -> fmap f' x) f
+
+append :: List a -> List a -> List a
+append Nil ys = ys
+append (Cons x xs) ys = Cons x $ xs `append` ys
+
+fold :: (a -> b -> b) -> b -> List a -> b
+fold _ b Nil = b
+fold f b (Cons h t) = f h (fold f b t)
+
+concat' :: List (List a) -> List a
+concat' = fold append Nil
+
+flatMap :: (a -> List b) -> List a -> List b
+flatMap f as = concat' $ fmap f as
+
+append' :: List a -> a -> List a
+append' acc x = Cons x acc
+
+fromList :: [a] -> List a
+fromList xs = foldl (\l a -> Cons a l) Nil xs
+
+instance Arbitrary a => Arbitrary (List a) where
+ arbitrary = frequency [(1, pure Nil),
+ (5, Cons <$> arbitrary <*> arbitrary)]
+
+instance Eq a => EqProp (List a) where
+ (=-=) = eq
diff --git a/Haskell-book/17/ListApplicative/src/Validation.hs b/Haskell-book/17/ListApplicative/src/Validation.hs
new file mode 100644
index 0000000..5ee3e9b
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/src/Validation.hs
@@ -0,0 +1,27 @@
+module Validation where
+
+import Test.QuickCheck (Arbitrary(..), frequency)
+import Test.QuickCheck.Checkers
+
+data Validation e a =
+ Failure e
+ | Success a
+ deriving (Eq, Show)
+
+instance Functor (Validation e) where
+ fmap f (Success x) = Success $ f x
+ fmap f (Failure x) = Failure x
+
+instance Monoid e => Applicative (Validation e) where
+ pure = Success
+ (Failure x) <*> (Success _) = Failure x
+ (Success _) <*> (Failure x) = Failure x
+ (Failure f) <*> (Failure y) = Failure $ mappend f y
+ (Success f) <*> (Success y) = Success $ f y
+
+instance (Arbitrary a, Arbitrary e) => Arbitrary (Validation e a) where
+ arbitrary = frequency [(1, Failure <$> arbitrary),
+ (5, Success <$> arbitrary)]
+
+instance (Eq a, Eq e) => EqProp (Validation e a) where
+ (=-=) = eq
diff --git a/Haskell-book/17/ListApplicative/src/ZipList.hs b/Haskell-book/17/ListApplicative/src/ZipList.hs
new file mode 100644
index 0000000..e36ec33
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/src/ZipList.hs
@@ -0,0 +1,40 @@
+module ZipList where
+
+import Control.Applicative
+import List
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+take' :: Int -> List a -> List a
+take' _ Nil = Nil
+take' 0 _ = Nil
+take' n (Cons x xs) = Cons x $ take' (n - 1) xs
+
+newtype ZipList' a =
+ ZipList' (List a)
+ deriving (Eq, Show)
+
+instance Eq a => EqProp (ZipList' a) where
+ xs =-= ys = xs' `eq` ys'
+ where xs' = let (ZipList' l) = xs
+ in take' 3000 l
+ ys' = let (ZipList' l) = ys
+ in take' 3000 l
+
+instance Functor ZipList' where
+ fmap f (ZipList' xs) = ZipList' $ fmap f xs
+
+instance Monoid a => Monoid (ZipList' a) where
+ mempty = pure mempty
+ mappend = liftA2 mappend
+
+instance Applicative ZipList' where
+ pure f = ZipList' $ repeat
+ where repeat = Cons f repeat
+ (ZipList' fs) <*> (ZipList' xs) = ZipList' $ applicative fs xs
+ where applicative Nil _ = Nil
+ applicative _ Nil = Nil
+ applicative (Cons f fs) (Cons x xs) = Cons (f x) $ applicative fs xs
+
+instance Arbitrary a => Arbitrary (ZipList' a) where
+ arbitrary = ZipList' <$> arbitrary
diff --git a/Haskell-book/17/ListApplicative/stack.yaml b/Haskell-book/17/ListApplicative/stack.yaml
new file mode 100644
index 0000000..005cfcf
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.3
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/17/ListApplicative/test/Spec.hs b/Haskell-book/17/ListApplicative/test/Spec.hs
new file mode 100644
index 0000000..ecd8148
--- /dev/null
+++ b/Haskell-book/17/ListApplicative/test/Spec.hs
@@ -0,0 +1,16 @@
+module Main where
+
+import Control.Applicative
+import Data.Monoid
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+import List
+import ZipList
+import Validation (Validation(..))
+
+main :: IO ()
+main = do
+ quickBatch $ applicative (Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil)
+ quickBatch $ monoid (ZipList' $ Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil)
+ quickBatch $ applicative (ZipList' $ Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil)
+ quickBatch $ applicative ((Success (Sum 1, Sum 2, Sum 3)) :: Validation String (Sum Integer, Sum Integer, Sum Integer))
diff --git a/Haskell-book/18/Bind.hs b/Haskell-book/18/Bind.hs
new file mode 100644
index 0000000..daeaada
--- /dev/null
+++ b/Haskell-book/18/Bind.hs
@@ -0,0 +1,6 @@
+module Bind where
+
+import Control.Monad
+
+bind :: Monad m => (a -> m b) -> m a -> m b
+bind f x = join $ fmap f x
diff --git a/Haskell-book/18/Functions.hs b/Haskell-book/18/Functions.hs
new file mode 100644
index 0000000..841ecbd
--- /dev/null
+++ b/Haskell-book/18/Functions.hs
@@ -0,0 +1,21 @@
+module Functions where
+
+j :: Monad m => m (m a) -> m a
+j = flip (>>=) id
+
+l1 :: Monad m => (a -> b) -> m a -> m b
+l1 = fmap
+
+l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c
+l2 f xs ys = f <$> xs <*> ys
+
+a :: Monad m => m a -> m (a -> b) -> m b
+a xs f = f <*> xs
+
+meh :: Monad m => [a] -> (a -> m b) -> m [b]
+meh xs f = rec $ fmap f xs
+ where rec [] = return []
+ rec (x:xs) = (:) <$> x <*> (rec xs)
+
+flipType :: Monad m => [m a] -> m [a]
+flipType = flip meh id
diff --git a/Haskell-book/18/Instance/.gitignore b/Haskell-book/18/Instance/.gitignore
new file mode 100644
index 0000000..01698eb
--- /dev/null
+++ b/Haskell-book/18/Instance/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Instance.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/18/Instance/Setup.hs b/Haskell-book/18/Instance/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/18/Instance/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/18/Instance/package.yaml b/Haskell-book/18/Instance/package.yaml
new file mode 100644
index 0000000..23b61e5
--- /dev/null
+++ b/Haskell-book/18/Instance/package.yaml
@@ -0,0 +1,26 @@
+name: Instance
+version: 0.1.0.0
+github: "githubuser/Instance"
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- QuickCheck
+- checkers
+
+library:
+ source-dirs: src
+
+tests:
+ Instance-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - Instance
diff --git a/Haskell-book/18/Instance/src/Identity.hs b/Haskell-book/18/Instance/src/Identity.hs
new file mode 100644
index 0000000..13cd1b2
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Identity.hs
@@ -0,0 +1,24 @@
+module Identity where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+newtype Identity a = Identity a
+ deriving (Eq, Ord, Show)
+
+instance Functor Identity where
+ fmap f (Identity x) = Identity $ f x
+
+instance Applicative Identity where
+ pure = Identity
+ (Identity f) <*> x = fmap f x
+
+instance Monad Identity where
+ return = pure
+ (Identity x) >>= f = f x
+
+instance Arbitrary a => Arbitrary (Identity a) where
+ arbitrary = fmap Identity $ arbitrary
+
+instance Eq a => EqProp (Identity a) where
+ (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/List.hs b/Haskell-book/18/Instance/src/List.hs
new file mode 100644
index 0000000..bd3a06b
--- /dev/null
+++ b/Haskell-book/18/Instance/src/List.hs
@@ -0,0 +1,44 @@
+module List where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data List a =
+ Nil
+ | Cons a (List a)
+ deriving (Eq, Show)
+
+instance Functor List where
+ fmap f Nil = Nil
+ fmap f (Cons x xs) = Cons (f x) (fmap f xs)
+
+append :: List a -> List a -> List a
+append Nil ys = ys
+append (Cons x xs) ys = Cons x $ xs `append` ys
+
+fold :: (a -> b -> b) -> b -> List a -> b
+fold _ b Nil = b
+fold f b (Cons h t) = f h (fold f b t)
+
+concat' :: List (List a) -> List a
+concat' = fold append Nil
+
+flatMap :: (a -> List b) -> List a -> List b
+flatMap f as = concat' $ fmap f as
+
+instance Applicative List where
+ pure f = Cons f Nil
+ Nil <*> _ = Nil
+ _ <*> Nil = Nil
+ f <*> x = flatMap (\f' -> fmap f' x) f
+
+instance Monad List where
+ return = pure
+ x >>= f = concat' $ fmap f x
+
+instance Arbitrary a => Arbitrary (List a) where
+ arbitrary = frequency [(1, pure Nil),
+ (5, Cons <$> arbitrary <*> arbitrary)]
+
+instance Eq a => EqProp (List a) where
+ (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/Nope.hs b/Haskell-book/18/Instance/src/Nope.hs
new file mode 100644
index 0000000..9a7fea1
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Nope.hs
@@ -0,0 +1,23 @@
+module Nope where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data Nope a = NopeDotJpg deriving (Show, Eq)
+
+instance Functor Nope where
+ fmap _ _ = NopeDotJpg
+
+instance Applicative Nope where
+ pure _ = NopeDotJpg
+ _ <*> _ = NopeDotJpg
+
+instance Monad Nope where
+ return _ = NopeDotJpg
+ _ >>= _ = NopeDotJpg
+
+instance Arbitrary (Nope a) where
+ arbitrary = return NopeDotJpg
+
+instance EqProp (Nope a) where
+ (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/PhhhbbtttEither.hs b/Haskell-book/18/Instance/src/PhhhbbtttEither.hs
new file mode 100644
index 0000000..0fc6acc
--- /dev/null
+++ b/Haskell-book/18/Instance/src/PhhhbbtttEither.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module PhhhbbtttEither where
+
+import Prelude ( Monad(..)
+ , Functor(..)
+ , Applicative(..)
+ , Eq(..)
+ , ($)
+ , Show(..) )
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data PhhhbbtttEither b a =
+ Left a
+ | Right b
+ deriving (Eq, Show)
+
+instance Functor (PhhhbbtttEither b) where
+ fmap f (Right x) = Right x
+ fmap f (Left x) = Left $ f x
+
+instance Applicative (PhhhbbtttEither b) where
+ pure x = Left x
+ Right f <*> _ = Right f
+ Left f <*> x = fmap f x
+
+instance Monad (PhhhbbtttEither b) where
+ return = pure
+ (Right x) >>= f = Right x
+ (Left x) >>= f = f x
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (PhhhbbtttEither b a) where
+ arbitrary = frequency [ (1, fmap Right arbitrary)
+ , (1, fmap Left arbitrary)
+ ]
+
+instance (Eq a, Eq b) => EqProp (PhhhbbtttEither b a) where
+ (=-=) = eq
diff --git a/Haskell-book/18/Instance/src/Sum.hs b/Haskell-book/18/Instance/src/Sum.hs
new file mode 100644
index 0000000..d51b211
--- /dev/null
+++ b/Haskell-book/18/Instance/src/Sum.hs
@@ -0,0 +1,31 @@
+module Sum where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data Sum a b =
+ First a
+ | Second b
+ deriving (Eq, Show)
+
+instance Functor (Sum a) where
+ fmap f (First x) = First x
+ fmap f (Second x) = Second $ f x
+
+instance Applicative (Sum a) where
+ pure x = Second x
+ First f <*> _ = First f
+ Second f <*> x = fmap f x
+
+instance Monad (Sum a) where
+ return = pure
+ (First x) >>= f = First x
+ (Second x) >>= f = f x
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Sum a b) where
+ arbitrary = frequency [ (1, fmap First arbitrary)
+ , (1, fmap Second arbitrary)
+ ]
+
+instance (Eq a, Eq b) => EqProp (Sum a b) where
+ (=-=) = eq
diff --git a/Haskell-book/18/Instance/stack.yaml b/Haskell-book/18/Instance/stack.yaml
new file mode 100644
index 0000000..97a175f
--- /dev/null
+++ b/Haskell-book/18/Instance/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.4
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/18/Instance/test/Spec.hs b/Haskell-book/18/Instance/test/Spec.hs
new file mode 100644
index 0000000..ea250fc
--- /dev/null
+++ b/Haskell-book/18/Instance/test/Spec.hs
@@ -0,0 +1,29 @@
+import Sum
+import Nope
+import qualified PhhhbbtttEither as Phhhbbttt
+import Identity
+import List
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+
+main :: IO ()
+main = do
+ quickBatch $ functor $ (First (1, 2, 3) :: Sum (Int, Int, Int) (Int, Int, Int))
+ quickBatch $ applicative $ (First (1, 2, 3) :: Sum (Int, Int, Int) (Int, Int, Int))
+ quickBatch $ monad $ (First (1, 2, 3) :: Sum (Int, Int, Int) (Int, Int, Int))
+
+ quickBatch $ functor $ (NopeDotJpg :: Nope (Int, Int, Int))
+ quickBatch $ applicative $ (NopeDotJpg :: Nope (Int, Int, Int))
+ quickBatch $ monad $ (NopeDotJpg :: Nope (Int, Int, Int))
+
+ quickBatch $ functor $ (Phhhbbttt.Left (1, 2, 3) :: Phhhbbttt.PhhhbbtttEither (Int, Int, Int) (Int, Int, Int))
+ quickBatch $ applicative $ (Phhhbbttt.Left (1, 2, 3) :: Phhhbbttt.PhhhbbtttEither (Int, Int, Int) (Int, Int, Int))
+ quickBatch $ monad $ (Phhhbbttt.Left (1, 2, 3) :: Phhhbbttt.PhhhbbtttEither (Int, Int, Int) (Int, Int, Int))
+
+ quickBatch $ functor $ (Identity (1, 2, 3) :: Identity (Int, Int, Int))
+ quickBatch $ applicative $ (Identity (1, 2, 3) :: Identity (Int, Int, Int))
+ quickBatch $ monad $ (Identity (1, 2, 3) :: Identity (Int, Int, Int))
+
+ quickBatch $ functor (Cons (1 :: Integer, 2 :: Integer, 3 :: Integer) Nil)
+ quickBatch $ applicative (Cons (1 :: Integer, 2 :: Integer, 3 :: Integer) Nil)
+ quickBatch $ monad (Cons (1 :: Integer, 2 :: Integer, 3 :: Integer) Nil)
diff --git a/Haskell-book/19/shawty/.gitignore b/Haskell-book/19/shawty/.gitignore
new file mode 100644
index 0000000..16d1698
--- /dev/null
+++ b/Haskell-book/19/shawty/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+shawty.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/19/shawty/ChangeLog.md b/Haskell-book/19/shawty/ChangeLog.md
new file mode 100644
index 0000000..2ab2f20
--- /dev/null
+++ b/Haskell-book/19/shawty/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for shawty
+
+## Unreleased changes
diff --git a/Haskell-book/19/shawty/LICENSE b/Haskell-book/19/shawty/LICENSE
new file mode 100644
index 0000000..e037c72
--- /dev/null
+++ b/Haskell-book/19/shawty/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/19/shawty/README.md b/Haskell-book/19/shawty/README.md
new file mode 100644
index 0000000..c260578
--- /dev/null
+++ b/Haskell-book/19/shawty/README.md
@@ -0,0 +1 @@
+# shawty
diff --git a/Haskell-book/19/shawty/Setup.hs b/Haskell-book/19/shawty/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/19/shawty/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/19/shawty/app/Main.hs b/Haskell-book/19/shawty/app/Main.hs
new file mode 100644
index 0000000..b8bea2e
--- /dev/null
+++ b/Haskell-book/19/shawty/app/Main.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad (replicateM)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.ByteString.Char8 as BC
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import qualified Data.Text.Lazy as TL
+import qualified Database.Redis as R
+import Network.URI (URI, parseURI)
+import qualified System.Random as SR
+import Web.Scotty
+
+alphaNum :: String
+alphaNum = ['A'..'Z'] ++ ['0'..'9']
+
+randomElement :: String -> IO Char
+randomElement xs = do
+ let maxIndex :: Int
+ maxIndex = length xs - 1
+ -- Right of arrow is IO Int,
+ -- so randomDigit is Int
+ randomDigit <- SR.randomRIO (0, maxIndex)
+ return (xs !! randomDigit)
+
+shortyGen :: IO [Char]
+shortyGen =
+ replicateM 7 (randomElement alphaNum)
+
+saveURI :: R.Connection
+ -> BC.ByteString
+ -> BC.ByteString
+ -> IO (Either R.Reply R.Status)
+saveURI conn shortURI uri = R.runRedis conn $ R.set shortURI uri
+
+getURI :: R.Connection
+ -> BC.ByteString
+ -> IO (Either R.Reply (Maybe BC.ByteString))
+getURI conn shortURI = R.runRedis conn $ R.get shortURI
+
+linkShorty :: String -> String
+linkShorty shorty =
+ concat
+ [ "Copy and paste your short URL"
+ ]
+
+-- TL.concat :: [TL.Text] -> TL.Text
+shortyCreated :: Show a
+ => a
+ -> String
+ -> TL.Text
+shortyCreated resp shawty =
+ TL.concat [ TL.pack (show resp)
+ , " shorty is: "
+ , TL.pack (linkShorty shawty)
+ ]
+
+shortyAintUri :: TL.Text -> TL.Text
+shortyAintUri uri =
+ TL.concat
+ [ uri
+ , " wasn't a url,"
+ , " did you forget http://?"
+ ]
+
+shortyFound :: TL.Text -> TL.Text
+shortyFound tbs =
+ TL.concat
+ [ ""
+ , tbs, ""
+ ]
+
+app :: R.Connection
+ -> ScottyM ()
+app rConn = do
+ get "/" $ do
+ uri <- param "uri"
+ let parsedUri :: Maybe URI
+ parsedUri = parseURI (TL.unpack uri)
+ case parsedUri of
+ Just _ -> do
+ shawty <- liftIO shortyGen
+ let shorty = BC.pack shawty
+ uri' = encodeUtf8 (TL.toStrict uri)
+ resp <- liftIO (saveURI rConn shorty uri')
+ html (shortyCreated resp shawty)
+ Nothing -> text (shortyAintUri uri)
+ get "/:short" $ do
+ short <- param "short"
+ uri <- liftIO (getURI rConn short)
+ case uri of
+ Left reply -> text (TL.pack (show reply))
+ Right mbBS -> case mbBS of
+ Nothing -> text "uri not found"
+ Just bs -> html (shortyFound tbs)
+ where tbs :: TL.Text
+ tbs = TL.fromStrict (decodeUtf8 bs)
+
+
+main :: IO ()
+main = do
+ rConn <- R.connect R.defaultConnectInfo
+ scotty 3000 (app rConn)
diff --git a/Haskell-book/19/shawty/package.yaml b/Haskell-book/19/shawty/package.yaml
new file mode 100644
index 0000000..ea8e1ab
--- /dev/null
+++ b/Haskell-book/19/shawty/package.yaml
@@ -0,0 +1,31 @@
+name: shawty
+version: 0.1.0.0
+homepage: http://github.com
+license: BSD3
+author: Chris Allen
+maintainer: cma@bitemyapp.com
+copyright: 2015, Chris Allen
+build-type: Simple
+
+synopsis: URI shortener
+category: Web
+description: Please see README.md
+
+dependencies:
+- base >= 4.7 && < 5
+- bytestring
+- hedis
+- mtl
+- network-uri
+- random
+- scotty
+- semigroups
+- text
+- transformers
+
+executables:
+ shawty:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
diff --git a/Haskell-book/19/shawty/stack.yaml b/Haskell-book/19/shawty/stack.yaml
new file mode 100644
index 0000000..97a175f
--- /dev/null
+++ b/Haskell-book/19/shawty/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.4
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/19/shawty/test/Spec.hs b/Haskell-book/19/shawty/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/Haskell-book/19/shawty/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/Haskell-book/20/Exercises.hs b/Haskell-book/20/Exercises.hs
new file mode 100644
index 0000000..6bab580
--- /dev/null
+++ b/Haskell-book/20/Exercises.hs
@@ -0,0 +1,38 @@
+module Exercises where
+
+-- 1
+data Constant a b = Constant b deriving (Show)
+
+instance Foldable (Constant a) where
+ foldr f acc (Constant x) = f x acc
+
+-- 2
+data Two a b = Two a b deriving (Show)
+
+instance Foldable (Two a) where
+ foldr f acc (Two _ x) = f x acc
+
+-- 3
+data Three a b c = Three a b c deriving (Show)
+
+instance Foldable (Three a b) where
+ foldr f acc (Three _ _ x) = f x acc
+
+-- 4
+data Three' a b = Three' a b b deriving (Show)
+
+instance Foldable (Three' a) where
+ foldr f acc (Three' _ x y) = f y $ f x acc
+
+-- 5
+data Four' a b = Four' a b b b deriving (Show)
+
+instance Foldable (Four' a) where
+ foldr f acc (Four' _ x y z) = f z $ f y $ f x acc
+
+filterF :: ( Applicative f
+ , Foldable t
+ , Monoid (f a))
+ => (a -> Bool) -> t a -> f a
+filterF f x = foldMap y x
+ where y k = if f k then pure k else mempty
diff --git a/Haskell-book/20/LibraryFunctions.hs b/Haskell-book/20/LibraryFunctions.hs
new file mode 100644
index 0000000..412de32
--- /dev/null
+++ b/Haskell-book/20/LibraryFunctions.hs
@@ -0,0 +1,51 @@
+module LibraryFunctions where
+
+-- 1
+sum :: (Foldable t, Num a) => t a -> a
+sum = foldr (+) 0
+
+-- 2
+product :: (Foldable t, Num a) => t a -> a
+product = foldr (*) 0
+
+-- 3
+elem :: (Foldable t, Eq a) => a -> t a -> Bool
+elem needle = foldr (\x b -> b || (needle == x)) False
+
+-- 4
+minimum :: (Foldable t, Ord a) => t a -> Maybe a
+minimum = foldr f Nothing
+ where f x Nothing = Just x
+ f x (Just y)
+ | x > y = Just x
+ | otherwise = Just y
+
+-- 5
+maximum :: (Foldable t, Ord a) => t a -> Maybe a
+maximum = foldr f Nothing
+ where f x Nothing = Just x
+ f x (Just y)
+ | x < y = Just x
+ | otherwise = Just y
+
+-- 6
+null :: (Foldable t) => t a -> Bool
+null f = LibraryFunctions.length f == 0
+
+-- 7
+length :: (Foldable t) => t a -> Int
+length = foldr (\_ l -> l + 1) 0
+
+-- 8
+toList :: (Foldable t) => t a -> [a]
+toList = foldr (:) []
+
+-- 9
+-- | Combine the elements of a structure using a monoid.
+--
+fold :: (Foldable t, Monoid m) => t m -> m
+fold = LibraryFunctions.foldMap id
+
+-- 10
+foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
+foldMap f t = foldr (\x m -> mappend (f x) m) mempty t
diff --git a/Haskell-book/21/instances/.gitignore b/Haskell-book/21/instances/.gitignore
new file mode 100644
index 0000000..5273565
--- /dev/null
+++ b/Haskell-book/21/instances/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+instances.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/21/instances/LICENSE b/Haskell-book/21/instances/LICENSE
new file mode 100644
index 0000000..e037c72
--- /dev/null
+++ b/Haskell-book/21/instances/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/21/instances/Setup.hs b/Haskell-book/21/instances/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/21/instances/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/21/instances/package.yaml b/Haskell-book/21/instances/package.yaml
new file mode 100644
index 0000000..11b92bb
--- /dev/null
+++ b/Haskell-book/21/instances/package.yaml
@@ -0,0 +1,24 @@
+name: instances
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- QuickCheck
+- checkers
+
+library:
+ source-dirs: src
+
+tests:
+ instances-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - instances
diff --git a/Haskell-book/21/instances/src/Lib.hs b/Haskell-book/21/instances/src/Lib.hs
new file mode 100644
index 0000000..1fbb25b
--- /dev/null
+++ b/Haskell-book/21/instances/src/Lib.hs
@@ -0,0 +1,222 @@
+module Lib where
+
+import Data.Monoid
+import Data.Traversable
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+--
+-- Identity
+--
+newtype Identity a = Identity a
+ deriving (Eq, Ord, Show)
+
+instance Functor Identity where
+ fmap f (Identity x) = Identity $ f x
+
+instance Applicative Identity where
+ pure = Identity
+ (Identity f) <*> x = fmap f x
+
+instance Foldable Identity where
+ foldr f acc (Identity x) = f x acc
+
+instance Arbitrary a => Arbitrary (Identity a) where
+ arbitrary = fmap Identity $ arbitrary
+
+instance Eq a => EqProp (Identity a) where
+ (=-=) = eq
+
+instance Traversable Identity where
+ traverse f (Identity x) = Identity <$> f x
+
+--
+-- Constant
+--
+newtype Constant a b = Constant { getConstant :: a }
+ deriving (Eq, Ord, Show)
+
+instance Functor (Constant a) where
+ fmap _ (Constant x) = Constant x
+
+instance Monoid a => Applicative (Constant a) where
+ pure _ = Constant mempty
+ (Constant x) <*> (Constant y) = Constant $ mappend x y
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Constant a b) where
+ arbitrary = do
+ x <- arbitrary
+ return $ Constant x
+
+instance (Eq a, Eq b) => EqProp (Constant a b) where
+ (=-=) = eq
+
+instance Foldable (Constant a) where
+ foldMap _ (Constant _) = mempty
+
+instance Traversable (Constant a) where
+ traverse f (Constant x) = pure $ Constant x
+
+--
+-- Maybe
+--
+data Optional a = Nada | Yep a deriving (Show, Eq, Ord)
+
+instance Monoid a => Monoid (Optional a) where
+ mempty = Nada
+ mappend Nada _ = Nada
+ mappend _ Nada = Nada
+ mappend (Yep x) (Yep y) = Yep $ mappend x y
+
+instance Applicative Optional where
+ pure = Yep
+ (Yep f) <*> (Yep x) = Yep $ f x
+ Nada <*> (Yep x) = Nada
+ _ <*> Nada = Nada
+
+instance Functor Optional where
+ fmap _ Nada = Nada
+ fmap f (Yep x) = Yep $ f x
+
+instance Foldable Optional where
+ foldr f acc Nada = acc
+ foldr f acc (Yep x) = f x acc
+
+instance Traversable Optional where
+ traverse f Nada = pure Nada
+ traverse f (Yep x) = Yep <$> f x
+
+instance (CoArbitrary a, Arbitrary a) => Arbitrary (Optional a) where
+ arbitrary = do
+ x <- arbitrary
+ frequency [ (1, return Nada)
+ , (2, return $ Yep x)
+ ]
+
+instance (Eq a) => EqProp (Optional a) where
+ (=-=) = eq
+
+--
+-- List
+--
+data List a = Nil | Cons a (List a) deriving (Eq, Show)
+
+instance Functor List where
+ fmap _ Nil = Nil
+ fmap f (Cons x xs) = Cons (f x) (fmap f xs)
+
+instance Foldable List where
+ foldr _ acc Nil = acc
+ foldr f acc (Cons x xs) = f x (foldr f acc xs)
+
+instance Traversable List where
+ sequenceA Nil = pure Nil
+ sequenceA (Cons x xs) = Cons <$> x <*> (sequenceA xs)
+
+instance Arbitrary a => Arbitrary (List a) where
+ arbitrary = sized go
+ where go 0 = pure Nil
+ go n = do
+ xs <- go (n - 1)
+ x <- arbitrary
+ return $ Cons x xs
+
+instance (Eq a) => EqProp (List a) where
+ (=-=) = eq
+
+--
+-- Three
+--
+data Three a b c = Three a b c deriving (Show, Eq)
+
+instance Functor (Three a b) where
+ fmap f (Three x y z) = Three x y (f z)
+
+instance Foldable (Three a b) where
+ foldr f acc (Three x y z) = (f z acc)
+
+instance Traversable (Three a b) where
+ traverse f (Three x y z) = fmap (Three x y) (f z)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Three x y z
+
+instance (Eq a, Eq b, Eq c) => EqProp (Three a b c) where
+ (=-=) = eq
+
+--
+-- Pair
+--
+data Pair a b = Pair a b deriving (Eq, Show)
+
+instance Functor (Pair a) where
+ fmap f (Pair x y) = Pair x (f y)
+
+instance Foldable (Pair a) where
+ foldr f acc (Pair x y) = (f y acc)
+
+instance Traversable (Pair a) where
+ traverse f (Pair x y) = fmap (Pair x) (f y)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ return $ Pair x y
+
+instance (Eq a, Eq b) => EqProp (Pair a b) where
+ (=-=) = eq
+
+--
+-- Big
+--
+data Big a b = Big a b b deriving (Eq, Show)
+
+instance Functor (Big a) where
+ fmap f (Big x y z) = Big x (f y) (f z)
+
+instance Foldable (Big a) where
+ foldr f acc (Big _ y z) = (f y (f z acc))
+
+instance Traversable (Big a) where
+ traverse f (Big x y z) = (Big x) <$> (f y) <*> (f z)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Big a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ return $ Big x y z
+
+instance (Eq a, Eq b) => EqProp (Big a b) where
+ (=-=) = eq
+
+--
+-- Bigger
+--
+data Bigger a b = Bigger a b b b deriving (Eq, Show)
+
+instance Functor (Bigger a) where
+ fmap f (Bigger x y z t) = Bigger x (f y) (f z) (f t)
+
+instance Foldable (Bigger a) where
+ foldr f acc (Bigger _ y z t) = f y $ f z $ f t acc
+
+instance Traversable (Bigger a) where
+ traverse f (Bigger x y z t) = (Bigger x) <$> (f y) <*> (f z) <*> (f t)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Bigger a b) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ t <- arbitrary
+ return $ Bigger x y z t
+
+instance (Eq a, Eq b) => EqProp (Bigger a b) where
+ (=-=) = eq
+
diff --git a/Haskell-book/21/instances/src/SkiFree.hs b/Haskell-book/21/instances/src/SkiFree.hs
new file mode 100644
index 0000000..70e87dc
--- /dev/null
+++ b/Haskell-book/21/instances/src/SkiFree.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module SkiFree where
+
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+data S n a = S (n a) a deriving (Eq, Show)
+
+instance ( Functor n
+ , Arbitrary (n a)
+ , Arbitrary a)
+ => Arbitrary (S n a) where
+ arbitrary = S <$> arbitrary <*> arbitrary
+
+--instance ( Applicative n
+-- , Testable (n Property)
+-- , EqProp a)
+-- => EqProp (S n a) where
+-- (S x y) =-= (S p q) =
+-- (property $ (=-=) <$> x <*> p) .&. (y =-= q)
+instance (Eq (n a), Eq a) => EqProp (S n a) where
+ (=-=) = eq
+
+instance Functor n => Functor (S n) where
+ fmap f (S x y) = S (fmap f x) (f y)
+
+instance Foldable n => Foldable (S n) where
+ foldMap f (S n a) = mappend (foldMap f n) (f a)
+
+instance Traversable n => Traversable (S n) where
+ traverse f (S x y) = S <$> (traverse f x) <*> (f y)
diff --git a/Haskell-book/21/instances/src/Tree.hs b/Haskell-book/21/instances/src/Tree.hs
new file mode 100644
index 0000000..5c0740c
--- /dev/null
+++ b/Haskell-book/21/instances/src/Tree.hs
@@ -0,0 +1,44 @@
+module Tree where
+
+import Data.Monoid
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+
+-- Solution:
+-- https://www.reddit.com/r/HaskellBook/comments/7w7bqn/ch_21_is_this_a_sane_instance_of_traversable/
+
+data Tree a = Empty
+ | Leaf a
+ | Node (Tree a) a (Tree a)
+ deriving (Eq, Show)
+
+instance Functor Tree where
+ fmap _ Empty = Empty
+ fmap f (Leaf x) = Leaf $ f x
+ fmap f (Node x y z) = Node (fmap f x) (f y) (fmap f z)
+
+-- foldMap is a bit easier and looks more natural, but you can do
+-- foldr too for extra credit.
+instance Foldable Tree where
+ foldMap _ Empty = mempty
+ foldMap f (Leaf x) = f x
+ foldMap f (Node x y z) = (foldMap f x) <> (f y) <> (foldMap f z)
+
+instance Traversable Tree where
+ traverse f Empty = pure Empty
+ traverse f (Leaf x) = Leaf <$> f x
+ traverse f (Node x y z) = Node <$> (traverse f x) <*> (f y) <*> (traverse f z)
+
+instance Arbitrary a => Arbitrary (Tree a) where
+ arbitrary = do
+ x <- arbitrary
+ y <- arbitrary
+ z <- arbitrary
+ frequency [ (1, return Empty)
+ , (2, return $ Leaf y)
+ , (3, return $ Node x y z)
+ ]
+
+instance Eq a => EqProp (Tree a) where
+ (=-=) = eq
diff --git a/Haskell-book/21/instances/stack.yaml b/Haskell-book/21/instances/stack.yaml
new file mode 100644
index 0000000..35d283a
--- /dev/null
+++ b/Haskell-book/21/instances/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.5
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/21/instances/test/Spec.hs b/Haskell-book/21/instances/test/Spec.hs
new file mode 100644
index 0000000..934b120
--- /dev/null
+++ b/Haskell-book/21/instances/test/Spec.hs
@@ -0,0 +1,35 @@
+import Lib
+import Data.Monoid
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+import Test.QuickCheck.Classes
+import SkiFree
+import Tree
+
+main :: IO ()
+main = do
+ sample' (arbitrary :: Gen (S [] Int))
+
+ quickBatch $ traversable $ (Identity (['a'], ['b'], ['c']))
+
+ quickBatch $ applicative $ (undefined :: Constant (String, String, String) (String, String, String))
+ quickBatch $ traversable $ (undefined :: Constant (String, String, String) (String, String, String))
+
+ quickBatch $ traversable $ (undefined :: Optional (String, String, String))
+
+ quickBatch $ traversable $ (undefined :: List (String, String, String))
+
+ quickBatch $ traversable $ (undefined :: Three (String, String, String)
+ (String, String, String)
+ (String, String, String))
+ quickBatch $ traversable $ (undefined :: Pair (String, String, String)
+ (String, String, String))
+ quickBatch $ traversable $ (undefined :: Big (String, String, String)
+ (String, String, String))
+ quickBatch $ traversable $ (undefined :: Bigger (String, String, String)
+ (String, String, String))
+
+ quickBatch $ functor $ S [("a", "q", "y")] ("a", "b", "c")
+ quickBatch $ traversable $ S [("a", "q", "y")] ("a", "b", "c")
+
+ quickBatch $ traversable $ Leaf ("a", "q", "y")
diff --git a/Haskell-book/22/Ash.hs b/Haskell-book/22/Ash.hs
new file mode 100644
index 0000000..d3bf585
--- /dev/null
+++ b/Haskell-book/22/Ash.hs
@@ -0,0 +1,7 @@
+module Ask where
+
+newtype Reader r a =
+ Reader { runReader :: r -> a }
+
+ask :: Reader a a
+ask = Reader id
diff --git a/Haskell-book/22/Reader.hs b/Haskell-book/22/Reader.hs
new file mode 100644
index 0000000..e50b623
--- /dev/null
+++ b/Haskell-book/22/Reader.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE InstanceSigs #-}
+module Reader where
+
+import Control.Applicative (liftA2)
+
+newtype Reader r a =
+ Reader { runReader :: r -> a }
+
+myLiftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
+myLiftA2 f x y = f <$> x <*> y
+
+asks :: (r -> a) -> Reader r a
+asks f = Reader f
+
+instance Functor (Reader r) where
+ fmap f (Reader x) = Reader $ f . x
+
+instance Applicative (Reader r) where
+ pure :: a -> Reader r a
+ pure a = Reader $ \x -> a
+ (<*>) :: Reader r (a -> b) -> Reader r a -> Reader r b
+ (Reader rab) <*> (Reader ra) = Reader $ \r -> rab r (ra r)
+
+instance Monad (Reader r) where
+ return = pure
+ (>>=) :: Reader r a -> (a -> Reader r b) -> Reader r b
+ (Reader ra) >>= aRb = Reader $ \r -> runReader (aRb (ra r)) r
+
+newtype HumanName = HumanName String deriving (Eq, Show)
+newtype DogName = DogName String deriving (Eq, Show)
+newtype Address = Address String deriving (Eq, Show)
+
+data Person = Person { humanName :: HumanName
+ , dogName :: DogName
+ , address :: Address
+ } deriving (Eq, Show)
+
+data Dog = Dog { dogsName :: DogName
+ , dogsAddress :: Address
+ } deriving (Eq, Show)
+
+pers :: Person
+pers = Person (HumanName "Big Bird")
+ (DogName "Barkley")
+ (Address "Sesame Street")
+
+chris :: Person
+chris = Person (HumanName "Chris Allen")
+ (DogName "Papu")
+ (Address "Austin")
+
+getDog :: Person -> Dog
+getDog p = Dog (dogName p) (address p)
+
+getDogR :: Person -> Dog
+getDogR = Dog <$> dogName <*> address
+
+getDogR' :: Person -> Dog
+getDogR' = liftA2 Dog dogName address
+
+getDogRM :: Person -> Dog
+getDogRM = dogName >>= (\x -> address >>= \y -> return $ Dog x y)
diff --git a/Haskell-book/22/ReaderPractice.hs b/Haskell-book/22/ReaderPractice.hs
new file mode 100644
index 0000000..e530d20
--- /dev/null
+++ b/Haskell-book/22/ReaderPractice.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module ReaderPractice where
+
+import Control.Applicative
+import Data.Maybe (Maybe(..))
+import Prelude ( zip
+ , foldr
+ , ($)
+ , flip
+ , Integer(..)
+ , (==)
+ , Eq
+ , otherwise
+ , undefined
+ , (+)
+ , Num
+ , (<)
+ , (>)
+ , (&&)
+ , Bool(..)
+ , print
+ , sequenceA
+ , IO(..)
+ , fmap
+ , even
+ , Integral )
+
+x = [1, 2, 3]
+y = [4, 5, 6]
+z = [7, 8, 9]
+
+lookup :: Eq a => a -> [(a, b)] -> Maybe b
+lookup v l = foldr f Nothing l
+ where f _ (Just x) = Just x
+ f (x, y) Nothing
+ | x == v = Just y
+ | otherwise = Nothing
+
+-- zip x and y using 3 as the lookup key
+xs :: Maybe Integer
+xs = lookup 3 (zip x y)
+
+-- zip y and z using 6 as the lookup key
+ys :: Maybe Integer
+ys = lookup 6 (zip y z)
+
+-- zip x and y using 4 as the lookup key
+zs :: Maybe Integer
+zs = lookup 4 $ zip x y
+
+z' :: Integer -> Maybe Integer
+z' = flip lookup $ zip x z
+
+x1 :: Maybe (Integer, Integer)
+x1 = Just (,) <*> xs <*> ys
+
+x2 :: Maybe (Integer, Integer)
+x2 = Just (,) <*> ys <*> zs
+
+x3 :: Integer -> (Maybe Integer, Maybe Integer)
+x3 n = (z' n, z' n)
+
+uncurry :: (a -> b -> c) -> (a, b) -> c
+uncurry f (x, y) = f x y
+
+summed :: Num c => (c, c) -> c
+summed = uncurry (+)
+
+bolt :: Integer -> Bool
+bolt = (&&) <$> (> 3) <*> (< 8)
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe x (Just y) = y
+fromMaybe x Nothing = x
+
+sequA :: Integral a => a -> [Bool]
+sequA m = sequenceA [(>3), (<8), even] m
+
+s' :: Maybe Integer
+s' = summed <$> ((,) <$> xs <*> ys)
+
+main :: IO ()
+main = do
+ print $ sequenceA [Just 3, Just 2, Just 1]
+ print $ sequenceA [x, y]
+ print $ sequenceA [xs, ys]
+ print $ summed <$> ((,) <$> xs <*> ys)
+ print $ fmap summed ((,) <$> xs <*> zs)
+ print $ bolt 7
+ print $ fmap bolt z
+ print $ sequenceA [(> 3), (< 8), even] 7
+ print $ foldr (&&) True $ sequA $ fromMaybe 0 s'
+ print $ sequA $ fromMaybe 0 s'
+ print $ bolt $ fromMaybe 0 s'
diff --git a/Haskell-book/22/WarmingUp.hs b/Haskell-book/22/WarmingUp.hs
new file mode 100644
index 0000000..b8dd194
--- /dev/null
+++ b/Haskell-book/22/WarmingUp.hs
@@ -0,0 +1,21 @@
+module WarmingUp where
+
+import Data.Char
+
+cap :: [Char] -> [Char]
+cap xs = map toUpper xs
+
+rev :: [Char] -> [Char]
+rev xs = reverse xs
+
+composed :: [Char] -> [Char]
+composed = cap . rev
+
+fmapped :: [Char] -> [Char]
+fmapped = fmap cap rev
+
+tupled :: [Char] -> ([Char], [Char])
+tupled = (,) <$> composed <*> fmapped
+
+tupled' :: [Char] -> ([Char], [Char])
+tupled' = composed >>= (\x -> fmapped >>= (\y -> return (x, y)))
diff --git a/Haskell-book/23/FizzBuzz.hs b/Haskell-book/23/FizzBuzz.hs
new file mode 100644
index 0000000..daee3f7
--- /dev/null
+++ b/Haskell-book/23/FizzBuzz.hs
@@ -0,0 +1,29 @@
+module FizzBuzz where
+
+import Control.Monad
+import Control.Monad.Trans.State
+
+fizzBuzz :: Integer -> String
+fizzBuzz n
+ | n `mod` 15 == 0 = "FizzBuzz"
+ | n `mod` 5 == 0 = "Buzz"
+ | n `mod` 3 == 0 = "Fizz"
+ | otherwise = show n
+
+fizzbuzzList :: [Integer] -> [String]
+fizzbuzzList list = execState (mapM_ addResult list) []
+
+addResult :: Integer -> State [String] ()
+addResult n = do
+ xs <- get
+ let result = fizzBuzz n
+ put (result : xs)
+
+fizzbuzzFromTo :: Integer -> Integer -> [String]
+fizzbuzzFromTo from to = execState (mapM_ addResult (genList from [])) []
+ where genList from soFar
+ | from > to = soFar
+ | otherwise = genList (from + 1) (from : soFar)
+
+main :: IO ()
+main = mapM_ putStrLn $ fizzbuzzFromTo 1 100
diff --git a/Haskell-book/23/Moi.hs b/Haskell-book/23/Moi.hs
new file mode 100644
index 0000000..70352f3
--- /dev/null
+++ b/Haskell-book/23/Moi.hs
@@ -0,0 +1,34 @@
+module Moi where
+
+newtype Moi s a = Moi { runMoi :: s -> (a, s) }
+
+instance Functor (Moi s) where
+ -- fmap :: (a -> b) -> Moi s a -> Moi s b
+ fmap f (Moi g) = Moi (\x -> h $ g x)
+ where h (a, b) = (f a, b)
+
+instance Applicative (Moi s) where
+ -- pure :: a -> Moi s a
+ pure a = Moi (\s -> (a, s))
+ -- (<*>) :: Moi s (a -> b) -> Moi s a -> Moi s b
+ (Moi f) <*> (Moi g) = Moi (\s -> ((fst (f s)) (fst (g s)), s))
+
+instance Monad (Moi s) where
+ return = pure
+ -- (>>=) :: Moi s a -> (a -> Moi s b) -> Moi s b
+ (Moi f) >>= g = Moi (\s -> (runMoi (g (fst (f s)))) (snd (f s)))
+
+get :: Moi s s
+get = Moi $ \a -> (a, a)
+
+put :: s -> Moi s ()
+put s = Moi $ \_ -> ((), s)
+
+exec :: Moi s a -> s -> s
+exec (Moi sa) s = snd (sa s)
+
+eval :: Moi s a -> s -> a
+eval (Moi sa) s = fst (sa s)
+
+modify :: (s -> s) -> Moi s ()
+modify f = Moi $ \a -> ((), f a)
diff --git a/Haskell-book/23/RandomExample/.gitignore b/Haskell-book/23/RandomExample/.gitignore
new file mode 100644
index 0000000..694b2b1
--- /dev/null
+++ b/Haskell-book/23/RandomExample/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+RandomExample.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/23/RandomExample/LICENSE b/Haskell-book/23/RandomExample/LICENSE
new file mode 100644
index 0000000..e037c72
--- /dev/null
+++ b/Haskell-book/23/RandomExample/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/23/RandomExample/Setup.hs b/Haskell-book/23/RandomExample/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/23/RandomExample/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/23/RandomExample/app/Main.hs b/Haskell-book/23/RandomExample/app/Main.hs
new file mode 100644
index 0000000..d82a4bd
--- /dev/null
+++ b/Haskell-book/23/RandomExample/app/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/Haskell-book/23/RandomExample/package.yaml b/Haskell-book/23/RandomExample/package.yaml
new file mode 100644
index 0000000..9fe2ffe
--- /dev/null
+++ b/Haskell-book/23/RandomExample/package.yaml
@@ -0,0 +1,34 @@
+name: RandomExample
+version: 0.1.0.0
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugene Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- random
+- transformers
+
+library:
+ source-dirs: src
+
+executables:
+ RandomExample-exe:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - RandomExample
+
+tests:
+ RandomExample-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - RandomExample
diff --git a/Haskell-book/23/RandomExample/src/RandomExample.hs b/Haskell-book/23/RandomExample/src/RandomExample.hs
new file mode 100644
index 0000000..deaa449
--- /dev/null
+++ b/Haskell-book/23/RandomExample/src/RandomExample.hs
@@ -0,0 +1,31 @@
+module RandomExample where
+
+import System.Random
+
+data Die = DieOne
+ | DieTwo
+ | DieThree
+ | DieFour
+ | DieFive
+ | DieSix
+ deriving (Eq, Show)
+
+intToDie :: Int -> Die
+intToDie n =
+ case n of
+ 1 -> DieOne
+ 2 -> DieTwo
+ 3 -> DieThree
+ 4 -> DieFour
+ 5 -> DieFive
+ 6 -> DieSix
+ -- Use 'error' __extermely_ sparingly
+ x -> error $ "intToDie got non 1-6 integer: " ++ show x
+
+rollDieThreeTimes :: (Die, Die, Die)
+rollDieThreeTimes = do
+ let s = mkStdGen 0
+ (d1, s1) = randomR (1, 6) s
+ (d2, s2) = randomR (1, 6) s1
+ (d3, _) = randomR (1, 6) s2
+ (intToDie d1, intToDie d2, intToDie d3)
diff --git a/Haskell-book/23/RandomExample/src/RandomExample2.hs b/Haskell-book/23/RandomExample/src/RandomExample2.hs
new file mode 100644
index 0000000..6fbd821
--- /dev/null
+++ b/Haskell-book/23/RandomExample/src/RandomExample2.hs
@@ -0,0 +1,54 @@
+module RandomExample2 where
+
+import Control.Applicative (liftA3)
+import Control.Monad (replicateM)
+import Control.Monad.Trans.State
+import System.Random
+import RandomExample
+
+rollDie :: State StdGen Die
+rollDie = state $ do
+ (n, s) <- randomR (1, 6)
+ return (intToDie n, s)
+
+rollDie' :: State StdGen Die
+rollDie' = intToDie <$> state (randomR (1, 6))
+
+rollDieThreeTimes' :: State StdGen (Die, Die, Die)
+rollDieThreeTimes' = liftA3 (,,) rollDie rollDie rollDie
+
+infiniteDie :: State StdGen [Die]
+infiniteDie = repeat <$> rollDie
+
+nDie :: Int -> State StdGen [Die]
+nDie n = replicateM n rollDie
+
+rollsToGetTwenty :: StdGen -> Int
+rollsToGetTwenty g = go 0 0 g
+ where
+ go :: Int -> Int -> StdGen -> Int
+ go sum count gen
+ | sum >= 20 = count
+ | otherwise =
+ let (die, nextGen) = randomR (1, 6) gen
+ in go (sum + die) (count + 1) nextGen
+
+rollsToGetN :: Int -> StdGen -> Int
+rollsToGetN limit g = go 0 0 g
+ where
+ go :: Int -> Int -> StdGen -> Int
+ go sum count gen
+ | sum >= limit = count
+ | otherwise =
+ let (die, nextGen) = randomR (1, 6) gen
+ in go (sum + die) (count + 1) nextGen
+
+rollsCountLogged :: Int -> StdGen -> (Int, [Die])
+rollsCountLogged limit g = go 0 0 g []
+ where
+ go :: Int -> Int -> StdGen -> [Die] -> (Int, [Die])
+ go sum count gen dies
+ | sum >= limit = (count, dies)
+ | otherwise =
+ let (die, nextGen) = randomR (1, 6) gen
+ in go (sum + die) (count + 1) nextGen ((intToDie die) : dies)
diff --git a/Haskell-book/23/RandomExample/stack.yaml b/Haskell-book/23/RandomExample/stack.yaml
new file mode 100644
index 0000000..9c6b17c
--- /dev/null
+++ b/Haskell-book/23/RandomExample/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-10.9
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/23/RandomExample/test/Spec.hs b/Haskell-book/23/RandomExample/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/Haskell-book/23/RandomExample/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/Haskell-book/24/LearnParsers/.gitignore b/Haskell-book/24/LearnParsers/.gitignore
new file mode 100644
index 0000000..b3162b7
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+LearnParsers.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/24/LearnParsers/ChangeLog.md b/Haskell-book/24/LearnParsers/ChangeLog.md
new file mode 100644
index 0000000..365af37
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for LearnParsers
+
+## Unreleased changes
diff --git a/Haskell-book/24/LearnParsers/Setup.hs b/Haskell-book/24/LearnParsers/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/24/LearnParsers/app/Main.hs b/Haskell-book/24/LearnParsers/app/Main.hs
new file mode 100644
index 0000000..57ff0bf
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/app/Main.hs
@@ -0,0 +1,24 @@
+module Main where
+
+import Control.Applicative
+import LearnParsers
+import Text.Fractions
+import Text.Trifecta
+import Text.Parser.Combinators
+
+unitOfSuccess :: (TokenParsing m, Monad m) => m Integer
+unitOfSuccess = do
+ number <- integer
+ _ <- eof
+ return number
+
+type FractionOrNumber = Either Rational Integer
+
+parseFractionOrNumber :: Parser FractionOrNumber
+parseFractionOrNumber = skipMany (oneOf "\n")
+ >> (Left <$> try virtuousFraction)
+ <|> (Right <$> integer)
+
+main :: IO ()
+main = do
+ print $ parseString unitOfSuccess mempty "123"
diff --git a/Haskell-book/24/LearnParsers/package.yaml b/Haskell-book/24/LearnParsers/package.yaml
new file mode 100644
index 0000000..ef83d5d
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/package.yaml
@@ -0,0 +1,24 @@
+name: LearnParsers
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- trifecta
+- parsers
+
+library:
+ source-dirs: src
+
+executables:
+ LearnParsers:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - LearnParsers
diff --git a/Haskell-book/24/LearnParsers/src/LearnParsers.hs b/Haskell-book/24/LearnParsers/src/LearnParsers.hs
new file mode 100644
index 0000000..9c349fd
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/src/LearnParsers.hs
@@ -0,0 +1,45 @@
+module LearnParsers where
+
+import Text.Trifecta
+
+stop :: Parser a
+stop = unexpected "stop"
+
+-- read a single character '1'
+one = char '1'
+
+-- read a single character '1', then die
+one' = one >> stop
+-- equivalent to char '1' >> stop
+
+-- read two characters, '1', and '2'
+oneTwo = char '1' >> char '2'
+
+-- read two characters,
+-- '1' and '2', then die
+
+oneTwo' = oneTwo >> stop
+
+testParse :: Parser Char -> IO ()
+testParse p = print $ parseString p mempty "123"
+
+pNL s = putStrLn ('\n' : s)
+
+oneTwoThree :: Parser String
+oneTwoThree = choice
+ [ string "123"
+ , string "12"
+ , string "1"
+ ]
+
+oneTwoThree' = oneTwoThree >> stop
+
+testParse' :: Parser String -> IO ()
+testParse' p = print $ parseString p mempty "123"
+
+oneTwoThree'' :: Parser Char
+oneTwoThree'' = choice
+ [ one
+ , oneTwo
+ , char '1' >> char '2' >> char '3'
+ ]
diff --git a/Haskell-book/24/LearnParsers/src/Text/Fractions.hs b/Haskell-book/24/LearnParsers/src/Text/Fractions.hs
new file mode 100644
index 0000000..f09efc0
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/src/Text/Fractions.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.Fractions where
+
+import Control.Applicative
+import Data.Ratio ((%))
+import Text.Trifecta
+
+badFraction = "1/0"
+
+alsoBad = "10"
+
+shouldWork = "1/2"
+
+shouldAlsoWork = "2/1"
+
+parseFraction :: Parser Rational
+parseFraction = do
+ numerator <- decimal
+ char '/'
+ denominator <- decimal
+ return (numerator % denominator)
+
+virtuousFraction :: Parser Rational
+virtuousFraction = do
+ numerator <- decimal
+ char '/'
+ denominator <- decimal
+ case denominator of
+ 0 -> fail "Denominator cannot be zero"
+ _ -> return $ numerator % denominator
diff --git a/Haskell-book/24/LearnParsers/stack.yaml b/Haskell-book/24/LearnParsers/stack.yaml
new file mode 100644
index 0000000..c741be6
--- /dev/null
+++ b/Haskell-book/24/LearnParsers/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.0
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/24/ParserExercises/.gitignore b/Haskell-book/24/ParserExercises/.gitignore
new file mode 100644
index 0000000..1918f96
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+ParserExercises.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/24/ParserExercises/Setup.hs b/Haskell-book/24/ParserExercises/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/24/ParserExercises/package.yaml b/Haskell-book/24/ParserExercises/package.yaml
new file mode 100644
index 0000000..8740046
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/package.yaml
@@ -0,0 +1,38 @@
+name: ParserExercises
+version: 0.1.0.0
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- parsec
+- trifecta
+- QuickCheck
+- time
+- containers
+
+library:
+ source-dirs: src
+
+tests:
+ ParserExercises-test:
+ main: Main.hs
+ source-dirs: test/Spec
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ParserExercises
+ - hspec
+
+ Log-test:
+ main: Main.hs
+ source-dirs: test/LogTest
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - ParserExercises
diff --git a/Haskell-book/24/ParserExercises/src/Base10Integer.hs b/Haskell-book/24/ParserExercises/src/Base10Integer.hs
new file mode 100644
index 0000000..4e8ee3a
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/Base10Integer.hs
@@ -0,0 +1,52 @@
+module Base10Integer where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 2. Write a parser for positive integer values. Don't reuse the preexisting
+-- digit or integer functions, but you can use the rest of the libraries we've
+-- shown you so far. You are not expected to write a parsing library from
+-- scratch.
+--
+-- Hint: Assume you're parsing base-10 numbers. Use arithmetic as a cheap
+-- "accumulator" for your final number as you parse each digit left-to-right.
+
+parseDigit :: Parser Char
+parseDigit = (char '0')
+ <|> (char '1')
+ <|> (char '2')
+ <|> (char '3')
+ <|> (char '4')
+ <|> (char '5')
+ <|> (char '6')
+ <|> (char '7')
+ <|> (char '8')
+ <|> (char '9')
+
+charToDigit :: Char -> Integer
+charToDigit c = case c of
+ '0' -> 0
+ '1' -> 1
+ '2' -> 2
+ '3' -> 3
+ '4' -> 4
+ '5' -> 5
+ '6' -> 6
+ '7' -> 7
+ '8' -> 8
+ '9' -> 9
+
+base10Integer :: Parser Integer
+base10Integer = do
+ number <- some parseDigit
+ let n = foldl (\acc x -> (acc * 10) + (charToDigit x)) 0 number
+ return n
+
+-- 3. Extend the parser your wrote to handle negative and positive integers.
+-- Try writing a new parser in terms of the one you already have to do this.
+base10Integer' :: Parser Integer
+base10Integer' = do
+ negative <- (char '-' >> (return negate)) <|> (return id)
+ number <- some parseDigit
+ let n = foldl (\acc x -> (acc * 10) + (charToDigit x)) 0 number
+ return $ negative n
diff --git a/Haskell-book/24/ParserExercises/src/IPAddress.hs b/Haskell-book/24/ParserExercises/src/IPAddress.hs
new file mode 100644
index 0000000..e6a7102
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/IPAddress.hs
@@ -0,0 +1,260 @@
+module IPAddress where
+
+import Numeric
+import Control.Monad (join)
+import Control.Applicative
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Map (lookup, Map(..), fromList)
+import Data.Word
+import Data.Bits
+import Text.Trifecta
+
+-- 6. Write a parser for IPv4 addresses.
+
+data IPAddress = IPAddress Word32 deriving (Eq, Ord)
+
+parseIP4 :: Parser IPAddress
+parseIP4 = do
+ p1 <- natural
+ _ <- char '.'
+ p2 <- natural
+ _ <- char '.'
+ p3 <- natural
+ _ <- char '.'
+ p4 <- natural
+ return $ IPAddress $ fromIntegral $ xor (xor (xor (shift p1 24) (shift p2 16)) (shift p3 8)) p4
+
+-- A 32-bit word is a 32-bit unsigned int. Lowest value is 0 rahter than being
+-- capable of representing negative numbers, but the highest possible value in
+-- the same number of bits is twice as high.
+--
+-- Word32 is an appropriate and compact way to represent IPv4 addresses. You
+-- are expected to figure out not only how to parse the typical IP address
+-- format, but how IP addresses work numerically insofar as is required to
+-- write a working parser. This will require using a search engine unless you
+-- have an appropriate book on internet networking handy.
+
+-- 7. Same as before, but IPv6.
+
+data IPAddress6 = IPAddress6 Word64 Word64 deriving (Eq, Ord)
+
+-- One of the trickier parts about IPv6 will be full vs. collapsed
+-- addresses and the abbrevations. See this Q&A thread 13 about
+-- IPv6 abbreviations for more.
+
+
+newtype IPV6Normed = IPV6Normed String
+ deriving (Eq, Ord, Show)
+
+newtype IPV6Str = IPV6Str String
+ deriving (Eq, Ord, Show)
+
+spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
+spanList _ [] = ([],[])
+spanList func list@(x:xs) =
+ if func list
+ then (x:ys,zs)
+ else ([],list)
+ where (ys,zs) = spanList func xs
+
+breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
+breakList func = spanList (not . func)
+
+split' :: Eq a => [a] -> [a] -> [[a]]
+split' _ [] = []
+split' delim str =
+ let (firstline, remainder) = breakList (isPrefixOf delim) str
+ in
+ firstline : case remainder of
+ [] -> []
+ x -> if x == delim
+ then [] : []
+ else split' delim
+ (drop (length delim) x)
+
+join :: [a] -> [[a]] -> [a]
+join delim l = concat (intersperse delim l)
+
+replace :: Eq a => [a] -> [a] -> [a] -> [a]
+replace old new l = IPAddress.join new . split' old $ l
+
+split :: Eq a => a -> [a] -> [[a]]
+split d [] = []
+split d s = x : split d (drop 1 y)
+ where
+ (x, y) = Data.List.span (/= d) s
+
+twoRaised16Exp :: [Integer]
+twoRaised16Exp = fmap ((2 ^ 16) ^) [0,1 ..]
+
+validHexChars :: String
+validHexChars = "0123456789abcdefABCDEF"
+
+validHexCharsLowerOnly :: String
+validHexCharsLowerOnly = "0123456789abcdef"
+
+buildExpanded0s :: Int -> String
+buildExpanded0s i = intersperse ':' (take i (repeat '0'))
+
+ipv6NormedToIPAddress6 :: IPV6Normed -> IPAddress6
+ipv6NormedToIPAddress6 (IPV6Normed str) = IPAddress6 quotient remainder
+ where
+ asSegs = split ':' str
+ zippedWithExp = zip (reverse asSegs) twoRaised16Exp
+ asInteger = foldr (\(s, exp) acc -> hexToDec s * exp + acc) 0 zippedWithExp
+ (q, r) = quotRem asInteger word64Max
+ quotient = fromIntegral q
+ remainder = fromIntegral r
+
+hexToDec :: String -> Integer
+hexToDec s = toInteger asInt
+ where
+ asInt = baseNToDec 16 (\c -> fromMaybe 0 (Data.Map.lookup (toLower c) hexCharToValue)) s
+
+baseNToDec :: Num i => i -> (a -> i) -> [a] -> i
+baseNToDec base toInt = foldl' (\acc n -> base * acc + toInt n ) 0
+
+hexCharToValue :: Map Char Int
+hexCharToValue = Data.Map.fromList $ zip validHexCharsLowerOnly [0 ..]
+
+word64Max :: Integer
+word64Max = toInteger (maxBound :: Word64)
+
+mkIPV6Normed :: String -> Either String IPV6Normed
+mkIPV6Normed origS = result
+ where
+ expand s
+ | s == "::" = IPV6Normed $ buildExpanded0s 8
+ | isPrefixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 2
+ filler = buildExpanded0s expandCnt ++ ":"
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | isSuffixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 1
+ filler = ':' : buildExpanded0s expandCnt
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | isInfixOf "::" s =
+ let expandCnt = 8 - (length $ split ':' s) + 1
+ filler = ':' : buildExpanded0s expandCnt ++ ":"
+ replaced = replace "::" filler s
+ in IPV6Normed replaced
+ | otherwise = IPV6Normed s
+ expanded = expand origS
+ IPV6Normed expandedStr = expanded
+ result = if length (split ':' expandedStr) == 8
+ then Right expanded
+ else Left "invalid sections"
+
+parseIPV6Section :: Parser String
+parseIPV6Section = do
+ mL <- optional (try $ string "::" <|> string ":")
+ seq <- some (oneOf validHexChars)
+ mR <- optional (try $ string "::" <|> string ":")
+ let lowered = map toLower seq
+ l = fromMaybe "" mL
+ r = fromMaybe "" mR
+ return $ l ++ lowered ++ r
+
+parseIPV6Str :: Parser IPV6Str
+parseIPV6Str = do
+ s <- (try $ (fmap (: []) (string "::" <* eof))) <|> manyTill parseIPV6Section
+ eof
+ if length s < 1
+ then fail "Did not find valid sections"
+ else return $ IPV6Str $ Control.Monad.join s
+
+parseIPV6Normed :: Parser IPV6Normed
+parseIPV6Normed = do
+ str <- parseIPV6Str
+ let IPV6Str (s) = str
+ full = mkIPV6Normed s
+ case full of
+ Left err -> fail err
+ Right fullstr -> return fullstr
+
+parseIP6 :: Parser IPAddress6
+parseIP6 = do
+ normed <- parseIPV6Normed
+ return $ ipv6NormedToIPAddress6 normed
+
+-- 8. Remove the derived Show instances from the IPAddress/IPAddress6
+-- types, and write your own Show instance for each type that renders in the
+-- typical textual format appropriate to each.
+
+ipAddressToIPV4DotFields :: IPAddress -> [Integer]
+ipAddressToIPV4DotFields (IPAddress word) = repr
+ where
+ asInteger = toInteger word
+ repr = decToBaseN asInteger 0 [0 .. 255]
+
+instance Show IPAddress where
+ show ip = Control.Monad.join $ intersperse "." asStrings
+ where
+ repr = ipAddressToIPV4DotFields ip
+ asStrings = fmap show repr
+
+ipAddress6toInteger :: IPAddress6 -> Integer
+ipAddress6toInteger (IPAddress6 q r) = toInteger q * word64Max + toInteger r
+
+iPAddress6ToIPV6Normed :: IPAddress6 -> IPV6Normed
+iPAddress6ToIPV6Normed ip = IPV6Normed s
+ where
+ asInteger = ipAddress6toInteger ip
+ chopped = integerToChoppedUp asInteger
+ ss = fmap integerToHexString chopped
+ fillCnt = 8 - length ss
+ filled = (take fillCnt (repeat "0")) ++ ss
+ s = Control.Monad.join $ intersperse ":" filled
+
+instance Show IPAddress6 where
+ show ip = normed
+ where IPV6Normed normed = iPAddress6ToIPV6Normed ip
+
+-- 9. Write a function that converts between IPAddress and IPAddress6.
+
+decToBaseN :: Integral a => a -> b -> [b] -> [b]
+decToBaseN i zero digits = if base == 0
+ then []
+ else go i []
+ where
+ base = fromIntegral $ length digits
+ go 0 [] = [zero]
+ go 0 acc = acc
+ go curr acc =
+ let (q, r) = quotRem curr base
+ in go q ((digits !! fromIntegral r) : acc)
+
+integerToHexString :: Integer -> String
+integerToHexString i = decToBaseN i '0' validHexCharsLowerOnly
+
+integerToChoppedUp :: Integer -> [Integer]
+integerToChoppedUp i = go i []
+ where
+ go 0 [] = [0]
+ go 0 acc = acc
+ go curr acc =
+ let (q, r) = quotRem curr (2 ^ 16)
+ in go q (r : acc)
+
+ipV4ToIpV6Normed :: IPAddress -> IPV6Normed
+ipV4ToIpV6Normed (IPAddress word) = normed
+ where
+ asInteger = toInteger word
+ chopped = integerToChoppedUp asInteger
+ ss = fmap integerToHexString chopped
+ fillCnt = 8 - length ss - 1
+ -- - ffff signifies an ip4 to ip6 conversion
+ -- (http://www.tcpipguide.com/free/t_IPv6IPv4AddressEmbedding-2.htm)
+ filled = (take fillCnt $ repeat "0") ++ ["ffff"] ++ ss
+ s = Control.Monad.join $ intersperse ":" filled
+ normed = IPV6Normed s
+
+ipV4ToIpV6 :: IPAddress -> IPAddress6
+ipV4ToIpV6 ip = ipv6
+ where
+ normed = ipV4ToIpV6Normed ip
+ ipv6 = ipv6NormedToIPAddress6 normed
diff --git a/Haskell-book/24/ParserExercises/src/LogParser.hs b/Haskell-book/24/ParserExercises/src/LogParser.hs
new file mode 100644
index 0000000..480498d
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/LogParser.hs
@@ -0,0 +1,83 @@
+module LogParser where
+
+import Control.Applicative
+import Data.Time
+import Test.QuickCheck
+import Text.Trifecta
+
+-- 5. Write a parser for a log file format and sum the time spent in
+-- each activity. Additionally, provide an alternative aggregation
+-- of the data that provides average time spent per activity per day.
+-- The format supports the use of comments which your parser
+-- will have to ignore. The # characters followed by a date mark
+-- the beginning of a particular day.
+--
+-- You are to derive a reasonable datatype for representing this
+-- data yourself. For bonus points, make this bi-directional by
+-- making a Show representation for the datatype which matches
+-- the format you are parsing. Then write a generator for this data
+-- using QuickCheck’s Gen and see if you can break your parser
+-- with QuickCheck.
+
+data Statement = Statement TimeOfDay String deriving Eq
+data LogEntry = LogEntry Day [Statement] deriving Eq
+newtype Log = Log { getLog :: [LogEntry] }
+
+instance Show Statement where
+ show (Statement x y) = (formatTime defaultTimeLocale "%R" x) ++ " " ++ y
+
+instance Show LogEntry where
+ show (LogEntry x y) = "# " ++ (show x) ++ "\n"
+ ++ (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)
+
+instance Show Log where
+ show (Log y) = (foldl (\acc v -> acc ++ (show v) ++ "\n") "" y)
+
+instance Arbitrary Statement where
+ arbitrary = do
+ h <- choose (0, 23)
+ m <- choose (0, 59)
+ text <- listOf1 $ elements ['.'..'~']
+ return $ Statement (TimeOfDay h m 0) text
+
+instance Arbitrary LogEntry where
+ arbitrary = do
+ day <- arbitrary
+ statements <- arbitrary
+ return $ LogEntry (ModifiedJulianDay day) statements
+
+skipEOL :: Parser ()
+skipEOL = skipMany (oneOf "\n")
+
+skipComments :: Parser ()
+skipComments =
+ skipMany (do _ <- char '-'
+ _ <- char '-'
+ skipMany (noneOf "\n")
+ skipEOL)
+
+parseStatement :: Parser Statement
+parseStatement = do
+ h <- integer
+ _ <- char ':'
+ m <- integer
+ text <- manyTill anyChar (try (string "--") <|> (string "\n") <|> (eof >> return ""))
+ skipComments
+ skipEOL
+ return $ Statement (TimeOfDay (fromIntegral h) (fromIntegral m) 0) text
+
+parseLogEntry :: Parser LogEntry
+parseLogEntry = do
+ _ <- string "# "
+ y <- integer
+ _ <- char '-'
+ m <- integer
+ _ <- char '-'
+ d <- integer
+ skipComments
+ skipEOL
+ statements <- many parseStatement
+ return $ LogEntry (fromGregorian (fromIntegral y) (fromIntegral m) (fromIntegral d)) statements
+
+parseLog :: Parser Log
+parseLog = Log <$> many parseLogEntry
diff --git a/Haskell-book/24/ParserExercises/src/PhoneNumber.hs b/Haskell-book/24/ParserExercises/src/PhoneNumber.hs
new file mode 100644
index 0000000..dad75a7
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/PhoneNumber.hs
@@ -0,0 +1,28 @@
+module PhoneNumber where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 4. Write a parser for US/Canada phone numbers with varying formats.
+-- Cf. Wikipeida's article on "National conventions for writing telephone
+-- numbers". You are encouraged to adapt the exercise to your locality's
+-- conventions if they are not part of the NNAP scheme.
+
+-- aka area code
+type NumberingPlanArea = Int
+type Exchange = Int
+type LineNumber = Int
+
+data PhoneNumber = PhoneNumber NumberingPlanArea Exchange LineNumber
+ deriving (Eq, Show)
+
+parsePhone :: Parser PhoneNumber
+parsePhone = do
+ _ <- optional ((try $ char '(') <|> (try (char '1' >> char '-')))
+ area <- count 3 digit
+ _ <- optional $ (try $ char ')')
+ _ <- optional $ (try $ char ' ') <|> (try $ char '-')
+ exchange <- count 3 digit
+ _ <- optional $ (char ' ') <|> (char '-')
+ lineNumber <- decimal
+ return $ PhoneNumber (read area) (read exchange) (fromIntegral lineNumber)
diff --git a/Haskell-book/24/ParserExercises/src/SemVer.hs b/Haskell-book/24/ParserExercises/src/SemVer.hs
new file mode 100644
index 0000000..47b49ab
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/src/SemVer.hs
@@ -0,0 +1,51 @@
+module SemVer where
+
+import Control.Applicative
+import Text.Trifecta
+
+-- 1. Write a parser for semantic versions as defined by http://semver.org/.
+-- After making a working parser, write an Ord instance for the SemVer type
+-- that obeys the specification outlined on the SemVer website.
+
+-- Relevant to precedence/ordering,
+-- cannot sort numbers like strings.
+data NumberOrString = NOSS String
+ | NOSI Integer
+ deriving (Eq, Show)
+
+type Major = Integer
+type Minor = Integer
+type Patch = Integer
+type Release = [NumberOrString]
+type Metadata = [NumberOrString]
+
+data SemVer = SemVer Major Minor Patch Release Metadata
+ deriving (Eq, Show)
+
+parseNos :: Parser NumberOrString
+parseNos = do
+ nos <- (NOSI <$> integer)
+ <|> (NOSS <$> some letter)
+ return nos
+
+parseRelease :: Parser [NumberOrString]
+parseRelease = do
+ _ <- char '-'
+ sepBy parseNos (char '.')
+
+parseMetadata :: Parser [NumberOrString]
+parseMetadata = do
+ _ <- char '+'
+ sepBy parseNos (char '.')
+
+parseSemVer :: Parser SemVer
+parseSemVer = do
+ major <- decimal
+ _ <- char '.'
+ minor <- decimal
+ _ <- char '.'
+ patch <- decimal
+ release <- option [] parseRelease
+ metadata <- option [] parseMetadata
+
+ return $ SemVer major minor patch release metadata
diff --git a/Haskell-book/24/ParserExercises/stack.yaml b/Haskell-book/24/ParserExercises/stack.yaml
new file mode 100644
index 0000000..e60ca15
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.1
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/24/ParserExercises/test/LogTest/Main.hs b/Haskell-book/24/ParserExercises/test/LogTest/Main.hs
new file mode 100644
index 0000000..7d1d135
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/test/LogTest/Main.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import LogParser
+import Test.QuickCheck
+import Text.Trifecta
+
+maybeSuccess :: Text.Trifecta.Result a -> Maybe a
+maybeSuccess (Text.Trifecta.Success a) = Just a
+maybeSuccess _ = Nothing
+
+main :: IO ()
+main = do
+ quickCheck ((\s -> (maybeSuccess $ parseString parseStatement mempty (show s)) == (Just s)) :: Statement -> Bool)
+ quickCheck ((\s -> (maybeSuccess $ parseString parseLogEntry mempty (show s)) == (Just s)) :: LogEntry -> Bool)
diff --git a/Haskell-book/24/ParserExercises/test/Spec/Main.hs b/Haskell-book/24/ParserExercises/test/Spec/Main.hs
new file mode 100644
index 0000000..23781c6
--- /dev/null
+++ b/Haskell-book/24/ParserExercises/test/Spec/Main.hs
@@ -0,0 +1,107 @@
+import SemVer
+import Base10Integer
+import PhoneNumber
+import IPAddress
+import Test.Hspec
+import Text.Trifecta
+
+maybeSuccess :: Result a -> Maybe a
+maybeSuccess (Success a) = Just a
+maybeSuccess _ = Nothing
+
+parseIP :: String -> Maybe IPAddress
+parseIP s = o
+ where r = parseString parseIP4 mempty s
+ o = case r of
+ (Success o) -> Just o
+ _ -> Nothing
+
+parseIP6' :: String -> Maybe IPAddress6
+parseIP6' s = o
+ where r = parseString parseIP6 mempty s
+ o = case r of
+ (Success o) -> Just o
+ _ -> Nothing
+
+main :: IO ()
+main = hspec $ do
+ describe "parseSemVer" $ do
+ it "parses minimum SemVer" $ do
+ let got = maybeSuccess $ parseString parseSemVer mempty "2.1.1"
+ in got `shouldBe` Just (SemVer 2 1 1 [] [])
+ it "parses release field" $ do
+ let got = maybeSuccess $ parseString parseSemVer mempty "1.0.0-x.7.z.92"
+ expected = Just $ SemVer 1 0 0 [NOSS "x", NOSI 7, NOSS "z", NOSI 92] []
+ in got `shouldBe` expected
+
+ describe "parseDigit" $ do
+ it "parses the first digit of '123'" $ do
+ let got = maybeSuccess $ parseString parseDigit mempty "123"
+ expected = Just '1'
+ in got `shouldBe` expected
+ it "fails on 'abc'" $ do
+ let got = maybeSuccess $ parseString parseDigit mempty "abc"
+ expected = Nothing
+ in got `shouldBe` expected
+
+ describe "base10Integer" $ do
+ it "parses the integer in '123abc'" $ do
+ let got = maybeSuccess $ parseString base10Integer mempty "123abc"
+ expected = Just 123
+ in got `shouldBe` expected
+ it "fails on 'abc'" $ do
+ let got = maybeSuccess $ parseString base10Integer mempty "abc"
+ expected = Nothing
+ in got `shouldBe` expected
+
+ describe "base10Integer'" $ do
+ it "parses negative numbers" $ do
+ let got = maybeSuccess $ parseString base10Integer' mempty "-123abc"
+ expected = Just (-123)
+ in got `shouldBe` expected
+
+ describe "parsePhone" $ do
+ it "parses '123-456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "123-456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '1234567890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "1234567890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '(123) 456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "(123) 456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+ it "parses '1-123-456-7890'" $ do
+ let actual = maybeSuccess $ parseString parsePhone mempty "1-123-456-7890"
+ expected = Just $ PhoneNumber 123 456 7890
+ in actual `shouldBe` expected
+
+ describe "parseIP4" $ do
+ it "parses localhost" $ do
+ let actual = maybeSuccess $ parseString parseIP4 mempty "127.0.0.1"
+ expected = Just $ IPAddress 2130706433
+ in actual `shouldBe` expected
+
+ describe "parseIP6" $ do
+ it "parses localhost" $ do
+ let actual = maybeSuccess $ parseString parseIP6 mempty "::1"
+ expected = Just $ IPAddress6 0 1
+ in actual `shouldBe` expected
+
+ describe "ipV4ToIpV6" $
+ it "should work" $ do
+ (show . ipV4ToIpV6 <$> parseIP "124.155.107.12") `shouldBe` Just "0:0:0:0:0:ffff:7c9b:6b0c"
+ (show . ipV4ToIpV6 <$> parseIP "192.168.0.1") `shouldBe` Just "0:0:0:0:0:ffff:c0a8:1"
+
+ describe "show" $ do
+ it "should show IPAddress6 properly" $ do
+ (show <$> parseIP6' "ff39:0:0:0:2f2:b3ff:f23d:8d5") `shouldBe` Just "ff39:0:0:0:2f2:b3ff:f23d:8d5"
+ (show <$> parseIP6' "9ff3:EA8::8A:30:2F0C:1F7A") `shouldBe` Just "9ff3:ea8:0:0:8a:30:2f0c:1f7a"
+ (show <$> parseIP6' "::ffff:abc:fed9") `shouldBe` Just "0:0:0:0:0:ffff:abc:fed9"
+
+ it "should show IPAddress properly" $ do
+ (show <$> parseIP "152.163.254.3") `shouldBe` Just "152.163.254.3"
+ (show <$> parseIP "224.165.197.142") `shouldBe` Just "224.165.197.142"
+ (show <$> parseIP "124.155.107.12") `shouldBe` Just "124.155.107.12"
diff --git a/Haskell-book/24/language-dot/LICENSE b/Haskell-book/24/language-dot/LICENSE
new file mode 100644
index 0000000..59fd4e9
--- /dev/null
+++ b/Haskell-book/24/language-dot/LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2009, Galois, Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in
+ the documentation and/or other materials provided with the
+ distribution.
+ * Neither the name of the Galois, Inc. nor the names of its
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/24/language-dot/Setup.hs b/Haskell-book/24/language-dot/Setup.hs
new file mode 100644
index 0000000..dba3cdf
--- /dev/null
+++ b/Haskell-book/24/language-dot/Setup.hs
@@ -0,0 +1,12 @@
+module Main where
+
+import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, runTests)
+import System.Process (system)
+
+main :: IO ()
+main =
+ defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }
+ where
+ runTests' _ _ _ _ = do
+ system "runhaskell -DTEST -i./src src/test.hs"
+ return ()
diff --git a/Haskell-book/24/language-dot/language-dot.cabal b/Haskell-book/24/language-dot/language-dot.cabal
new file mode 100644
index 0000000..5463485
--- /dev/null
+++ b/Haskell-book/24/language-dot/language-dot.cabal
@@ -0,0 +1,59 @@
+name: language-dot
+version: 0.0.8
+category: Language
+synopsis: A library for the analysis and creation of Graphviz DOT files
+description: A library for the analysis and creation of Graphviz DOT files.
+author: Brian Lewis
+maintainer: Brian Lewis
+copyright: (c) 2009 Galois, Inc.
+license: BSD3
+license-file: LICENSE
+
+cabal-version: >= 1.6
+build-type: Custom
+
+extra-source-files:
+ src/test.hs
+
+flag executable
+ description: Build the `ppdot' executable.
+ default: True
+
+library
+ hs-source-dirs:
+ src
+
+ exposed-modules:
+ Language.Dot
+ Language.Dot.Parser
+ Language.Dot.Pretty
+ Language.Dot.Syntax
+
+ build-depends:
+ base == 4.*,
+ mtl == 1.* || == 2.*,
+ parsec == 3.*,
+ pretty == 1.*
+
+ ghc-options: -Wall
+ if impl(ghc >= 6.8)
+ ghc-options: -fwarn-tabs
+
+executable ppdot
+ if flag(executable)
+ buildable: True
+ else
+ buildable: False
+
+ hs-source-dirs:
+ src
+
+ main-is: ppdot.hs
+
+ ghc-options: -Wall
+ if impl(ghc >= 6.8)
+ ghc-options: -fwarn-tabs
+
+source-repository head
+ type: git
+ location: git://github.com/bsl/language-dot.git
diff --git a/Haskell-book/24/language-dot/src/Language/Dot.hs b/Haskell-book/24/language-dot/src/Language/Dot.hs
new file mode 100644
index 0000000..b1a87a3
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot.hs
@@ -0,0 +1,10 @@
+module Language.Dot
+ ( module Language.Dot.Parser
+ , module Language.Dot.Pretty
+ , module Language.Dot.Syntax
+ )
+ where
+
+import Language.Dot.Parser
+import Language.Dot.Pretty
+import Language.Dot.Syntax
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs b/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs
new file mode 100644
index 0000000..a13d457
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Parser.hs
@@ -0,0 +1,486 @@
+{-# LANGUAGE CPP #-}
+
+module Language.Dot.Parser
+ ( parseDot
+#ifdef TEST
+ , parsePort
+ , parseCompass
+ , parseAttribute
+ , parseId
+#endif
+ )
+ where
+
+import Control.Applicative ((<$>), (<*>), (<*), (*>))
+import Control.Monad (when)
+import Data.Char (digitToInt, toLower)
+import Data.List (foldl')
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Numeric (readFloat)
+
+import Text.Parsec
+import Text.Parsec.Language
+import Text.Parsec.String
+import Text.Parsec.Token
+
+import Language.Dot.Syntax
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseDot
+ :: String -- ^ origin of the data, e.g., the name of a file
+ -> String -- ^ DOT source code
+ -> Either ParseError Graph
+parseDot origin =
+ parse (whiteSpace' >> parseGraph) origin . preprocess
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+preprocess :: String -> String
+preprocess =
+ unlines . map commentPoundLines . lines
+ where
+ commentPoundLines [] = []
+ commentPoundLines line@(c:_) = if c == '#' then "// " ++ line else line
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseGraph :: Parser Graph
+parseGraph =
+ ( Graph <$>
+ parseGraphStrictness
+ <*> parseGraphDirectedness
+ <*> optionMaybe parseId
+ <*> parseStatementList
+ )
+ "graph"
+
+parseGraphStrictness :: Parser GraphStrictness
+parseGraphStrictness =
+ ((reserved' "strict" >> return StrictGraph) <|> return UnstrictGraph)
+ "graph strictness"
+
+parseGraphDirectedness :: Parser GraphDirectedness
+parseGraphDirectedness =
+ ( (reserved' "graph" >> return UndirectedGraph)
+ <|> (reserved' "digraph" >> return DirectedGraph)
+ )
+ "graph directedness"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseStatementList :: Parser [Statement]
+parseStatementList =
+ braces' (parseStatement `endBy` optional semi')
+ "statement list"
+
+parseStatement :: Parser Statement
+parseStatement =
+ ( try parseEdgeStatement
+ <|> try parseAttributeStatement
+ <|> try parseAssignmentStatement
+ <|> try parseSubgraphStatement
+ <|> parseNodeStatement
+ )
+ "statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseNodeStatement :: Parser Statement
+parseNodeStatement =
+ ( NodeStatement <$>
+ parseNodeId <*> parseAttributeList
+ )
+ "node statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseEdgeStatement :: Parser Statement
+parseEdgeStatement =
+ ( EdgeStatement <$>
+ parseEntityList <*> parseAttributeList
+ )
+ "edge statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAttributeStatement :: Parser Statement
+parseAttributeStatement =
+ ( AttributeStatement <$>
+ parseAttributeStatementType <*> parseAttributeList
+ )
+ "attribute statement"
+
+parseAttributeStatementType :: Parser AttributeStatementType
+parseAttributeStatementType =
+ ( (reserved' "graph" >> return GraphAttributeStatement)
+ <|> (reserved' "node" >> return NodeAttributeStatement)
+ <|> (reserved' "edge" >> return EdgeAttributeStatement)
+ )
+ "attribute statement type"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAssignmentStatement :: Parser Statement
+parseAssignmentStatement =
+ ( AssignmentStatement <$>
+ parseId <*> (reservedOp' "=" *> parseId)
+ )
+ "assignment statement"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseSubgraphStatement :: Parser Statement
+parseSubgraphStatement =
+ ( SubgraphStatement <$>
+ parseSubgraph
+ )
+ "subgraph statement"
+
+parseSubgraph :: Parser Subgraph
+parseSubgraph =
+ ( try parseNewSubgraph
+ <|> parseSubgraphRef
+ )
+ "subgraph"
+
+parseNewSubgraph :: Parser Subgraph
+parseNewSubgraph =
+ ( NewSubgraph <$>
+ (optional (reserved' "subgraph") *> optionMaybe parseId) <*> parseStatementList
+ )
+ "new subgraph"
+
+parseSubgraphRef :: Parser Subgraph
+parseSubgraphRef =
+ ( SubgraphRef <$>
+ (reserved' "subgraph" *> parseId)
+ )
+ "subgraph ref"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseEntityList :: Parser [Entity]
+parseEntityList =
+ ( (:) <$>
+ parseEntity True <*> many1 (parseEntity False)
+ )
+ "entity list"
+
+parseEntity :: Bool -> Parser Entity
+parseEntity first =
+ ( try (parseENodeId first)
+ <|> parseESubgraph first
+ )
+ "entity"
+
+parseENodeId :: Bool -> Parser Entity
+parseENodeId first =
+ ( ENodeId <$>
+ (if first then return NoEdge else parseEdgeType) <*> parseNodeId
+ )
+ "entity node id"
+
+parseESubgraph :: Bool -> Parser Entity
+parseESubgraph first =
+ ( ESubgraph <$>
+ (if first then return NoEdge else parseEdgeType) <*> parseSubgraph
+ )
+ "entity subgraph"
+
+parseEdgeType :: Parser EdgeType
+parseEdgeType =
+ ( try (reservedOp' "->" >> return DirectedEdge)
+ <|> (reservedOp' "--" >> return UndirectedEdge)
+ )
+ "edge operator"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseNodeId :: Parser NodeId
+parseNodeId =
+ ( NodeId <$>
+ parseId <*> optionMaybe parsePort
+ )
+ "node id"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parsePort :: Parser Port
+parsePort =
+ ( try parsePortC
+ <|> parsePortI
+ )
+ "port"
+
+parsePortC :: Parser Port
+parsePortC =
+ ( PortC <$>
+ (colon' *> parseCompass)
+ )
+ "port (compass variant)"
+
+parsePortI :: Parser Port
+parsePortI =
+ ( PortI <$>
+ (colon' *> parseId) <*> optionMaybe (colon' *> parseCompass)
+ )
+ "port (id variant)"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseCompass :: Parser Compass
+parseCompass =
+ (fmap convert identifier' >>= maybe err return)
+ "compass"
+ where
+ err = parserFail "invalid compass value"
+ convert =
+ flip lookup table . stringToLower
+ where
+ table =
+ [ ("n", CompassN), ("e", CompassE), ("s", CompassS), ("w", CompassW)
+ , ("ne", CompassNE), ("nw", CompassNW), ("se", CompassSE), ("sw", CompassSW)
+ ]
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseAttributeList :: Parser [Attribute]
+parseAttributeList =
+ (brackets' (parseAttribute `sepBy` optional comma') <|> return [])
+ "attribute list"
+
+parseAttribute :: Parser Attribute
+parseAttribute =
+ ( do
+ id0 <- parseId
+ id1 <- optionMaybe (reservedOp' "=" >> parseId)
+ return $ maybe (AttributeSetTrue id0) (AttributeSetValue id0) id1
+ )
+ "attribute"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseId :: Parser Id
+parseId =
+ ( try parseNameId
+ <|> try parseStringId
+ <|> try parseFloatId
+ <|> try parseIntegerId
+ <|> parseXmlId
+ )
+ "id"
+
+parseNameId :: Parser Id
+parseNameId =
+ ( NameId <$>
+ identifier'
+ )
+ "name"
+
+parseStringId :: Parser Id
+parseStringId =
+ ( StringId <$>
+ lexeme' (char '"' *> manyTill stringChar (char '"'))
+ )
+ "string literal"
+ where
+ stringChar =
+ (try (string "\\\"" >> return '"') <|> noneOf "\"")
+ "string character"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+-- | DOT allows floating point numbers having no whole part like @.123@, but
+-- Parsec 'float' does not accept them.
+parseFloatId :: Parser Id
+parseFloatId =
+ lexeme'
+ ( do s <- parseSign
+ l <- fmap (fromMaybe 0) (optionMaybe parseNatural)
+ _ <- char '.'
+ r <- many1 digit
+ maybe err return (make s (show l ++ "." ++ r))
+ )
+ "float"
+ where
+ err = parserFail "invalid float value"
+ make s f =
+ case readFloat f of
+ [(v,"")] -> (Just . FloatId . s) v
+ _ -> Nothing
+
+parseSign :: (Num a) => Parser (a -> a)
+parseSign =
+ ( (char '-' >> return negate)
+ <|> (char '+' >> return id)
+ <|> return id
+ )
+ "sign"
+
+-- | Non-'lexeme' variant of 'natural' for parsing the natural part of a float.
+parseNatural :: Parser Integer
+parseNatural =
+ ( (char '0' >> return 0)
+ <|> (convert <$> many1 digit)
+ )
+ "natural"
+ where
+ convert = foldl' (\acc d -> 10 * acc + fromIntegral (digitToInt d)) 0
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseIntegerId :: Parser Id
+parseIntegerId =
+ ( IntegerId <$>
+ integer'
+ )
+ "integer"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parseXmlId :: Parser Id
+parseXmlId =
+ ( XmlId <$>
+ angles' parseXml
+ )
+ "XML id"
+
+parseXml :: Parser Xml
+parseXml =
+ ( try parseXmlEmptyTag
+ <|> try parseXmlTag
+ <|> parseXmlText
+ )
+ "XML"
+
+parseXmlEmptyTag :: Parser Xml
+parseXmlEmptyTag =
+ ( XmlEmptyTag <$>
+ (char '<' *> parseXmlName) <*> (parseXmlAttributes <* (char '/' >> char '>'))
+ )
+ "XML empty tag"
+
+parseXmlTag :: Parser Xml
+parseXmlTag =
+ ( do (name, attributes) <- parseXmlTagOpen
+ elements <- manyTill parseXml (lookAhead (try (parseXmlTagClose (Just name))))
+ parseXmlTagClose (Just name)
+ return $ XmlTag name attributes elements
+ )
+ "XML tag"
+
+parseXmlTagOpen :: Parser (XmlName, [XmlAttribute])
+parseXmlTagOpen =
+ ( (,) <$>
+ (char '<' *> parseXmlName) <*> (parseXmlAttributes <* char '>')
+ )
+ "XML opening tag"
+
+parseXmlTagClose :: Maybe XmlName -> Parser ()
+parseXmlTagClose mn0 =
+ ( do _ <- char '<'
+ _ <- char '/'
+ n1 <- parseXmlName
+ _ <- char '>'
+ when (isJust mn0 && fromJust mn0 /= n1) parserZero
+ )
+ "XML closing tag " ++ "(" ++ which ++ ")"
+ where
+ which =
+ case mn0 of
+ Just (XmlName n) -> "for " ++ show n
+ Nothing -> "any"
+
+parseXmlText :: Parser Xml
+parseXmlText =
+ ( XmlText <$>
+ anyChar `manyTill` lookAhead ( try (parseXmlEmptyTag >> return ())
+ <|> try (parseXmlTag >> return ())
+ <|> parseXmlTagClose Nothing
+ )
+ )
+ "XML text"
+
+parseXmlAttributes :: Parser [XmlAttribute]
+parseXmlAttributes =
+ many parseXmlAttribute
+ "XML attribute list"
+
+parseXmlAttribute :: Parser XmlAttribute
+parseXmlAttribute =
+ ( XmlAttribute <$>
+ (parseXmlName <* reservedOp' "=") <*> parseXmlAttributeValue
+ )
+ "XML attribute"
+
+parseXmlAttributeValue :: Parser XmlAttributeValue
+parseXmlAttributeValue =
+ ( XmlAttributeValue <$>
+ stringLiteral'
+ )
+ "XML attribute value"
+
+parseXmlName :: Parser XmlName
+parseXmlName =
+ ( XmlName <$>
+ ((:) <$> c0 <*> (many c1 <* whiteSpace'))
+ )
+ "XML name"
+ where
+ c0 = letter <|> cs
+ c1 = alphaNum <|> cs
+ cs = oneOf "-.:_"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+angles' :: Parser a -> Parser a
+braces' :: Parser a -> Parser a
+brackets' :: Parser a -> Parser a
+colon' :: Parser String
+comma' :: Parser String
+identifier' :: Parser String
+integer' :: Parser Integer
+lexeme' :: Parser a -> Parser a
+reserved' :: String -> Parser ()
+reservedOp' :: String -> Parser ()
+semi' :: Parser String
+stringLiteral' :: Parser String
+whiteSpace' :: Parser ()
+
+angles' = angles lexer
+braces' = braces lexer
+brackets' = brackets lexer
+colon' = colon lexer
+comma' = comma lexer
+identifier' = identifier lexer
+integer' = integer lexer
+lexeme' = lexeme lexer
+reserved' = reserved lexer
+reservedOp' = reservedOp lexer
+semi' = semi lexer
+stringLiteral' = stringLiteral lexer
+whiteSpace' = whiteSpace lexer
+
+lexer :: TokenParser ()
+lexer =
+ makeTokenParser dotDef
+ where
+ dotDef = emptyDef
+ { commentStart = "/*"
+ , commentEnd = "*/"
+ , commentLine = "//"
+ , nestedComments = True
+ , identStart = letter <|> char '_'
+ , identLetter = alphaNum <|> char '_'
+ , opStart = oneOf "-="
+ , opLetter = oneOf ""
+ , reservedOpNames = ["->", "--", "="]
+ , reservedNames = ["digraph", "edge", "graph", "node", "strict", "subgraph"]
+ , caseSensitive = False
+ }
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+stringToLower :: String -> String
+stringToLower = map toLower
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs b/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs
new file mode 100644
index 0000000..84a4c0c
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Pretty.hs
@@ -0,0 +1,135 @@
+module Language.Dot.Pretty
+ ( prettyPrintDot
+ , renderDot
+ , PP(..)
+ )
+ where
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+import Numeric
+import Text.PrettyPrint
+
+import Language.Dot.Syntax
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+prettyPrintDot :: Graph -> Doc
+prettyPrintDot = pp
+
+renderDot :: Graph -> String
+renderDot = render . pp
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+class PP a where
+ pp :: a -> Doc
+
+instance (PP a) => PP (Maybe a) where
+ pp (Just v) = pp v
+ pp Nothing = empty
+
+instance PP Graph where
+ pp (Graph s d mi ss) = pp s <+> pp d <+> pp mi <+> lbrace $+$ indent (vcat' ss) $+$ rbrace
+
+instance PP GraphStrictness where
+ pp StrictGraph = text "strict"
+ pp UnstrictGraph = empty
+
+instance PP GraphDirectedness where
+ pp DirectedGraph = text "digraph"
+ pp UndirectedGraph = text "graph"
+
+instance PP Id where
+ pp (NameId v) = text v
+ pp (StringId v) = doubleQuotes (text v)
+ pp (IntegerId v) = integer v
+ pp (FloatId v) = ffloat v
+ pp (XmlId v) = langle <> pp v <> rangle
+
+instance PP Statement where
+ pp (NodeStatement ni as) = pp ni <+> if not (null as) then brackets (hsep' as) else empty
+ pp (EdgeStatement es as) = hsep' es <+> if not (null as) then brackets (hsep' as) else empty
+ pp (AttributeStatement t as) = pp t <+> brackets (hsep' as)
+ pp (AssignmentStatement i0 i1) = pp i0 <> equals <> pp i1
+ pp (SubgraphStatement s) = pp s
+
+instance PP AttributeStatementType where
+ pp GraphAttributeStatement = text "graph"
+ pp NodeAttributeStatement = text "node"
+ pp EdgeAttributeStatement = text "edge"
+
+instance PP Attribute where
+ pp (AttributeSetTrue i) = pp i
+ pp (AttributeSetValue i0 i1) = pp i0 <> equals <> pp i1
+
+instance PP NodeId where
+ pp (NodeId i mp) = pp i <> pp mp
+
+instance PP Port where
+ pp (PortI i mc) = colon <> pp i <> maybe empty ((colon <>) . pp) mc
+ pp (PortC c) = colon <> pp c
+
+instance PP Compass where
+ pp CompassN = text "n"
+ pp CompassE = text "e"
+ pp CompassS = text "s"
+ pp CompassW = text "w"
+ pp CompassNE = text "ne"
+ pp CompassNW = text "nw"
+ pp CompassSE = text "se"
+ pp CompassSW = text "sw"
+
+instance PP Subgraph where
+ pp (NewSubgraph mi ss) = text "subgraph" <+> pp mi <+> lbrace $+$ indent (vcat' ss) $+$ rbrace
+ pp (SubgraphRef i) = text "subgraph" <+> pp i
+
+instance PP Entity where
+ pp (ENodeId et ni) = pp et <+> pp ni
+ pp (ESubgraph et sg) = pp et <+> pp sg
+
+instance PP EdgeType where
+ pp NoEdge = empty
+ pp DirectedEdge = text "->"
+ pp UndirectedEdge = text "--"
+
+instance PP Xml where
+ pp (XmlEmptyTag n as) = langle <> pp n <+> hsep' as <> slash <> rangle
+ pp (XmlTag n as xs) = langle <> pp n <+> hsep' as <> rangle <> hcat' xs <> langle <> slash <> pp n <> rangle
+ pp (XmlText t) = text t
+
+instance PP XmlName where
+ pp (XmlName n) = text n
+
+instance PP XmlAttribute where
+ pp (XmlAttribute n v) = pp n <> equals <> pp v
+
+instance PP XmlAttributeValue where
+ pp (XmlAttributeValue v) = doubleQuotes (text v)
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+indent :: Doc -> Doc
+indent = nest 2
+
+hcat' :: (PP a) => [a] -> Doc
+hcat' = hcat . map pp
+
+hsep' :: (PP a) => [a] -> Doc
+hsep' = hsep . map pp
+
+vcat' :: (PP a) => [a] -> Doc
+vcat' = vcat . map pp
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+langle :: Doc
+rangle :: Doc
+slash :: Doc
+
+langle = char '<'
+rangle = char '>'
+slash = char '/'
+
+ffloat :: Float -> Doc
+ffloat v = text (showFFloat Nothing v "")
diff --git a/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs b/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs
new file mode 100644
index 0000000..cca7d99
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/Language/Dot/Syntax.hs
@@ -0,0 +1,92 @@
+-- | DOT AST. See .
+
+module Language.Dot.Syntax where
+
+data Graph
+ = Graph GraphStrictness GraphDirectedness (Maybe Id) [Statement]
+ deriving (Eq, Show)
+
+data GraphStrictness
+ = StrictGraph
+ | UnstrictGraph
+ deriving (Eq, Show)
+
+data GraphDirectedness
+ = DirectedGraph
+ | UndirectedGraph
+ deriving (Eq, Show)
+
+data Id
+ = NameId String
+ | StringId String
+ | IntegerId Integer
+ | FloatId Float
+ | XmlId Xml
+ deriving (Eq, Show)
+
+data Statement
+ = NodeStatement NodeId [Attribute]
+ | EdgeStatement [Entity] [Attribute]
+ | AttributeStatement AttributeStatementType [Attribute]
+ | AssignmentStatement Id Id
+ | SubgraphStatement Subgraph
+ deriving (Eq, Show)
+
+data AttributeStatementType
+ = GraphAttributeStatement
+ | NodeAttributeStatement
+ | EdgeAttributeStatement
+ deriving (Eq, Show)
+
+data Attribute
+ = AttributeSetTrue Id
+ | AttributeSetValue Id Id
+ deriving (Eq, Show)
+
+data NodeId
+ = NodeId Id (Maybe Port)
+ deriving (Eq, Show)
+
+data Port
+ = PortI Id (Maybe Compass)
+ | PortC Compass
+ deriving (Eq, Show)
+
+data Compass
+ = CompassN | CompassE | CompassS | CompassW
+ | CompassNE | CompassNW | CompassSE | CompassSW
+ deriving (Eq, Show)
+
+data Subgraph
+ = NewSubgraph (Maybe Id) [Statement]
+ | SubgraphRef Id
+ deriving (Eq, Show)
+
+data Entity
+ = ENodeId EdgeType NodeId
+ | ESubgraph EdgeType Subgraph
+ deriving (Eq, Show)
+
+data EdgeType
+ = NoEdge
+ | DirectedEdge
+ | UndirectedEdge
+ deriving (Eq, Show)
+
+data Xml
+ = XmlEmptyTag XmlName [XmlAttribute]
+ | XmlTag XmlName [XmlAttribute] [Xml]
+ | XmlText String
+ deriving (Eq, Show)
+
+data XmlName
+ = XmlName String
+ deriving (Eq, Show)
+
+data XmlAttribute
+ = XmlAttribute XmlName XmlAttributeValue
+ deriving (Eq, Show)
+
+data XmlAttributeValue
+ = XmlAttributeValue String
+ deriving (Eq, Show)
diff --git a/Haskell-book/24/language-dot/src/ppdot.hs b/Haskell-book/24/language-dot/src/ppdot.hs
new file mode 100644
index 0000000..6051845
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/ppdot.hs
@@ -0,0 +1,72 @@
+module Main (main) where
+
+import Control.Exception (IOException, try)
+import Control.Monad.Error (ErrorT(..), MonadError(..))
+import System.Environment (getArgs, getProgName)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (hPutStrLn, stderr)
+
+import Language.Dot (parseDot, renderDot)
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+main :: IO ()
+main =
+ getArgs >>= run
+
+run :: [String] -> IO ()
+run args =
+ case args of
+ [fp] -> renderDotFile fp
+ [] -> displayUsage >> exitSuccess
+ _ -> displayUsage >> exitFailure
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+renderDotFile :: FilePath -> IO ()
+renderDotFile fp =
+ runErrorT (renderDotFileET fp) >>= either exitError putStrLn
+
+renderDotFileET :: FilePath -> ErrorT String IO String
+renderDotFileET fp = do
+ contents <- readFile fp `liftCatch` show
+ graph <- parseDot fp contents `liftEither` show
+ return $ renderDot graph
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+displayUsage :: IO ()
+displayUsage = do
+ programName <- getProgName
+ ePutStrLns
+ [ programName ++ ": Pretty-print a Graphviz DOT file."
+ , unwords ["Usage:", programName, "FILE"]
+ ]
+
+exitError :: String -> IO ()
+exitError e = do
+ displayUsage
+ ePutStrLn ""
+ let el = lines e
+ if length el == 1
+ then ePutStrLn ("ERROR: " ++ e)
+ else ePutStrLns ("ERROR:" : indent el)
+ exitFailure
+ where
+ indent = map (" "++)
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+liftCatch :: IO a -> (IOException -> e) -> ErrorT e IO a
+liftCatch a f = ErrorT $ fmap (either (Left . f) Right) (try a)
+
+liftEither :: (MonadError e m) => Either l r -> (l -> e) -> m r
+liftEither e f = either (throwError . f) return e
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+ePutStrLn :: String -> IO ()
+ePutStrLn = hPutStrLn stderr
+
+ePutStrLns :: [String] -> IO ()
+ePutStrLns = mapM_ (hPutStrLn stderr)
diff --git a/Haskell-book/24/language-dot/src/test.hs b/Haskell-book/24/language-dot/src/test.hs
new file mode 100644
index 0000000..2fa4e0b
--- /dev/null
+++ b/Haskell-book/24/language-dot/src/test.hs
@@ -0,0 +1,120 @@
+module Main (main) where
+
+import Control.Monad (unless)
+import Data.Char (toLower, toUpper)
+
+import Text.Parsec
+import Text.Parsec.String
+
+import Language.Dot.Parser
+import Language.Dot.Syntax
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+main :: IO ()
+main = do
+ testParser "parsePort" parsePort parsePortTests
+ testParser "parseCompass" parseCompass parseCompassTests
+ testParser "parseAttribute" parseAttribute parseAttributeTests
+ testParser "parseId" parseId parseIdTests
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parsePortTests :: [(String, Port)]
+parsePortTests =
+ [ ( ":\"x\"" , PortI (StringId "x" ) Nothing )
+ , ( ":\"\\t\\\"\":nw" , PortI (StringId "\\t\"" ) (Just CompassNW) )
+ , ( ":-.0004" , PortI (FloatId (-0.0004) ) Nothing )
+ , ( ":-1.23:sE" , PortI (FloatId (-1.23) ) (Just CompassSE) )
+ , ( ":123" , PortI (IntegerId 123 ) Nothing )
+ , ( ":123:NE" , PortI (IntegerId 123 ) (Just CompassNE) )
+ , ( ":__2xYz" , PortI (NameId "__2xYz" ) Nothing )
+ , ( ":__2xYz:S" , PortI (NameId "__2xYz" ) (Just CompassS) )
+ , ( ":n" , PortC CompassN )
+ , ( ":SE" , PortC CompassSE )
+ ]
+
+parseCompassTests :: [(String, Compass)]
+parseCompassTests =
+ concat
+ [ [ (t, CompassN) | t <- allCaps "n" ]
+ , [ (t, CompassE) | t <- allCaps "e" ]
+ , [ (t, CompassS) | t <- allCaps "s" ]
+ , [ (t, CompassW) | t <- allCaps "w" ]
+ , [ (t, CompassNE) | t <- allCaps "ne" ]
+ , [ (t, CompassNW) | t <- allCaps "nw" ]
+ , [ (t, CompassSE) | t <- allCaps "se" ]
+ , [ (t, CompassSW) | t <- allCaps "sw" ]
+ ]
+
+parseAttributeTests :: [(String, Attribute)]
+parseAttributeTests =
+ [ ( "a" , AttributeSetTrue (NameId "a") )
+ , ( "a=b" , AttributeSetValue (NameId "a") (NameId "b") )
+ , ( "-.003\t=\r\n _xYz123_" , AttributeSetValue (FloatId (-0.003)) (NameId "_xYz123_") )
+ , ( "\"\\t\\\"\" =-123" , AttributeSetValue (StringId "\\t\"") (IntegerId (-123)) )
+ ]
+
+parseIdTests :: [(String, Id)]
+parseIdTests =
+ [ ( "a" , NameId "a" )
+ , ( "A1" , NameId "A1" )
+ , ( "_2X" , NameId "_2X" )
+ , ( "\"\"" , StringId "" )
+ , ( "\"\\t\\r\\n\"" , StringId "\\t\\r\\n" )
+ , ( ".0" , FloatId 0.0 )
+ , ( ".123" , FloatId 0.123 )
+ , ( "+.999" , FloatId 0.999 )
+ , ( "-.001" , FloatId (-0.001) )
+ , ( "+.001" , FloatId 0.001 )
+ , ( "0.0" , FloatId 0.0 )
+ , ( "1.2" , FloatId 1.2 )
+ , ( "123.456" , FloatId 123.456 )
+ , ( "0" , IntegerId 0 )
+ , ( "+0" , IntegerId 0 )
+ , ( "-0" , IntegerId 0 )
+ , ( "123" , IntegerId 123 )
+ , ( "-123" , IntegerId (-123) )
+ ]
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+testParser :: (Eq a, Show a) => String -> Parser a -> [(String, a)] -> IO ()
+testParser name parser tests =
+ help tests [] (0 :: Int) (0 :: Int)
+ where
+ help [] es np nf = do
+ putStrLn $ name ++ ": " ++ show np ++ " passed, " ++ show nf ++ " failed"
+ mapM_ (putStrLn . (" "++)) (reverse es)
+ unless (null es) (putStrLn "")
+ help ((i,o):ts) es np nf =
+ case parse' parser i of
+ Left _ -> help ts (makeFailureMessage name i o : es) np (succ nf)
+ Right v ->
+ if v /= o
+ then help ts (makeFailureMessage' name i o v : es) np (succ nf)
+ else help ts es (succ np) nf
+
+makeFailureMessage :: (Show a) => String -> String -> a -> String
+makeFailureMessage name i o =
+ "(" ++ name ++ " " ++ show i ++ ")" ++
+ " should have returned " ++ "(" ++ show o ++ ")"
+
+makeFailureMessage' :: (Show a) => String -> String -> a -> a -> String
+makeFailureMessage' name i o v =
+ "(" ++ name ++ " " ++ show i ++ ")" ++
+ " returned " ++ "(" ++ show v ++ ")" ++
+ ", expected " ++ "(" ++ show o ++ ")"
+
+-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+
+parse' :: Parser a -> String -> Either ParseError a
+parse' p = parse p ""
+
+allCaps :: String -> [String]
+allCaps [] = [[]]
+allCaps (c:cs) =
+ concatMap (\t -> [l:t, u:t]) (allCaps cs)
+ where
+ l = toLower c
+ u = toUpper c
diff --git a/Haskell-book/25/Bifunctor/.gitignore b/Haskell-book/25/Bifunctor/.gitignore
new file mode 100644
index 0000000..45b62d9
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Bifunctor.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/25/Bifunctor/Setup.hs b/Haskell-book/25/Bifunctor/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/25/Bifunctor/package.yaml b/Haskell-book/25/Bifunctor/package.yaml
new file mode 100644
index 0000000..0f52279
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/package.yaml
@@ -0,0 +1,23 @@
+name: Bifunctor
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+ source-dirs: src
+
+tests:
+ Bifunctor-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - Bifunctor
diff --git a/Haskell-book/25/Bifunctor/src/Bifunctor.hs b/Haskell-book/25/Bifunctor/src/Bifunctor.hs
new file mode 100644
index 0000000..944bf13
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/src/Bifunctor.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Bifunctor where
+
+import Prelude (($), id, (.))
+
+class Bifunctor p where
+ {-# MINIMAL bimap | first, second #-}
+
+ bimap :: (a -> b)
+ -> (c -> d)
+ -> p a c
+ -> p b d
+ bimap f g = first f . second g
+
+ first :: (a -> b) -> p a c -> p b c
+ first f = bimap f id
+
+ second :: (b -> c) -> p a b -> p a c
+ second = bimap id
+
+-- 1
+data Deux a b = Deux a b
+
+instance Bifunctor Deux where
+ first f (Deux a c) = Deux (f a) c
+ second f (Deux a b) = Deux a (f b)
+
+-- 2
+data Const a b = Const a
+
+instance Bifunctor Const where
+ first f (Const a) = Const (f a)
+ second f (Const a) = Const a
+
+-- 3
+data Drei a b c = Drei a b c
+
+instance Bifunctor (Drei a) where
+ first f (Drei a b c) = Drei a (f b) c
+ second f (Drei a b c) = Drei a b (f c)
+
+-- 4
+data SuperDrei a b c = SuperDrei a b
+
+instance Bifunctor (SuperDrei a) where
+ first f (SuperDrei a b) = SuperDrei a (f b)
+ second f (SuperDrei a b) = SuperDrei a b
+
+-- 5
+data SemiDrei a b c = SemiDrei a
+
+instance Bifunctor (SemiDrei a) where
+ first f (SemiDrei a) = SemiDrei a
+ second f (SemiDrei a) = SemiDrei a
+
+-- 6
+data Quadriceps a b c d = Quadzzz a b c d
+
+instance Bifunctor (Quadriceps a b) where
+ first f (Quadzzz a b c d) = Quadzzz a b (f c) d
+ second f (Quadzzz a b c d) = Quadzzz a b c (f d)
+
+-- 7
+data Either a b = Left a | Right b
+
+instance Bifunctor Either where
+ first f (Left a) = Left $ f a
+ second f (Right b) = Right $ f b
\ No newline at end of file
diff --git a/Haskell-book/25/Bifunctor/stack.yaml b/Haskell-book/25/Bifunctor/stack.yaml
new file mode 100644
index 0000000..05facc0
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.6
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/25/Bifunctor/test/Spec.hs b/Haskell-book/25/Bifunctor/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/Haskell-book/25/Bifunctor/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/Haskell-book/25/Twinplicative/.gitignore b/Haskell-book/25/Twinplicative/.gitignore
new file mode 100644
index 0000000..33823d2
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Twinplicative.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/25/Twinplicative/LICENSE b/Haskell-book/25/Twinplicative/LICENSE
new file mode 100644
index 0000000..e037c72
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Author name here nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Haskell-book/25/Twinplicative/Setup.hs b/Haskell-book/25/Twinplicative/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/25/Twinplicative/package.yaml b/Haskell-book/25/Twinplicative/package.yaml
new file mode 100644
index 0000000..0c1eed0
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/package.yaml
@@ -0,0 +1,13 @@
+name: Twinplicative
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+ source-dirs: src
\ No newline at end of file
diff --git a/Haskell-book/25/Twinplicative/src/Twinplicative.hs b/Haskell-book/25/Twinplicative/src/Twinplicative.hs
new file mode 100644
index 0000000..f8840fa
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/src/Twinplicative.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE InstanceSigs #-}
+module Twinplicative where
+
+newtype Identity a
+ = Identity { runIdentity :: a }
+
+instance Functor Identity where
+ fmap f (Identity a) = Identity (f a)
+
+newtype Compose f g a =
+ Compose { getCompose :: f (g a) }
+ deriving (Eq, Show)
+
+instance (Functor f, Functor g) =>
+ Functor (Compose f g) where
+ fmap f (Compose fga) =
+ Compose $ (fmap . fmap) f fga
+
+-- instance types provided as they may help.
+instance (Applicative f, Applicative g)
+ => Applicative (Compose f g) where
+ pure :: a -> Compose f g a
+ pure x = Compose $ (pure . pure) x
+
+ (<*>) :: Compose f g (a -> b)
+ -> Compose f g a
+ -> Compose f g b
+ (Compose f) <*> (Compose a) = Compose $ (fmap (<*>) f) <*> a
+
+
+instance (Foldable f, Foldable g) =>
+ Foldable (Compose f g) where
+ foldMap f (Compose fga) =
+ (foldMap . foldMap) f fga
+
+instance (Traversable f, Traversable g) =>
+ Traversable (Compose f g) where
+ traverse :: Applicative f1 => (a -> f1 b)
+ -> Compose f g a
+ -> f1 (Compose f g b)
+ traverse f (Compose fga) =
+ Compose <$> (traverse . traverse) f fga
\ No newline at end of file
diff --git a/Haskell-book/25/Twinplicative/stack.yaml b/Haskell-book/25/Twinplicative/stack.yaml
new file mode 100644
index 0000000..05facc0
--- /dev/null
+++ b/Haskell-book/25/Twinplicative/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.6
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/26/Embedded/Embedded.cabal b/Haskell-book/26/Embedded/Embedded.cabal
new file mode 100644
index 0000000..d0898f4
--- /dev/null
+++ b/Haskell-book/26/Embedded/Embedded.cabal
@@ -0,0 +1,40 @@
+-- This file has been generated from package.yaml by hpack version 0.20.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 4aaf9c578000b87231817edc542c283c58e2e1562cc290df37e9e8a9628885b0
+
+name: Embedded
+version: 0.1.0.0
+author: Eugen Wissner
+maintainer: belka@caraus.de
+copyright: 2018 Eugen Wissner
+license: BSD3
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+ hs-source-dirs:
+ src
+ build-depends:
+ base >=4.7 && <5
+ , transformers
+ exposed-modules:
+ OuterInner
+ other-modules:
+ Paths_Embedded
+ default-language: Haskell2010
+
+test-suite Embedded-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs:
+ test
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ Embedded
+ , base >=4.7 && <5
+ , transformers
+ other-modules:
+ Paths_Embedded
+ default-language: Haskell2010
diff --git a/Haskell-book/26/Embedded/Setup.hs b/Haskell-book/26/Embedded/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/26/Embedded/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/26/Embedded/package.yaml b/Haskell-book/26/Embedded/package.yaml
new file mode 100644
index 0000000..59f144a
--- /dev/null
+++ b/Haskell-book/26/Embedded/package.yaml
@@ -0,0 +1,24 @@
+name: Embedded
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- transformers
+
+library:
+ source-dirs: src
+
+tests:
+ Embedded-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - Embedded
diff --git a/Haskell-book/26/Embedded/src/OuterInner.hs b/Haskell-book/26/Embedded/src/OuterInner.hs
new file mode 100644
index 0000000..edc31c1
--- /dev/null
+++ b/Haskell-book/26/Embedded/src/OuterInner.hs
@@ -0,0 +1,30 @@
+module OuterInner where
+
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
+
+-- We only need to use return once
+-- because it's one big Monad
+embedded :: MaybeT
+ (ExceptT String
+ (ReaderT () IO))
+ Int
+--embedded = return 1
+embedded = MaybeT . ExceptT . ReaderT $ return . (const (Right (Just 1)))
+
+-- We can sort of peel away the layers one by one:
+maybeUnwrap :: ExceptT String
+ (ReaderT () IO) (Maybe Int)
+maybeUnwrap = runMaybeT embedded
+
+-- Next
+eitherUnwrap :: ReaderT () IO
+ (Either String (Maybe Int))
+eitherUnwrap = runExceptT maybeUnwrap
+
+-- Lastly
+readerUnwrap :: ()
+ -> IO (Either String
+ (Maybe Int))
+readerUnwrap = runReaderT eitherUnwrap
\ No newline at end of file
diff --git a/Haskell-book/26/Embedded/stack.yaml b/Haskell-book/26/Embedded/stack.yaml
new file mode 100644
index 0000000..eb506f9
--- /dev/null
+++ b/Haskell-book/26/Embedded/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.7
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/26/Embedded/test/Spec.hs b/Haskell-book/26/Embedded/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/Haskell-book/26/Embedded/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/Haskell-book/26/Exercises/.gitignore b/Haskell-book/26/Exercises/.gitignore
new file mode 100644
index 0000000..3834f98
--- /dev/null
+++ b/Haskell-book/26/Exercises/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Exercises.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/26/Exercises/Setup.hs b/Haskell-book/26/Exercises/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/26/Exercises/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/26/Exercises/app/Main.hs b/Haskell-book/26/Exercises/app/Main.hs
new file mode 100644
index 0000000..6bfe6bb
--- /dev/null
+++ b/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 [ "Success! Count was: "
+ , TL.pack $ show (newInteger :: Integer)
+ , "
"
+ ]
+
+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
diff --git a/Haskell-book/26/Exercises/package.yaml b/Haskell-book/26/Exercises/package.yaml
new file mode 100644
index 0000000..a757233
--- /dev/null
+++ b/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
diff --git a/Haskell-book/26/Exercises/src/Exercises.hs b/Haskell-book/26/Exercises/src/Exercises.hs
new file mode 100644
index 0000000..d3a8370
--- /dev/null
+++ b/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)]
diff --git a/Haskell-book/26/Exercises/src/Fix.hs b/Haskell-book/26/Exercises/src/Fix.hs
new file mode 100644
index 0000000..bd43f7f
--- /dev/null
+++ b/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)
diff --git a/Haskell-book/26/Exercises/stack.yaml b/Haskell-book/26/Exercises/stack.yaml
new file mode 100644
index 0000000..1962baa
--- /dev/null
+++ b/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
\ No newline at end of file
diff --git a/Haskell-book/26/Exercises/test/Spec.hs b/Haskell-book/26/Exercises/test/Spec.hs
new file mode 100644
index 0000000..92db8e6
--- /dev/null
+++ b/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"]
diff --git a/Haskell-book/26/MaybeT/.gitignore b/Haskell-book/26/MaybeT/.gitignore
new file mode 100644
index 0000000..ae82431
--- /dev/null
+++ b/Haskell-book/26/MaybeT/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+MaybeT.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/26/MaybeT/Setup.hs b/Haskell-book/26/MaybeT/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/26/MaybeT/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/26/MaybeT/package.yaml b/Haskell-book/26/MaybeT/package.yaml
new file mode 100644
index 0000000..dfa5dac
--- /dev/null
+++ b/Haskell-book/26/MaybeT/package.yaml
@@ -0,0 +1,23 @@
+name: MaybeT
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+
+library:
+ source-dirs: src
+
+tests:
+ MaybeT-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - MaybeT
diff --git a/Haskell-book/26/MaybeT/src/Either.hs b/Haskell-book/26/MaybeT/src/Either.hs
new file mode 100644
index 0000000..e09bfe6
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/Either.hs
@@ -0,0 +1,56 @@
+module Either where
+
+import Control.Monad (liftM)
+import MonadTrans
+import MonadIO
+
+newtype EitherT e m a =
+ EitherT { runEitherT :: m (Either e a) }
+
+-- 1
+instance Functor m => Functor (EitherT e m) where
+ fmap f (EitherT x) = EitherT $ (fmap . fmap) f x
+
+-- 2
+instance Applicative m => Applicative (EitherT e m) where
+ pure x = EitherT $ pure $ pure x
+
+ (EitherT f) <*> (EitherT a) = EitherT $ (<*>) <$> f <*> a
+
+-- 3
+instance Monad m => Monad (EitherT e m) where
+ return = pure
+
+ (EitherT em) >>= f = EitherT $ do
+ v <- em
+ case v of
+ Left y -> return $ Left y
+ Right y -> runEitherT (f y)
+
+
+-- 4
+-- transformer version of swapEither.
+-- Hint: write swapEither first, then swapEitherT in terms of the former.
+swapEither :: Either e a -> Either a e
+swapEither (Left x) = Right x
+swapEither (Right y) = Left y
+
+swapEitherT :: (Functor m)
+ => EitherT e m a
+ -> EitherT a m e
+swapEitherT (EitherT x) = EitherT $ fmap swapEither x
+
+-- 5. Write the transformer variant of the either catamorphism.
+eitherT :: Monad m
+ => (a -> m c)
+ -> (b -> m c)
+ -> EitherT a m b
+ -> m c
+eitherT f g (EitherT x) = x >>= (either f g)
+
+instance MonadTrans (EitherT e) where
+ lift = EitherT . liftM Right
+
+instance (MonadIO m)
+ => MonadIO (EitherT e m) where
+ liftIO = lift . liftIO
diff --git a/Haskell-book/26/MaybeT/src/Identity.hs b/Haskell-book/26/MaybeT/src/Identity.hs
new file mode 100644
index 0000000..8189c18
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/Identity.hs
@@ -0,0 +1,43 @@
+module Identity where
+
+import MonadIO
+import MonadTrans
+
+newtype Identity a =
+ Identity { runIdentity :: a }
+ deriving (Eq, Show)
+
+instance Functor Identity where
+ fmap f (Identity a) = Identity (f a)
+
+instance Applicative Identity where
+ pure = Identity
+ (Identity f) <*> (Identity a) = Identity (f a)
+
+newtype IdentityT f a =
+ IdentityT { runIdentityT :: f a }
+ deriving (Eq, Show)
+
+instance (Functor m)
+ => Functor (IdentityT m) where
+ fmap f (IdentityT fa) = IdentityT (fmap f fa)
+
+instance (Applicative m)
+ => Applicative (IdentityT m) where
+ pure x = IdentityT (pure x)
+
+ (IdentityT fab) <*> (IdentityT fa) =
+ IdentityT (fab <*> fa)
+
+instance (Monad m)
+ => Monad (IdentityT m) where
+ return = pure
+
+ (IdentityT ma) >>= f = IdentityT $ ma >>= runIdentityT . f
+
+instance (MonadIO m)
+ => MonadIO (IdentityT m) where
+ liftIO = IdentityT . liftIO
+
+instance MonadTrans IdentityT where
+ lift = IdentityT
diff --git a/Haskell-book/26/MaybeT/src/Maybe.hs b/Haskell-book/26/MaybeT/src/Maybe.hs
new file mode 100644
index 0000000..4d6c9b7
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/Maybe.hs
@@ -0,0 +1,40 @@
+module Maybe where
+
+import Control.Monad
+import MonadIO
+import MonadTrans
+
+newtype MaybeT m a =
+ MaybeT { runMaybeT :: m (Maybe a) }
+
+-- compare to the instance for MaybeT
+instance (Functor m)
+ => Functor (MaybeT m) where
+ fmap f (MaybeT ma) =
+ MaybeT $ (fmap . fmap) f ma
+
+instance (Applicative m)
+ => Applicative (MaybeT m) where
+ pure x = MaybeT (pure (pure x))
+
+ (MaybeT fab) <*> (MaybeT mma) = MaybeT $ (<*>) <$> fab <*> mma
+
+instance (Monad m)
+ => Monad (MaybeT m) where
+ return = pure
+
+ -- (>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
+ (MaybeT ma) >>= f = MaybeT $ do
+ -- ma :: m (Maybe a)
+ -- v :: Maybe a
+ v <- ma
+ case v of
+ Nothing -> return Nothing
+ Just y -> runMaybeT (f y)
+
+instance MonadTrans MaybeT where
+ lift = MaybeT . liftM Just
+
+instance (MonadIO m)
+ => MonadIO (MaybeT m) where
+ liftIO = lift . liftIO
diff --git a/Haskell-book/26/MaybeT/src/MonadIO.hs b/Haskell-book/26/MaybeT/src/MonadIO.hs
new file mode 100644
index 0000000..93244dd
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/MonadIO.hs
@@ -0,0 +1,5 @@
+module MonadIO where
+
+class (Monad m) => MonadIO m where
+ -- | Lift a computation from the 'IO' monad.
+ liftIO :: IO a -> m a
diff --git a/Haskell-book/26/MaybeT/src/MonadTrans.hs b/Haskell-book/26/MaybeT/src/MonadTrans.hs
new file mode 100644
index 0000000..7954164
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/MonadTrans.hs
@@ -0,0 +1,7 @@
+module MonadTrans where
+
+class MonadTrans t where
+ -- | Lift a computation from
+ -- the argument monad to
+ -- the constructed monad.
+ lift :: (Monad m) => m a -> t m a
diff --git a/Haskell-book/26/MaybeT/src/Reader.hs b/Haskell-book/26/MaybeT/src/Reader.hs
new file mode 100644
index 0000000..38fded9
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/Reader.hs
@@ -0,0 +1,35 @@
+module Reader where
+
+import MonadIO
+import MonadTrans
+
+newtype ReaderT r m a =
+ ReaderT { runReaderT :: r -> m a }
+
+instance (Functor m)
+ => Functor (ReaderT r m) where
+ fmap f (ReaderT rma) =
+ ReaderT $ (fmap . fmap) f rma
+
+instance (Applicative m)
+ => Applicative (ReaderT r m) where
+ pure a = ReaderT (pure (pure a))
+
+ (ReaderT fmab) <*> (ReaderT rma) =
+ ReaderT $ (<*>) <$> fmab <*> rma
+
+instance (Monad m)
+ => Monad (ReaderT r m) where
+ return = pure
+
+ (ReaderT rma) >>= f =
+ ReaderT $ \r -> do
+ a <- rma r
+ runReaderT (f a) r
+
+instance MonadTrans (ReaderT r) where
+ lift = ReaderT . const
+
+instance (MonadIO m)
+ => MonadIO (ReaderT r m) where
+ liftIO = lift . liftIO
diff --git a/Haskell-book/26/MaybeT/src/State.hs b/Haskell-book/26/MaybeT/src/State.hs
new file mode 100644
index 0000000..d30fdd5
--- /dev/null
+++ b/Haskell-book/26/MaybeT/src/State.hs
@@ -0,0 +1,41 @@
+module State where
+
+import MonadIO
+import MonadTrans
+
+newtype StateT s m a =
+ StateT { runStateT :: s -> m (a, s) }
+
+-- 1
+instance (Functor m)
+ => Functor (StateT s m) where
+ fmap f (StateT m) = StateT $ \s -> fmap first $ m s
+ where first = uncurry (\t1 t2 -> ((f t1), t2))
+
+-- 2
+-- Links:
+-- http://stackoverflow.com/questions/18673525/is-it-possible-to-implement-applicative-m-applicative-statet-s-m
+-- https://github.com/NICTA/course/issues/134
+instance (Monad m)
+ => Applicative (StateT s m) where
+ pure x = StateT $ (\s -> pure (x, s))
+ StateT g <*> StateT h = StateT $ \s -> keepFirst <$> g s <*> h s
+ where keepFirst (f, s') (x, _) = (f x, s')
+
+
+-- 3
+instance (Monad m)
+ => Monad (StateT s m) where
+ return = pure
+
+ (StateT sma) >>= f =
+ StateT $ \s -> do
+ a <- sma s
+ runStateT (f $ fst a) s
+
+instance MonadTrans (StateT s) where
+ lift c = StateT $ \s -> c >>= (\x -> return (x, s))
+
+instance (MonadIO m)
+ => MonadIO (StateT s m) where
+ liftIO = lift . liftIO
diff --git a/Haskell-book/26/MaybeT/stack.yaml b/Haskell-book/26/MaybeT/stack.yaml
new file mode 100644
index 0000000..05facc0
--- /dev/null
+++ b/Haskell-book/26/MaybeT/stack.yaml
@@ -0,0 +1,66 @@
+# 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
+# resolver:
+# name: custom-snapshot
+# location: "./custom-snapshot.yaml"
+resolver: lts-11.6
+
+# 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
+# extra-dep: true
+# subdirs:
+# - auto-update
+# - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (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.6"
+#
+# 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
\ No newline at end of file
diff --git a/Haskell-book/26/MaybeT/test/Spec.hs b/Haskell-book/26/MaybeT/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/Haskell-book/26/MaybeT/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/Haskell-book/26/Morra/.gitignore b/Haskell-book/26/Morra/.gitignore
new file mode 100644
index 0000000..552029c
--- /dev/null
+++ b/Haskell-book/26/Morra/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Morra.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/26/Morra/Setup.hs b/Haskell-book/26/Morra/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/26/Morra/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/26/Morra/app/Main.hs b/Haskell-book/26/Morra/app/Main.hs
new file mode 100644
index 0000000..0b0d28a
--- /dev/null
+++ b/Haskell-book/26/Morra/app/Main.hs
@@ -0,0 +1,69 @@
+module Main where
+
+import Control.Monad
+import Control.Monad.Trans.State
+import System.Random
+import System.Console.ANSI (clearScreen)
+
+type Score = StateT (Integer, Integer) IO (Integer, Integer)
+
+yourTurn :: IO (Integer, Integer)
+yourTurn = do
+ putStrLn "Wie viele Finger zeigen Sie?"
+ shown <- liftM read getLine
+
+ putStrLn "Wie viele Finger wird der Gegner zeigen?"
+ guessed <- liftM read getLine
+
+ clearScreen
+
+ return (shown, guessed)
+
+
+aiTurn :: IO (Integer, Integer)
+aiTurn = do
+ gen1 <- getStdGen
+
+ let (shown, gen2) = randomR (1, 5) gen1
+ putStrLn $ "Der Gegner zeigt: " ++ (show shown)
+
+ let (guessed, gen3) = randomR (1, 5) gen2
+ putStrLn $ "Der Gegner hat " ++ (show guessed) ++ " geraten."
+
+ setStdGen gen3
+ return (shown, guessed)
+
+
+score :: IO (Integer, Integer) -> Score
+score partnerTurn = StateT $ \(s1, s2) -> do
+ you <- yourTurn
+ partner <- partnerTurn
+ let sum = (fst you) + (snd partner)
+
+ let yourScore = if (snd you) == sum then 1 else 0
+ let partnerScore = if (snd partner) == sum then 1 else 0
+ return ((yourScore, partnerScore), (s1 + yourScore, s2 + partnerScore))
+
+
+loopGame :: IO (Integer, Integer)
+ -> (Integer, Integer)
+ -> IO (Either (Integer, Integer) (Integer, Integer))
+loopGame partnerTurn currentScore = do
+ (result, s) <- runStateT (score partnerTurn) currentScore
+ putStrLn $ show $ result
+
+ case s of
+ (16, _) -> return $ Left result
+ (_, 16) -> return $ Right result
+ _ -> loopGame partnerTurn s
+
+
+main :: IO ()
+main = do
+ winner <- loopGame aiTurn (0, 0)
+
+ case winner of
+ Left x -> putStrLn $ "You've won! Score: " ++ (show x)
+ Right x -> putStrLn $ "You've lost! Score: " ++ (show x)
+
+ return ()
diff --git a/Haskell-book/26/Morra/package.yaml b/Haskell-book/26/Morra/package.yaml
new file mode 100644
index 0000000..5b313af
--- /dev/null
+++ b/Haskell-book/26/Morra/package.yaml
@@ -0,0 +1,21 @@
+name: Morra
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- random
+- transformers
+- ansi-terminal
+
+executables:
+ morra:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
diff --git a/Haskell-book/26/Morra/stack.yaml b/Haskell-book/26/Morra/stack.yaml
new file mode 100644
index 0000000..8235b57
--- /dev/null
+++ b/Haskell-book/26/Morra/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.9
+
+# 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
\ No newline at end of file
diff --git a/Haskell-book/27/BottomExpression.hs b/Haskell-book/27/BottomExpression.hs
new file mode 100644
index 0000000..0f0d71d
--- /dev/null
+++ b/Haskell-book/27/BottomExpression.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE Strict #-}
+module BottomExpression where
+
+!x = undefined
+y = "blah"
+main = do
+ print $ snd $ seq x (x, y)
diff --git a/Haskell-book/27/StrictList.hs b/Haskell-book/27/StrictList.hs
new file mode 100644
index 0000000..f75bb05
--- /dev/null
+++ b/Haskell-book/27/StrictList.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE Strict #-}
+
+module StrictList where
+
+data List a =
+ Nil
+ | Cons ~a ~(List a)
+ deriving (Show)
+
+take' n _ | n <= 0 = Nil
+take' _ Nil = Nil
+take' n (Cons x xs) = (Cons x (take' (n - 1) xs))
+
+map' _ Nil = Nil
+map' f (Cons x xs) = (Cons (f x) (map' f xs))
+
+repeat' x = xs where xs = (Cons x xs)
+
+main = do
+ print $ take' 10 $ map' (+1) (repeat' 1)
diff --git a/Haskell-book/28/Bench/.gitignore b/Haskell-book/28/Bench/.gitignore
new file mode 100644
index 0000000..84192e8
--- /dev/null
+++ b/Haskell-book/28/Bench/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+Bench.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/28/Bench/Setup.hs b/Haskell-book/28/Bench/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/28/Bench/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/28/Bench/app/Main.hs b/Haskell-book/28/Bench/app/Main.hs
new file mode 100644
index 0000000..c3c602f
--- /dev/null
+++ b/Haskell-book/28/Bench/app/Main.hs
@@ -0,0 +1,46 @@
+module Main where
+
+import Criterion.Main
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+
+genList :: Int -> [(String, Int)]
+genList n = go n []
+ where go 0 xs = ("0", 0) : xs
+ go n' xs = go (n' - 1) ((show n', n') : xs)
+
+pairList :: [(String, Int)]
+pairList = genList 9001
+
+testMap :: M.Map String Int
+testMap = M.fromList pairList
+
+testSet :: S.Set String
+testSet = S.fromList $ fmap fst pairList
+
+slice :: Int -> Int -> [a] -> [a]
+slice from len xs = take len (drop from xs)
+
+boxed :: V.Vector Int
+boxed = V.fromList [1..1000]
+
+unboxed :: U.Vector Int
+unboxed = U.fromList [1..1000]
+
+main :: IO ()
+main = defaultMain
+ [ bench "slicing unboxed vector" $
+ whnf (U.head . U.slice 100 900) unboxed
+ , bench "slicing boxed vector" $
+ whnf (V.head . V.slice 100 900) boxed
+ , bench "lookup one thing, set" $
+ whnf (S.member "doesntExist") testSet
+ , bench "insert one thing, set" $
+ whnf (S.insert "doesntExist" ) S.empty
+ , bench "lookup one thing, map" $
+ whnf (M.lookup "doesntExist") testMap
+ , bench "insert one thing, map" $
+ whnf (M.insert ("doesntExist", 0)) M.empty
+ ]
diff --git a/Haskell-book/28/Bench/package.yaml b/Haskell-book/28/Bench/package.yaml
new file mode 100644
index 0000000..cdf6c5f
--- /dev/null
+++ b/Haskell-book/28/Bench/package.yaml
@@ -0,0 +1,21 @@
+name: Bench
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- containers
+- criterion
+- vector
+
+executables:
+ bench:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
diff --git a/Haskell-book/28/Bench/stack.yaml b/Haskell-book/28/Bench/stack.yaml
new file mode 100644
index 0000000..8235b57
--- /dev/null
+++ b/Haskell-book/28/Bench/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.9
+
+# 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
\ No newline at end of file
diff --git a/Haskell-book/28/DifferenceList/.gitignore b/Haskell-book/28/DifferenceList/.gitignore
new file mode 100644
index 0000000..8543bc3
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+DifferenceList.cabal
+*~
\ No newline at end of file
diff --git a/Haskell-book/28/DifferenceList/Setup.hs b/Haskell-book/28/DifferenceList/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Haskell-book/28/DifferenceList/app/Main.hs b/Haskell-book/28/DifferenceList/app/Main.hs
new file mode 100644
index 0000000..8ece171
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/app/Main.hs
@@ -0,0 +1,46 @@
+module Main where
+
+import Criterion.Main
+import Data.DList
+import qualified Data.Queue as Q
+import qualified Data.Sequence as S
+
+schlemiel :: Int -> [Int]
+schlemiel i = go i []
+ where go 0 xs = xs
+ go n xs = go (n - 1) ([n] ++ xs)
+
+constructDlist :: Int -> [Int]
+constructDlist i = toList $ go i empty
+ where go 0 xs = xs
+ go n xs = go (n - 1) (singleton n `append` xs)
+
+processQueue :: Int -> Q.Queue Int
+processQueue i = clear $ Q.pop $ fill i Q.empty
+ where fill 0 xs = xs
+ fill n xs = fill (n - 1) (Q.push n xs)
+ clear Nothing = Q.empty
+ clear (Just xs) = clear $ Q.pop $ snd xs
+
+processList :: Int -> [Int]
+processList i = go (schlemiel i)
+ where go [] = []
+ go (x:xs) = xs
+
+processSeq :: Int -> S.Seq Int
+processSeq i = go $ S.fromList $ schlemiel i
+ where go xs = if S.null xs then xs else go (S.deleteAt 0 xs)
+
+main :: IO ()
+main = defaultMain
+ [ bench "concat list" $
+ whnf schlemiel 123456
+ , bench "concat dlist" $
+ whnf constructDlist 123456
+ , bench "process queue" $
+ whnf processQueue 12345
+ , bench "process list" $
+ whnf processList 12345
+ , bench "process sequence" $
+ whnf processSeq 12345
+ ]
diff --git a/Haskell-book/28/DifferenceList/package.yaml b/Haskell-book/28/DifferenceList/package.yaml
new file mode 100644
index 0000000..654822a
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/package.yaml
@@ -0,0 +1,37 @@
+name: DifferenceList
+version: 0.1.0.0
+license: BSD3
+author: "Eugen Wissner"
+maintainer: "belka@caraus.de"
+copyright: "2018 Eugen Wissner"
+
+dependencies:
+- base >= 4.7 && < 5
+- containers
+
+library:
+ source-dirs: src
+
+tests:
+ DifferenceList-test:
+ main: Spec.hs
+ source-dirs: test
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - DifferenceList
+ - hspec
+
+executables:
+ benchmark:
+ main: Main.hs
+ source-dirs: app
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ dependencies:
+ - DifferenceList
+ - criterion
diff --git a/Haskell-book/28/DifferenceList/src/Data/DList.hs b/Haskell-book/28/DifferenceList/src/Data/DList.hs
new file mode 100644
index 0000000..12d3a53
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/src/Data/DList.hs
@@ -0,0 +1,40 @@
+module Data.DList
+ ( DList(..)
+ , empty
+ , singleton
+ , toList
+ , cons
+ , snoc
+ , append
+ ) where
+
+newtype DList a = DL { unDL :: [a] -> [a] }
+
+empty :: DList a
+empty = DL ([] ++)
+{-# INLINE empty #-}
+
+singleton :: a -> DList a
+singleton x = DL ([x] ++)
+{-# INLINE singleton #-}
+
+toList :: DList a -> [a]
+toList xsf = unDL xsf []
+{-# INLINE toList #-}
+
+-- Prepend a single element to a dlist.
+infixr `cons`
+cons :: a -> DList a -> DList a
+cons x xs = DL ((x:) . unDL xs)
+{-# INLINE cons #-}
+
+-- Append a single element to a dlist.
+infixl `snoc`
+snoc :: DList a -> a -> DList a
+snoc xs x = append xs $ singleton x
+{-# INLINE snoc #-}
+
+-- Append dlists.
+append :: DList a -> DList a -> DList a
+append xsf ysf = DL $ (unDL xsf) . (unDL ysf)
+{-# INLINE append #-}
diff --git a/Haskell-book/28/DifferenceList/src/Data/Queue.hs b/Haskell-book/28/DifferenceList/src/Data/Queue.hs
new file mode 100644
index 0000000..68d1e1f
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/src/Data/Queue.hs
@@ -0,0 +1,44 @@
+module Data.Queue
+ ( Queue(..)
+ , empty
+ , isEmpty
+ , push
+ , pop
+ ) where
+
+-- From Okasaki's Purely Functional Data Structures
+data Queue a =
+ Queue { enqueue :: [a]
+ , dequeue :: [a]
+ } deriving (Eq, Show)
+
+isEmpty :: Queue a -> Bool
+isEmpty xs = length (enqueue xs) == 0
+ && length (dequeue xs) == 0
+
+empty :: Queue a
+empty = Queue [] []
+
+-- adds an item
+push :: a -> Queue a -> Queue a
+push x xs = Queue { enqueue = x : (enqueue xs)
+ , dequeue = dequeue xs }
+
+pop :: Queue a -> Maybe (a, Queue a)
+pop xs = popFromLists (enqueue xs) (dequeue xs)
+ where popFromLists [] [] = Nothing
+ popFromLists en (d:de) = Just (d, Queue en de)
+ popFromLists en [] = popFromLists [] (reverse en)
+
+-- We’re going to give you less code this time, but your task is to
+-- implement the above and write a benchmark comparing it against
+-- performing alternating pushes and pops from a queue based on a
+-- single list. Alternating so that you can’t take advantage of reversing
+-- the list after a long series of pushes in order to perform a long series
+-- of pops efficiently.
+--
+-- Don’t forget to handle the case where the dequeue is empty and
+-- you need to shift items from the enqueue to the dequeue. You need
+-- to do so without violating “first come, first served”.
+-- Lastly, benchmark it against Sequence. Come up with a variety of
+-- tests. Add additional operations for your Queue type if you want.
diff --git a/Haskell-book/28/DifferenceList/stack.yaml b/Haskell-book/28/DifferenceList/stack.yaml
new file mode 100644
index 0000000..27a701e
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/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.10
+
+# 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
\ No newline at end of file
diff --git a/Haskell-book/28/DifferenceList/test/Spec.hs b/Haskell-book/28/DifferenceList/test/Spec.hs
new file mode 100644
index 0000000..84d9376
--- /dev/null
+++ b/Haskell-book/28/DifferenceList/test/Spec.hs
@@ -0,0 +1,33 @@
+module Main where
+
+import Test.Hspec
+import Data.Queue
+
+main :: IO ()
+main = hspec $ do
+ describe "empty" $ do
+ it "returns an empty queue" $ do
+ (empty :: Queue Int) `shouldBe` (Queue [] [])
+
+ describe "push" $ do
+ it "puts an element into an empty queue" $ do
+ (push 5 empty) `shouldBe` (Queue [5] [])
+
+ describe "pop" $ do
+ it "takes the only element from the queue" $ do
+ (pop (Queue [5] [])) `shouldBe` (Just (5, Queue [] []))
+ it "returns nothing if the queue is empty" $ do
+ (pop ((Queue [] [])::Queue Int)) `shouldBe` Nothing
+ it "takes elements in the FIFO order" $ do
+ let queue = push 3 (push 5 empty)
+ in pop queue `shouldBe` Just (5, Queue [] [3])
+
+ describe "isEmpty" $ do
+ it "tells when the queue is empty" $ do
+ (isEmpty (empty :: Queue Int)) `shouldBe` True
+ it "tells when the enqueue part isn't empty" $ do
+ let queue = push 3 empty
+ in isEmpty queue `shouldBe` False
+ it "tells when the dequeue part isn't empty" $ do
+ let queue = fmap snd (pop $ push 3 (push 5 empty))
+ in fmap isEmpty queue `shouldBe` Just False
diff --git a/README.md b/README.md
index 2af94b1..73161bb 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,12 @@
+This repository contains solutions to excercises I have done
+working on some computer books.
+
+This README lists only the books and courses. Book subdirectory
+may contain an additional README.
+
## pharo-mooc
-This repository contains some excercises and projects from
-"[The Pharo Mooc](https://mooc.pharo.org/)".
+[The Pharo Mooc](https://mooc.pharo.org/).
## Java-Kompendium. Professionell Java programmieren lernen