diff options
| author | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
| commit | 98329e0a3dd4f78b5d815ac3896272ec70904901 (patch) | |
| tree | 80f9c56cfe2ac20232358f236d32e84bd683be1b /Haskell-book/17 | |
| parent | 3624c712d72d246f21d4e710cec7c11e052e0326 (diff) | |
| download | book-exercises-98329e0a3dd4f78b5d815ac3896272ec70904901.tar.gz | |
Add remaining haskell book exercises
Diffstat (limited to 'Haskell-book/17')
20 files changed, 543 insertions, 0 deletions
diff --git a/Haskell-book/17/Combinations.hs b/Haskell-book/17/Combinations.hs new file mode 100644 index 0000000..9e13e1e --- /dev/null +++ b/Haskell-book/17/Combinations.hs @@ -0,0 +1,12 @@ +module Combinations where + +import Control.Applicative (liftA3) + +stops :: String +stops = "pbtdkg" + +vowels :: String +vowels = "aeiou" + +combos :: [a] -> [b] -> [c] -> [(a, b, c)] +combos = liftA3 (\x y z -> (x, y, z)) diff --git a/Haskell-book/17/Constant.hs b/Haskell-book/17/Constant.hs new file mode 100644 index 0000000..f25da54 --- /dev/null +++ b/Haskell-book/17/Constant.hs @@ -0,0 +1,13 @@ +module Constant where + +newtype Constant a b = + Constant { getConstant :: a } + deriving (Eq, Ord, Show) + +instance Functor (Constant a) where + fmap _ (Constant x) = Constant x + +instance Monoid a + => Applicative (Constant a) where + pure x = Constant mempty + (Constant x) <*> (Constant y) = Constant $ mappend x y diff --git a/Haskell-book/17/Exercises/.gitignore b/Haskell-book/17/Exercises/.gitignore new file mode 100644 index 0000000..3834f98 --- /dev/null +++ b/Haskell-book/17/Exercises/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +Exercises.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/17/Exercises/Setup.hs b/Haskell-book/17/Exercises/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/17/Exercises/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/17/Exercises/app/Main.hs b/Haskell-book/17/Exercises/app/Main.hs new file mode 100644 index 0000000..43979f0 --- /dev/null +++ b/Haskell-book/17/Exercises/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Exercises + +main :: IO () +main = return () diff --git a/Haskell-book/17/Exercises/package.yaml b/Haskell-book/17/Exercises/package.yaml new file mode 100644 index 0000000..f7e3630 --- /dev/null +++ b/Haskell-book/17/Exercises/package.yaml @@ -0,0 +1,35 @@ +name: Exercises +version: 0.1.0.0 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- QuickCheck +- checkers + +library: + source-dirs: src + +executables: + Exercises-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - Exercises + +tests: + Exercises-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - Exercises diff --git a/Haskell-book/17/Exercises/src/Exercises.hs b/Haskell-book/17/Exercises/src/Exercises.hs new file mode 100644 index 0000000..1ea70e3 --- /dev/null +++ b/Haskell-book/17/Exercises/src/Exercises.hs @@ -0,0 +1,124 @@ +module Exercises where + +import Test.QuickCheck +import Test.QuickCheck.Checkers + +--- 1 +data Pair a = Pair a a deriving (Show, Eq) + +instance Functor Pair where + fmap f (Pair x y) = Pair (f x) (f y) + +instance Applicative Pair where + pure f = Pair f f + (Pair f f') <*> (Pair x y) = Pair (f x) (f' y) + +instance Arbitrary a => Arbitrary (Pair a) where + arbitrary = do + x <- arbitrary + y <- arbitrary + return $ Pair x y + +instance Eq a => EqProp (Pair a) where + (=-=) = eq + +--- 2 +data Two a b = Two a b deriving (Show, Eq) + +instance Functor (Two a) where + fmap f (Two x y) = Two x (f y) + +instance Monoid a => Applicative (Two a) where + pure x = Two mempty $ x + (Two f f') <*> (Two x y) = Two (mappend f x) (f' y) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + return $ Two x y + +instance (Eq a, Eq b) => EqProp (Two a b) where + (=-=) = eq + +--- 3 +data Three a b c = Three a b c deriving (Show, Eq) + +instance Functor (Three a b) where + fmap f (Three x y z) = Three x y (f z) + +instance (Monoid a, Monoid b) => Applicative (Three a b) where + pure x = Three mempty mempty x + (Three f f' f'') <*> (Three x y z) = Three (mappend f x) (mappend f' y) (f'' z) + +instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + return $ Three x y z + +instance (Eq a, Eq b, Eq c) => EqProp (Three a b c) where + (=-=) = eq + +--- 4 +data Three' a b = Three' a b b deriving (Show, Eq) + +instance Functor (Three' a) where + fmap f (Three' x y z) = Three' x (f y) (f z) + +instance (Monoid a) => Applicative (Three' a) where + pure x = Three' mempty x x + (Three' f f' f'') <*> (Three' x y z) = Three' (mappend f x) (f' y) (f'' z) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + return $ Three' x y z + +instance (Eq a, Eq b) => EqProp (Three' a b) where + (=-=) = eq + +--- 5 +data Four a b c d = Four a b c d deriving (Show, Eq) + +instance Functor (Four a b c) where + fmap f (Four x y z t) = Four x y z (f t) + +instance (Monoid a, Monoid b, Monoid c) => Applicative (Four a b c) where + pure x = Four mempty mempty mempty x + (Four f f' f'' f''') <*> (Four x y z t) = Four (mappend f x) (mappend f' y) (mappend f'' z) (f''' t) + +instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Four a b c d) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + t <- arbitrary + return $ Four x y z t + +instance (Eq a, Eq b, Eq c, Eq d) => EqProp (Four a b c d) where + (=-=) = eq + +--- 5 +data Four' a b = Four' a a a b deriving (Show, Eq) + +instance Functor (Four' a) where + fmap f (Four' x y z t) = Four' x y z (f t) + +instance (Monoid a) => Applicative (Four' a) where + pure x = Four' mempty mempty mempty x + (Four' f f' f'' f''') <*> (Four' x y z t) = Four' (mappend f x) (mappend f' y) (mappend f'' z) (f''' t) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where + arbitrary = do + x <- arbitrary + y <- arbitrary + z <- arbitrary + t <- arbitrary + return $ Four' x y z t + +instance (Eq a, Eq b) => EqProp (Four' a b) where + (=-=) = eq diff --git a/Haskell-book/17/Exercises/stack.yaml b/Haskell-book/17/Exercises/stack.yaml new file mode 100644 index 0000000..005cfcf --- /dev/null +++ b/Haskell-book/17/Exercises/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-10.3 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.6" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/17/Exercises/test/Spec.hs b/Haskell-book/17/Exercises/test/Spec.hs new file mode 100644 index 0000000..e1405c5 --- /dev/null +++ b/Haskell-book/17/Exercises/test/Spec.hs @@ -0,0 +1,26 @@ +import Data.Monoid +import Exercises +import Test.QuickCheck.Checkers +import Test.QuickCheck.Classes + +main :: IO () +main = do + quickBatch $ functor $ Pair ('a', 'b', 'c') ('d', 'e', 'f') + quickBatch $ applicative $ Pair ('a', 'b', 'c') ('d', 'e', 'f') + quickBatch $ functor $ Two ('a', 'b', 'c') (1 :: Integer, 2 :: Integer, 3 :: Integer) + quickBatch $ applicative $ Two (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) + quickBatch $ applicative $ Three (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) + (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer)) + quickBatch $ applicative $ Three' (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) + (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer)) + quickBatch $ applicative $ Four (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) + (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer)) + quickBatch $ applicative $ Four (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Product (1 :: Integer), Product (2 :: Integer), Product (3 :: Integer)) + (Sum (4 :: Integer), Sum (5 :: Integer), Sum (6 :: Integer)) diff --git a/Haskell-book/17/FixerUpper.hs b/Haskell-book/17/FixerUpper.hs new file mode 100644 index 0000000..b09877f --- /dev/null +++ b/Haskell-book/17/FixerUpper.hs @@ -0,0 +1,6 @@ +module FixerUpper where + +a = const <$> Just <$> "Hello" <*> "World" + +b = (,,,) <$> Just 90 + <*> Just 10 <*> Just "Tierness" <*> pure [1, 2, 3] diff --git a/Haskell-book/17/Identity.hs b/Haskell-book/17/Identity.hs new file mode 100644 index 0000000..6b5f9a9 --- /dev/null +++ b/Haskell-book/17/Identity.hs @@ -0,0 +1,9 @@ +newtype Identity a = Identity a + deriving (Eq, Show, Ord) + +instance Functor Identity where + fmap f (Identity x) = Identity $ f x + +instance Applicative Identity where + pure x = Identity x + (Identity f) <*> (Identity y) = Identity $ f y diff --git a/Haskell-book/17/ListApplicative/.gitignore b/Haskell-book/17/ListApplicative/.gitignore new file mode 100644 index 0000000..296aa3a --- /dev/null +++ b/Haskell-book/17/ListApplicative/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +ListApplicative.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/17/ListApplicative/Setup.hs b/Haskell-book/17/ListApplicative/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/17/ListApplicative/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/17/ListApplicative/app/Main.hs b/Haskell-book/17/ListApplicative/app/Main.hs new file mode 100644 index 0000000..66f0611 --- /dev/null +++ b/Haskell-book/17/ListApplicative/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import List + +main :: IO () +main = return () diff --git a/Haskell-book/17/ListApplicative/package.yaml b/Haskell-book/17/ListApplicative/package.yaml new file mode 100644 index 0000000..5cfefdf --- /dev/null +++ b/Haskell-book/17/ListApplicative/package.yaml @@ -0,0 +1,35 @@ +name: ListApplicative +version: 0.1.0.0 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- QuickCheck +- checkers + +library: + source-dirs: src + +executables: + ListApplicative-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - ListApplicative + +tests: + ListApplicative-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - ListApplicative diff --git a/Haskell-book/17/ListApplicative/src/List.hs b/Haskell-book/17/ListApplicative/src/List.hs new file mode 100644 index 0000000..92cf8b9 --- /dev/null +++ b/Haskell-book/17/ListApplicative/src/List.hs @@ -0,0 +1,46 @@ +module List where + +import Test.QuickCheck +import Test.QuickCheck.Checkers + +data List a = + Nil + | Cons a (List a) + deriving (Eq, Show) + +instance Functor List where + fmap _ Nil = Nil + fmap f (Cons x y) = Cons (f x) (fmap f y) + +instance Applicative List where + pure f = Cons f Nil + Nil <*> _ = Nil + _ <*> Nil = Nil + f <*> x = flatMap (\f' -> fmap f' x) f + +append :: List a -> List a -> List a +append Nil ys = ys +append (Cons x xs) ys = Cons x $ xs `append` ys + +fold :: (a -> b -> b) -> b -> List a -> b +fold _ b Nil = b +fold f b (Cons h t) = f h (fold f b t) + +concat' :: List (List a) -> List a +concat' = fold append Nil + +flatMap :: (a -> List b) -> List a -> List b +flatMap f as = concat' $ fmap f as + +append' :: List a -> a -> List a +append' acc x = Cons x acc + +fromList :: [a] -> List a +fromList xs = foldl (\l a -> Cons a l) Nil xs + +instance Arbitrary a => Arbitrary (List a) where + arbitrary = frequency [(1, pure Nil), + (5, Cons <$> arbitrary <*> arbitrary)] + +instance Eq a => EqProp (List a) where + (=-=) = eq diff --git a/Haskell-book/17/ListApplicative/src/Validation.hs b/Haskell-book/17/ListApplicative/src/Validation.hs new file mode 100644 index 0000000..5ee3e9b --- /dev/null +++ b/Haskell-book/17/ListApplicative/src/Validation.hs @@ -0,0 +1,27 @@ +module Validation where + +import Test.QuickCheck (Arbitrary(..), frequency) +import Test.QuickCheck.Checkers + +data Validation e a = + Failure e + | Success a + deriving (Eq, Show) + +instance Functor (Validation e) where + fmap f (Success x) = Success $ f x + fmap f (Failure x) = Failure x + +instance Monoid e => Applicative (Validation e) where + pure = Success + (Failure x) <*> (Success _) = Failure x + (Success _) <*> (Failure x) = Failure x + (Failure f) <*> (Failure y) = Failure $ mappend f y + (Success f) <*> (Success y) = Success $ f y + +instance (Arbitrary a, Arbitrary e) => Arbitrary (Validation e a) where + arbitrary = frequency [(1, Failure <$> arbitrary), + (5, Success <$> arbitrary)] + +instance (Eq a, Eq e) => EqProp (Validation e a) where + (=-=) = eq diff --git a/Haskell-book/17/ListApplicative/src/ZipList.hs b/Haskell-book/17/ListApplicative/src/ZipList.hs new file mode 100644 index 0000000..e36ec33 --- /dev/null +++ b/Haskell-book/17/ListApplicative/src/ZipList.hs @@ -0,0 +1,40 @@ +module ZipList where + +import Control.Applicative +import List +import Test.QuickCheck +import Test.QuickCheck.Checkers + +take' :: Int -> List a -> List a +take' _ Nil = Nil +take' 0 _ = Nil +take' n (Cons x xs) = Cons x $ take' (n - 1) xs + +newtype ZipList' a = + ZipList' (List a) + deriving (Eq, Show) + +instance Eq a => EqProp (ZipList' a) where + xs =-= ys = xs' `eq` ys' + where xs' = let (ZipList' l) = xs + in take' 3000 l + ys' = let (ZipList' l) = ys + in take' 3000 l + +instance Functor ZipList' where + fmap f (ZipList' xs) = ZipList' $ fmap f xs + +instance Monoid a => Monoid (ZipList' a) where + mempty = pure mempty + mappend = liftA2 mappend + +instance Applicative ZipList' where + pure f = ZipList' $ repeat + where repeat = Cons f repeat + (ZipList' fs) <*> (ZipList' xs) = ZipList' $ applicative fs xs + where applicative Nil _ = Nil + applicative _ Nil = Nil + applicative (Cons f fs) (Cons x xs) = Cons (f x) $ applicative fs xs + +instance Arbitrary a => Arbitrary (ZipList' a) where + arbitrary = ZipList' <$> arbitrary diff --git a/Haskell-book/17/ListApplicative/stack.yaml b/Haskell-book/17/ListApplicative/stack.yaml new file mode 100644 index 0000000..005cfcf --- /dev/null +++ b/Haskell-book/17/ListApplicative/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-10.3 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.6" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/17/ListApplicative/test/Spec.hs b/Haskell-book/17/ListApplicative/test/Spec.hs new file mode 100644 index 0000000..ecd8148 --- /dev/null +++ b/Haskell-book/17/ListApplicative/test/Spec.hs @@ -0,0 +1,16 @@ +module Main where + +import Control.Applicative +import Data.Monoid +import Test.QuickCheck.Checkers +import Test.QuickCheck.Classes +import List +import ZipList +import Validation (Validation(..)) + +main :: IO () +main = do + quickBatch $ applicative (Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil) + quickBatch $ monoid (ZipList' $ Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil) + quickBatch $ applicative (ZipList' $ Cons (Sum (1 :: Integer), Sum (2 :: Integer), Sum (3 :: Integer)) Nil) + quickBatch $ applicative ((Success (Sum 1, Sum 2, Sum 3)) :: Validation String (Sum Integer, Sum Integer, Sum Integer)) |
