Add remaining haskell book exercises
This commit is contained in:
35
Haskell-book/14/addition/Addition.hs
Normal file
35
Haskell-book/14/addition/Addition.hs
Normal file
@@ -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
|
||||
30
Haskell-book/14/addition/LICENSE
Normal file
30
Haskell-book/14/addition/LICENSE
Normal file
@@ -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.
|
||||
1
Haskell-book/14/addition/README.md
Normal file
1
Haskell-book/14/addition/README.md
Normal file
@@ -0,0 +1 @@
|
||||
# addition
|
||||
2
Haskell-book/14/addition/Setup.hs
Normal file
2
Haskell-book/14/addition/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
17
Haskell-book/14/addition/addition.cabal
Normal file
17
Haskell-book/14/addition/addition.cabal
Normal file
@@ -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
|
||||
66
Haskell-book/14/addition/stack.yaml
Normal file
66
Haskell-book/14/addition/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-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
|
||||
12
Haskell-book/14/addition/stack.yaml.lock
Normal file
12
Haskell-book/14/addition/stack.yaml.lock
Normal file
@@ -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
|
||||
3
Haskell-book/14/morse/.gitignore
vendored
Normal file
3
Haskell-book/14/morse/.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
.stack-work/
|
||||
morse.cabal
|
||||
*~
|
||||
3
Haskell-book/14/morse/ChangeLog.md
Normal file
3
Haskell-book/14/morse/ChangeLog.md
Normal file
@@ -0,0 +1,3 @@
|
||||
# Changelog for morse
|
||||
|
||||
## Unreleased changes
|
||||
30
Haskell-book/14/morse/LICENSE
Normal file
30
Haskell-book/14/morse/LICENSE
Normal file
@@ -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.
|
||||
1
Haskell-book/14/morse/README.md
Normal file
1
Haskell-book/14/morse/README.md
Normal file
@@ -0,0 +1 @@
|
||||
# morse
|
||||
2
Haskell-book/14/morse/Setup.hs
Normal file
2
Haskell-book/14/morse/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
59
Haskell-book/14/morse/src/Main.hs
Normal file
59
Haskell-book/14/morse/src/Main.hs
Normal file
@@ -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
|
||||
68
Haskell-book/14/morse/src/Morse.hs
Normal file
68
Haskell-book/14/morse/src/Morse.hs
Normal file
@@ -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
|
||||
26
Haskell-book/14/morse/src/WordNumber.hs
Normal file
26
Haskell-book/14/morse/src/WordNumber.hs
Normal file
@@ -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)
|
||||
66
Haskell-book/14/morse/stack.yaml
Normal file
66
Haskell-book/14/morse/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-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
|
||||
12
Haskell-book/14/morse/stack.yaml.lock
Normal file
12
Haskell-book/14/morse/stack.yaml.lock
Normal file
@@ -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
|
||||
16
Haskell-book/14/morse/tests/CoArbitrary.hs
Normal file
16
Haskell-book/14/morse/tests/CoArbitrary.hs
Normal file
@@ -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
|
||||
24
Haskell-book/14/morse/tests/WordNumberTest.hs
Normal file
24
Haskell-book/14/morse/tests/WordNumberTest.hs
Normal file
@@ -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"
|
||||
86
Haskell-book/14/morse/tests/tests.hs
Normal file
86
Haskell-book/14/morse/tests/tests.hs
Normal file
@@ -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
|
||||
32
Haskell-book/14/qc/qc.cabal
Normal file
32
Haskell-book/14/qc/qc.cabal
Normal file
@@ -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
|
||||
58
Haskell-book/14/qc/src/UsingQuickCheck.hs
Normal file
58
Haskell-book/14/qc/src/UsingQuickCheck.hs
Normal file
@@ -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')]
|
||||
66
Haskell-book/14/qc/stack.yaml
Normal file
66
Haskell-book/14/qc/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-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
|
||||
30
Haskell-book/14/qc/tests/Idempotence.hs
Normal file
30
Haskell-book/14/qc/tests/Idempotence.hs
Normal file
@@ -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)
|
||||
128
Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
Normal file
128
Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user