Add remaining haskell book exercises
This commit is contained in:
3
Haskell-book/15/optional/.gitignore
vendored
Normal file
3
Haskell-book/15/optional/.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
.stack-work/
|
||||
optional.cabal
|
||||
*~
|
||||
2
Haskell-book/15/optional/Setup.hs
Normal file
2
Haskell-book/15/optional/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
48
Haskell-book/15/optional/app/First.hs
Normal file
48
Haskell-book/15/optional/app/First.hs
Normal file
@@ -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)
|
||||
35
Haskell-book/15/optional/package.yaml
Normal file
35
Haskell-book/15/optional/package.yaml
Normal file
@@ -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
|
||||
12
Haskell-book/15/optional/src/Optional.hs
Normal file
12
Haskell-book/15/optional/src/Optional.hs
Normal file
@@ -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)
|
||||
66
Haskell-book/15/optional/stack.yaml
Normal file
66
Haskell-book/15/optional/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.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
|
||||
21
Haskell-book/15/optional/test/Spec.hs
Normal file
21
Haskell-book/15/optional/test/Spec.hs
Normal file
@@ -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})
|
||||
Reference in New Issue
Block a user