Add remaining haskell book exercises
This commit is contained in:
3
Haskell-book/16/func/.gitignore
vendored
Normal file
3
Haskell-book/16/func/.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
.stack-work/
|
||||
func.cabal
|
||||
*~
|
||||
2
Haskell-book/16/func/Setup.hs
Normal file
2
Haskell-book/16/func/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
6
Haskell-book/16/func/app/Main.hs
Normal file
6
Haskell-book/16/func/app/Main.hs
Normal file
@@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = someFunc
|
||||
34
Haskell-book/16/func/package.yaml
Normal file
34
Haskell-book/16/func/package.yaml
Normal 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
|
||||
89
Haskell-book/16/func/src/Func.hs
Normal file
89
Haskell-book/16/func/src/Func.hs
Normal 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
|
||||
66
Haskell-book/16/func/stack.yaml
Normal file
66
Haskell-book/16/func/stack.yaml
Normal 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
|
||||
54
Haskell-book/16/func/test/Spec.hs
Normal file
54
Haskell-book/16/func/test/Spec.hs
Normal 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)
|
||||
Reference in New Issue
Block a user