Add remaining haskell book exercises

This commit is contained in:
2025-12-11 10:28:11 +01:00
parent 3624c712d7
commit 98329e0a3d
221 changed files with 8033 additions and 2 deletions

3
Haskell-book/16/func/.gitignore vendored Normal file
View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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