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/14 | |
| parent | 3624c712d72d246f21d4e710cec7c11e052e0326 (diff) | |
| download | book-exercises-98329e0a3dd4f78b5d815ac3896272ec70904901.tar.gz | |
Add remaining haskell book exercises
Diffstat (limited to 'Haskell-book/14')
25 files changed, 873 insertions, 0 deletions
diff --git a/Haskell-book/14/addition/Addition.hs b/Haskell-book/14/addition/Addition.hs new file mode 100644 index 0000000..474eecd --- /dev/null +++ b/Haskell-book/14/addition/Addition.hs @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/addition/LICENSE b/Haskell-book/14/addition/LICENSE new file mode 100644 index 0000000..6a042c2 --- /dev/null +++ b/Haskell-book/14/addition/LICENSE @@ -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.
\ No newline at end of file diff --git a/Haskell-book/14/addition/README.md b/Haskell-book/14/addition/README.md new file mode 100644 index 0000000..543097e --- /dev/null +++ b/Haskell-book/14/addition/README.md @@ -0,0 +1 @@ +# addition diff --git a/Haskell-book/14/addition/Setup.hs b/Haskell-book/14/addition/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/14/addition/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/14/addition/addition.cabal b/Haskell-book/14/addition/addition.cabal new file mode 100644 index 0000000..1dec256 --- /dev/null +++ b/Haskell-book/14/addition/addition.cabal @@ -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 diff --git a/Haskell-book/14/addition/stack.yaml b/Haskell-book/14/addition/stack.yaml new file mode 100644 index 0000000..9e311c2 --- /dev/null +++ b/Haskell-book/14/addition/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-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
\ No newline at end of file diff --git a/Haskell-book/14/addition/stack.yaml.lock b/Haskell-book/14/addition/stack.yaml.lock new file mode 100644 index 0000000..75bf3ab --- /dev/null +++ b/Haskell-book/14/addition/stack.yaml.lock @@ -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 diff --git a/Haskell-book/14/morse/.gitignore b/Haskell-book/14/morse/.gitignore new file mode 100644 index 0000000..cf4a5cf --- /dev/null +++ b/Haskell-book/14/morse/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +morse.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/14/morse/ChangeLog.md b/Haskell-book/14/morse/ChangeLog.md new file mode 100644 index 0000000..1ae7856 --- /dev/null +++ b/Haskell-book/14/morse/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for morse + +## Unreleased changes diff --git a/Haskell-book/14/morse/LICENSE b/Haskell-book/14/morse/LICENSE new file mode 100644 index 0000000..da7b69b --- /dev/null +++ b/Haskell-book/14/morse/LICENSE @@ -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. diff --git a/Haskell-book/14/morse/README.md b/Haskell-book/14/morse/README.md new file mode 100644 index 0000000..8b8c638 --- /dev/null +++ b/Haskell-book/14/morse/README.md @@ -0,0 +1 @@ +# morse diff --git a/Haskell-book/14/morse/Setup.hs b/Haskell-book/14/morse/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/14/morse/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/14/morse/src/Main.hs b/Haskell-book/14/morse/src/Main.hs new file mode 100644 index 0000000..1f73b90 --- /dev/null +++ b/Haskell-book/14/morse/src/Main.hs @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/morse/src/Morse.hs b/Haskell-book/14/morse/src/Morse.hs new file mode 100644 index 0000000..03193e5 --- /dev/null +++ b/Haskell-book/14/morse/src/Morse.hs @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/morse/src/WordNumber.hs b/Haskell-book/14/morse/src/WordNumber.hs new file mode 100644 index 0000000..5b25ee2 --- /dev/null +++ b/Haskell-book/14/morse/src/WordNumber.hs @@ -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)
\ No newline at end of file diff --git a/Haskell-book/14/morse/stack.yaml b/Haskell-book/14/morse/stack.yaml new file mode 100644 index 0000000..22e3463 --- /dev/null +++ b/Haskell-book/14/morse/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-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
\ No newline at end of file diff --git a/Haskell-book/14/morse/stack.yaml.lock b/Haskell-book/14/morse/stack.yaml.lock new file mode 100644 index 0000000..6ee2e72 --- /dev/null +++ b/Haskell-book/14/morse/stack.yaml.lock @@ -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 diff --git a/Haskell-book/14/morse/tests/CoArbitrary.hs b/Haskell-book/14/morse/tests/CoArbitrary.hs new file mode 100644 index 0000000..dc0da3d --- /dev/null +++ b/Haskell-book/14/morse/tests/CoArbitrary.hs @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/morse/tests/WordNumberTest.hs b/Haskell-book/14/morse/tests/WordNumberTest.hs new file mode 100644 index 0000000..d9623a9 --- /dev/null +++ b/Haskell-book/14/morse/tests/WordNumberTest.hs @@ -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"
\ No newline at end of file diff --git a/Haskell-book/14/morse/tests/tests.hs b/Haskell-book/14/morse/tests/tests.hs new file mode 100644 index 0000000..b27d3b3 --- /dev/null +++ b/Haskell-book/14/morse/tests/tests.hs @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/qc/qc.cabal b/Haskell-book/14/qc/qc.cabal new file mode 100644 index 0000000..f0b5b3a --- /dev/null +++ b/Haskell-book/14/qc/qc.cabal @@ -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
\ No newline at end of file diff --git a/Haskell-book/14/qc/src/UsingQuickCheck.hs b/Haskell-book/14/qc/src/UsingQuickCheck.hs new file mode 100644 index 0000000..f0fa27f --- /dev/null +++ b/Haskell-book/14/qc/src/UsingQuickCheck.hs @@ -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')]
\ No newline at end of file diff --git a/Haskell-book/14/qc/stack.yaml b/Haskell-book/14/qc/stack.yaml new file mode 100644 index 0000000..22e3463 --- /dev/null +++ b/Haskell-book/14/qc/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-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
\ No newline at end of file diff --git a/Haskell-book/14/qc/tests/Idempotence.hs b/Haskell-book/14/qc/tests/Idempotence.hs new file mode 100644 index 0000000..4b484d0 --- /dev/null +++ b/Haskell-book/14/qc/tests/Idempotence.hs @@ -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)
\ No newline at end of file diff --git a/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs new file mode 100644 index 0000000..da5ddb5 --- /dev/null +++ b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs @@ -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
\ No newline at end of file |
