Add remaining haskell book exercises

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)

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

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

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

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)

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

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.

Haskell-book/14/addition/README.md

@@ -0,0 +1 @@
+# addition

Haskell-book/14/addition/Setup.hs

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

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

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

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

Haskell-book/14/morse/.gitignore

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

Haskell-book/14/morse/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for morse
+
+## Unreleased changes

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.

Haskell-book/14/morse/README.md

@@ -0,0 +1 @@
+# morse

Haskell-book/14/morse/Setup.hs

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

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

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

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)

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

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

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

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"

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

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

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')]

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

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)

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

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."
+            ]

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

Haskell-book/15/optional/.gitignore

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

Haskell-book/15/optional/Setup.hs

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

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)

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

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)

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

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})

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'

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'

Haskell-book/15/semigroup/.gitignore

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

Haskell-book/15/semigroup/Setup.hs

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

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

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

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

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"

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"

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

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)

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) ]

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 = (<>)

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

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) ]

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

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)

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)

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

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

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

Haskell-book/16/func/.gitignore

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

Haskell-book/16/func/Setup.hs

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

Haskell-book/16/func/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

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

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

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

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)

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))

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

Haskell-book/17/Exercises/.gitignore

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

Haskell-book/17/Exercises/Setup.hs

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

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

@@ -0,0 +1,6 @@
+module Main where
+
+import Exercises
+
+main :: IO ()
+main = return ()

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

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

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

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))

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]

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

Haskell-book/17/ListApplicative/.gitignore

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

Haskell-book/17/ListApplicative/Setup.hs

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

Haskell-book/17/ListApplicative/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import List
+
+main :: IO ()
+main = return ()

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

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

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

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

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

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))

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

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

Haskell-book/18/Instance/.gitignore

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

Haskell-book/18/Instance/Setup.hs

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

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

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

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

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

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

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

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

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)

Haskell-book/19/shawty/.gitignore

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