├── .circleci └── config.yml ├── .ghci ├── .gitignore ├── .gitlab-ci.yml ├── .travis.yml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── benchmark ├── BasicLibraries │ └── ChapterExercises │ │ ├── DifferenceListBenchmark.hs │ │ └── QueueBenchmark.hs └── Main.hs ├── package.yaml ├── src ├── AlgebraicDataTypes │ ├── BinaryTree │ │ ├── ConvertBinaryTreesToLists.hs │ │ ├── WriteFoldrForBinaryTree.hs │ │ └── WriteMapForBinaryTree.hs │ ├── ChapterExercises │ │ ├── AsPatterns.hs │ │ ├── Ciphers.hs │ │ ├── HuttonRazor.hs │ │ ├── LanguageExercises.hs │ │ ├── MultipleChoice.md │ │ └── PhoneExercise.hs │ ├── ConstructingAndDeconstructingValues │ │ └── Exercise.hs │ ├── DataConstructorsAndValues │ │ └── IntermissionExercises.md │ ├── FunctionTypeIsExponential │ │ └── IntermissionExercises.md │ ├── NormalForm │ │ └── Exercises.md │ ├── ProductTypes │ │ └── JamminExercises.hs │ ├── SumTypes │ │ └── IntermissionExercises.md │ ├── WhatIsTypeAndWhatIsData │ │ └── IntermissionExercises.hs │ └── WhatMakesDataTypesAlgebraic │ │ ├── IntermissionExercises.md │ │ ├── NewType.hs │ │ └── SimpleDataTypesWithNullaryDataConstructors.md ├── Applicative │ ├── ApplicativeInUse │ │ ├── ConstantExercise.hs │ │ ├── IdentityExercise.hs │ │ ├── MaybeExercise.hs │ │ └── ShortExercises.hs │ ├── ApplicativeLaws │ │ └── .gitkeep │ ├── ChapterExercises │ │ ├── ApplicativeInstances.hs │ │ ├── Combinations.hs │ │ └── SpecializeTypes.md │ ├── YouKnewThisWasComing │ │ └── .gitkeep │ └── ZipListMonoid │ │ ├── ListApplicativeExercise.hs │ │ ├── ValidationExercise.hs │ │ └── ZipListApplicativeExercise.hs ├── BasicDatatypes │ ├── BasicDatatypes │ │ └── IntermissionExercises.md │ ├── ChapterExercises │ │ ├── Awesome.hs │ │ ├── MatchTheFunctionNamesToTheirTypes.md │ │ └── ReadingSyntax.hs │ └── ComparingValues │ │ └── IntermissionExercises.hs ├── BasicLibraries │ └── ChapterExercises │ │ ├── DifferenceList.hs │ │ └── Queue.hs ├── BuildingProjects │ ├── ChapterExercises │ │ └── ModifyingCode │ │ │ ├── GimmePerson.hs │ │ │ ├── HangmanGameLogic.hs │ │ │ └── Palindrome.hs │ └── ImportingModules │ │ └── CheckYourUnderstanding.md ├── ComposingTypes │ ├── IntermissionExercises │ │ ├── Bifunctor.hs │ │ └── FoldableAndTraversableForCompose.hs │ └── Twinplicative │ │ └── Exercise.hs ├── Foldable │ ├── ChapterExercises │ │ ├── WriteFilterFunction.hs │ │ └── WriteFoldableInstances.hs │ └── SomeBasicDerivedOperations │ │ └── Exercises.hs ├── FoldingLists │ ├── ChapterExercises │ │ ├── RewritingFunctionsUsingFolds.hs │ │ └── WarmUpAndReview.hs │ ├── FoldLeft │ │ └── IntermissionExercises.md │ ├── HowToWriteFoldFunctions │ │ └── IntermissionExercises.hs │ └── Scans │ │ └── ScansExercises.hs ├── Functor │ ├── ChapterExercises │ │ ├── DetermineIfAValidFunctorCanBeWritten.md │ │ ├── RearrangeArguments.hs │ │ └── WriteFunctorInstances.hs │ ├── CommonlyUsedFunctors │ │ └── LiftingExercises.hs │ ├── IgnoringPossibilities │ │ └── ShortExercise.hs │ ├── IntermissionExercises │ │ └── IntermissionExercises.hs │ └── LetUsTalkAboutF │ │ └── IntermissionExercises.md ├── Lists │ ├── ChapterExercises │ │ ├── Char.hs │ │ ├── Ciphers.hs │ │ └── WritingYourOwnStandardFunctions.hs │ ├── ExtractingPortionsOfLists │ │ └── IntermissionExercises.hs │ ├── FilteringListsOfValues │ │ └── IntermissionExercises.hs │ ├── ListComprehensions │ │ └── IntermissionExercises.hs │ ├── SpinesAndNonStrictEvaluation │ │ └── IntermissionExercises.md │ ├── TransformingListsOfValues │ │ └── IntermissionExercises.md │ ├── UsingRangesToConstructLists │ │ └── Exercise.hs │ └── ZippingLists │ │ └── ZippingExercises.hs ├── Monad │ ├── ChapterExercises │ │ ├── RewriteFunctions.hs │ │ └── WriteMonadInstances.hs │ ├── ExampleOfMonadUse │ │ └── Exercise.hs │ └── Monad │ │ └── Exercise.hs ├── MonadTransformers │ ├── ChapterExercises │ │ ├── FixTheCode.hs │ │ ├── HitCounter.hs │ │ ├── Morra.hs │ │ └── WriteTheCode.hs │ ├── EitherT │ │ └── Exercises.hs │ ├── LexicallyInnerIsStructurallyOuter │ │ └── Exercise.hs │ ├── MonadIO │ │ └── Exercises.hs │ ├── MonadTrans │ │ └── Exercises.hs │ └── StateT │ │ └── Exercises.hs ├── Monoid │ ├── BetterLivingThroughQuickCheck │ │ └── IntermissionExercise.hs │ ├── ChapterExercises │ │ ├── MonoidExercises.hs │ │ └── SemigroupExercises.hs │ ├── Madness │ │ └── Exercise.hs │ └── ReusingAlgebras │ │ └── Exercise.hs ├── MoreFunctionalPatterns │ ├── AnonymousFunctions │ │ └── IntermissionExercises.md │ ├── CaseExpressions │ │ └── IntermissionExercises.hs │ ├── ChapterExercises │ │ ├── LetUsWriteCode.hs │ │ └── MultipleChoice.md │ ├── Guards │ │ └── IntermissionExercises.md │ ├── HigherOrderFunctions │ │ └── IntermissionExercises.hs │ └── PatternMatching │ │ └── IntermissionExercises.md ├── ParserCombinators │ ├── Alternative │ │ └── IntermissionExercise.hs │ ├── ChapterExercises │ │ ├── IPV4Addresses.hs │ │ ├── IPV6Addresses.hs │ │ ├── LogFile.hs │ │ ├── ParseDigitAndInteger.hs │ │ ├── PhoneNumbers.hs │ │ └── SemanticVersions.hs │ ├── ParsingFractions │ │ └── IntermissionExercise.hs │ └── UnderstandingTheParsingProcess │ │ └── IntermissionExercises.hs ├── Reader │ ├── ButUhReader │ │ └── Exercise.hs │ ├── ChapterExercises │ │ └── WarmUpStretch.hs │ ├── FunctionsHaveAnApplicativeToo │ │ └── Exercise.hs │ ├── Reader │ │ └── ShortExercise.hs │ └── TheMonadOfFunctions │ │ └── Exercise.hs ├── Recursion │ └── ChapterExercises │ │ ├── FixingDividedBy.hs │ │ ├── McCarthy91Function.hs │ │ ├── NumbersIntoWords.hs │ │ ├── Recursion.hs │ │ ├── ReviewOfTypes.md │ │ └── ReviewingCurrying.md ├── SignalingAdversity │ └── ChapterExercises │ │ ├── DetermineTheKinds.md │ │ ├── ItIsOnlyNatural.hs │ │ ├── IterateAndUnfoldr.hs │ │ ├── SmallLibraryForEither.hs │ │ ├── SmallLibraryForMaybe.hs │ │ ├── SomethingOtherThanList.hs │ │ ├── StringProcessing.hs │ │ └── ValidateTheWord.hs ├── State │ ├── ChapterExercises │ │ └── Exercises.hs │ ├── GetACodingJobWithOneWierdTrick │ │ └── FizzbuzzDifferently.hs │ ├── ThrowDown │ │ └── Exercises.hs │ └── WriteStateForYourself │ │ └── Exercise.hs ├── Strings │ ├── ChapterExercises │ │ ├── BuildingFunctions.hs │ │ └── ReadingSyntax.md │ ├── PrintingSimpleStrings │ │ └── IntermissionExercises.md │ └── TypesOfConcatenationFunctions │ │ └── IntermissionExercises.md ├── Testing │ ├── ChapterExercises │ │ ├── Idempotence.hs │ │ ├── MakeAGenRandomGeneratorForTheDataType.hs │ │ ├── UsingQuickCheck.hs │ │ └── ValidatingNumbersIntoWords.hs │ └── ConventionalTesting │ │ └── IntermissionExercise.hs ├── Traversable │ └── ChapterExercises │ │ ├── InstancesForTree.hs │ │ └── TraversableInstances.hs ├── Typeclasses │ ├── ChapterExercises │ │ ├── DoesItTypecheck.md │ │ ├── GivenDatatypeDeclarationWhatCanWeDo.md │ │ ├── MatchTheTypes.md │ │ ├── MultipleChoice.md │ │ └── TypeKwonDo.hs │ ├── Ord │ │ └── IntermissionExercises.md │ └── WritingTypeclassInstances │ │ └── IntermissionExercises.hs └── Types │ ├── ChapterExercises │ ├── DetermineTheType.md │ ├── DoesItCompile.md │ ├── FixIt.hs │ ├── GivenATypeWriteTheFunction.hs │ ├── MultipleChoice.md │ ├── TypeKwonDo.hs │ └── WriteATypeSignature.hs │ ├── Currying │ └── IntermissionExercises.md │ ├── Polymorphism │ └── IntermissionExercises.hs │ └── TypeInference │ └── IntermissionExercises.md ├── stack.yaml └── test ├── AlgebraicDataTypes ├── BinaryTree │ ├── ConvertBinaryTreesToListsSpec.hs │ ├── WriteFoldrForBinaryTreeSpec.hs │ └── WriteMapForBinaryTreeSpec.hs ├── ChapterExercises │ ├── AsPatternsSpec.hs │ ├── CiphersSpec.hs │ ├── HuttonRazorSpec.hs │ ├── LanguageExercisesSpec.hs │ └── PhoneExerciseSpec.hs ├── ConstructingAndDeconstructingValues │ └── ExerciseSpec.hs └── ProductTypes │ └── JamminExercisesSpec.hs ├── Applicative ├── ApplicativeInUse │ ├── ConstantExerciseSpec.hs │ └── IdentityExerciseSpec.hs ├── ChapterExercises │ ├── ApplicativeInstancesSpec.hs │ └── CombinationsSpec.hs └── ZipListMonoid │ ├── ListApplicativeExerciseSpec.hs │ ├── ValidationExerciseSpec.hs │ └── ZipListApplicativeExerciseSpec.hs ├── Foldable ├── ChapterExercises │ ├── WriteFilterFunctionSpec.hs │ └── WriteFoldableInstancesSpec.hs └── SomeBasicDerivedOperations │ └── ExercisesSpec.hs ├── FoldingLists ├── ChapterExercises │ └── RewritingFunctionsUsingFoldsSpec.hs ├── HowToWriteFoldFunctions │ └── IntermissionExercisesSpec.hs └── Scans │ └── ScansExercisesSpec.hs ├── Functor ├── ChapterExercises │ └── RearrangeArgumentsSpec.hs ├── CommonlyUsedFunctors │ └── LiftingExercisesSpec.hs ├── IgnoringPossibilities │ └── ShortExerciseSpec.hs └── IntermissionExercises │ └── IntermissionExercisesSpec.hs ├── Lists ├── ChapterExercises │ ├── CharSpec.hs │ ├── CiphersSpec.hs │ └── WritingYourOwnStandardFunctionsSpec.hs ├── ExtractingPortionsOfLists │ └── IntermissionExercisesSpec.hs ├── FilteringListsOfValues │ └── IntermissionExercisesSpec.hs ├── UsingRangesToConstructLists │ └── ExerciseSpec.hs └── ZippingLists │ └── ZippingExercisesSpec.hs ├── Monad ├── ChapterExercises │ ├── RewriteFunctionsSpec.hs │ └── WriteMonadInstancesSpec.hs ├── ExampleOfMonadUse │ └── ExerciseSpec.hs └── Monad │ └── ExerciseSpec.hs ├── MonadTransformers └── ChapterExercises │ └── WriteTheCodeSpec.hs ├── Monoid ├── ChapterExercises │ ├── MonoidExercisesSpec.hs │ └── SemigroupExercisesSpec.hs └── ReusingAlgebras │ └── ExerciseSpec.hs ├── MoreFunctionalPatterns └── ChapterExercises │ └── LetUsWriteCodeSpec.hs ├── ParserCombinators ├── Alternative │ └── IntermissionExerciseSpec.hs ├── ChapterExercises │ ├── IPV4AddressesSpec.hs │ ├── IPV6AddressesSpec.hs │ ├── LogFileSpec.hs │ ├── ParseDigitAndIntegerSpec.hs │ ├── PhoneNumbersSpec.hs │ └── SemanticVersionsSpec.hs ├── ParsingFractions │ └── IntermissionExerciseSpec.hs └── UnderstandingTheParsingProcess │ └── IntermissionExercisesSpec.hs ├── Reader ├── ButUhReader │ └── ExerciseSpec.hs ├── ChapterExercises │ └── WarmUpStretchSpec.hs ├── FunctionsHaveAnApplicativeToo │ └── ExerciseSpec.hs └── Reader │ └── ShortExerciseSpec.hs ├── Recursion └── ChapterExercises │ ├── FixingDividedBySpec.hs │ ├── McCarthy91FunctionSpec.hs │ ├── NumbersIntoWordsSpec.hs │ └── RecursionSpec.hs ├── SignalingAdversity └── ChapterExercises │ ├── ItIsOnlyNaturalSpec.hs │ ├── IterateAndUnfoldrSpec.hs │ ├── SmallLibraryForMaybeSpec.hs │ ├── SomethingOtherThanListSpec.hs │ └── StringProcessingSpec.hs ├── Spec.hs ├── State ├── ChapterExercises │ └── ExercisesSpec.hs ├── GetACodingJobWithOneWierdTrick │ └── FizzbuzzDifferentlySpec.hs ├── ThrowDown │ └── ExercisesSpec.hs └── WriteStateForYourself │ └── ExerciseSpec.hs ├── Testing ├── ChapterExercises │ ├── IdempotenceSpec.hs │ ├── UsingQuickCheckSpec.hs │ └── ValidatingNumbersIntoWordsSpec.hs └── ConventionalTesting │ └── IntermissionExerciseSpec.hs └── Traversable └── ChapterExercises ├── InstancesForTreeSpec.hs └── TraversableInstancesSpec.hs /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | 3 | jobs: 4 | build: 5 | docker: 6 | - image: fpco/stack-build:lts-14.27 7 | steps: 8 | - checkout 9 | 10 | - restore_cache: 11 | keys: 12 | - stack-dependencies-{{ arch }}-{{ checksum "stack.yaml" }}-{{ checksum "package.yaml" }} 13 | - stack-dependencies-{{ arch }}-{{ checksum "stack.yaml" }} 14 | 15 | - run: 16 | command: stack build --test --bench --only-dependencies -j1 17 | 18 | - save_cache: 19 | key: stack-dependencies-{{ arch }}-{{ checksum "stack.yaml" }}-{{ checksum "package.yaml" }} 20 | paths: 21 | - ~/.stack 22 | 23 | - run: 24 | command: stack build --test --no-run-tests --bench --no-run-benchmarks 25 | 26 | - save_cache: 27 | key: stack-work-{{ arch }}-{{ .Revision }} 28 | paths: 29 | - .stack-work 30 | 31 | test: 32 | docker: 33 | - image: fpco/stack-build:lts-14.27 34 | steps: 35 | - checkout 36 | - restore_cache: 37 | keys: 38 | - stack-dependencies-{{ arch }}-{{ checksum "stack.yaml" }}-{{ checksum "package.yaml" }} 39 | - stack-dependencies-{{ arch }}-{{ checksum "stack.yaml" }} 40 | - restore_cache: 41 | key: stack-work-{{ arch }}-{{ .Revision }} 42 | - run: 43 | command: stack test 44 | workflows: 45 | version: 2 46 | build-test: 47 | jobs: 48 | - build 49 | - test: 50 | requires: 51 | - build 52 | -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | :set prompt "\ESC[34mλ> \ESC[m" 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Haskell 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .hpc 12 | .hsenv 13 | .cabal-sandbox/ 14 | cabal.sandbox.config 15 | *.prof 16 | *.aux 17 | *.hp 18 | *.eventlog 19 | .stack-work/ 20 | cabal.project.local 21 | cabal.project.local~ 22 | .HTF/ 23 | .ghc.environment.* 24 | 25 | # Custom 26 | haskell-programming-from-first-principles.cabal 27 | *~ 28 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | image: haskell:8.4.3 2 | cache: 3 | key: ${CI_COMMIT_REF_SLUG} 4 | paths: 5 | - .stack-work/ 6 | - .stack-root/ 7 | before_script: 8 | - stack install --only-dependencies 9 | stages: 10 | - test 11 | test: 12 | stage: test 13 | only: 14 | - master 15 | script: 16 | - stack test 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the simple Travis configuration, which is intended for use 2 | # on applications which do not require cross-platform and 3 | # multiple-GHC-version support. For more information and other 4 | # options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Do not choose a language; we provide our own build tools. 15 | language: generic 16 | 17 | # safelist 18 | branches: 19 | only: 20 | - master 21 | 22 | # Caching so the next build will be fast too. 23 | cache: 24 | directories: 25 | - $HOME/.stack 26 | 27 | # Ensure necessary system libraries are present 28 | addons: 29 | apt: 30 | packages: 31 | - libgmp-dev 32 | 33 | before_install: 34 | # Download and unpack the stack executable 35 | - mkdir -p ~/.local/bin 36 | - export PATH=$HOME/.local/bin:$PATH 37 | - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 38 | 39 | install: 40 | # Build dependencies 41 | - stack --no-terminal --install-ghc test --only-dependencies 42 | 43 | script: 44 | # Run test and benchmark suites 45 | - stack --no-terminal --skip-ghc-check test 46 | - stack --no-terminal --skip-ghc-check bench 47 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for haskell-programming-from-first-principles 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright BoeingX (c) 2018 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of BoeingX nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell Programming from First Principles 2 | [![Build Status](https://travis-ci.org/BoeingX/haskell-programming-from-first-principles.svg?branch=master)](https://travis-ci.org/BoeingX/haskell-programming-from-first-principles) 3 | [![CircleCI](https://circleci.com/gh/BoeingX/haskell-programming-from-first-principles/tree/master.svg?style=svg)](https://circleci.com/gh/BoeingX/haskell-programming-from-first-principles/tree/master) 4 | [![License](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) 5 | 6 | This repository hosts my notes and solutions to exercises in the book 7 | [Haskell Programming from First Principles](http://haskellbook.com/). 8 | 9 | ## Dependencies 10 | 11 | The only dependency is [Stack](https://docs.haskellstack.org/en/stable/README/). 12 | Once setup, Stack takes care of any Haskell package dependencies. 13 | 14 | ## Project structure 15 | 16 | This repository is organized as a single Stack project as follows 17 | ``` 18 | . 19 | ├── benchmark/ 20 | ├── ChangeLog.md 21 | ├── haskell-programming-from-first-principles.cabal 22 | ├── LICENSE 23 | ├── package.yaml 24 | ├── README.md 25 | ├── Setup.hs 26 | ├── src/ 27 | ├── stack.yaml 28 | └── test/ 29 | ``` 30 | where [src](./src) are solutions whose name follows the pattern 31 | ``` 32 | ChapterName/SectionName/ExerciseName.hs 33 | ``` 34 | [test](./test/) and [benchmark](./benchmark) are test and benchmark suites following 35 | the same naming convention. 36 | 37 | ## Run tests 38 | 39 | All test suites can be discovered by `hspec-discover`. To run tests, simply do 40 | 41 | ```bash 42 | stack test 43 | ``` 44 | or 45 | ```bash 46 | stack --fast test 47 | ``` 48 | if you want avoid GHC optimization (hence faster). 49 | 50 | ## Run benchmarks 51 | 52 | Run 53 | 54 | ```bash 55 | stack bench 56 | ``` 57 | 58 | > **Never** use the `--fast` flag for benchmarks otherwise you will get **wrong** results. 59 | 60 | Reference benchmark results are included in each benchmark file as block comment. 61 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /benchmark/BasicLibraries/ChapterExercises/DifferenceListBenchmark.hs: -------------------------------------------------------------------------------- 1 | module BasicLibraries.ChapterExercises.DifferenceListBenchmark ( 2 | benchmarks 3 | ) where 4 | 5 | import Criterion 6 | import BasicLibraries.ChapterExercises.DifferenceList 7 | 8 | schlemiel :: Int -> [Int] 9 | schlemiel i = go i [] 10 | where go 0 xs = xs 11 | go n xs = go (n-1) [n] ++ xs 12 | 13 | constructDlist :: Int -> [Int] 14 | constructDlist i = toList $ go i empty 15 | where go 0 xs = xs 16 | go n xs = go (n-1) (singleton n `append` xs) 17 | 18 | benchmarks :: [Benchmark] 19 | benchmarks = 20 | [ bench "concat list" $ whnf schlemiel 123456 21 | , bench "concat dlist" $ whnf constructDlist 123456 22 | ] 23 | 24 | {- Reference benchmark results 25 | 26 | benchmarking Difference List/concat list 27 | time 35.99 ms (32.95 ms .. 42.01 ms) 28 | 0.942 R² (0.873 R² .. 0.993 R²) 29 | mean 38.50 ms (36.79 ms .. 41.26 ms) 30 | std dev 4.482 ms (3.416 ms .. 5.551 ms) 31 | variance introduced by outliers: 45% (moderately inflated) 32 | 33 | benchmarking Difference List/concat dlist 34 | time 217.9 μs (211.2 μs .. 225.5 μs) 35 | 0.990 R² (0.984 R² .. 0.996 R²) 36 | mean 217.9 μs (213.2 μs .. 224.9 μs) 37 | std dev 19.38 μs (15.17 μs .. 23.67 μs) 38 | variance introduced by outliers: 75% (severely inflated) 39 | -} 40 | -------------------------------------------------------------------------------- /benchmark/BasicLibraries/ChapterExercises/QueueBenchmark.hs: -------------------------------------------------------------------------------- 1 | module BasicLibraries.ChapterExercises.QueueBenchmark ( 2 | benchmarks 3 | ) where 4 | 5 | import Criterion 6 | import Data.Sequence 7 | import BasicLibraries.ChapterExercises.Queue 8 | 9 | listQueueBench :: Int -> [Int] 10 | listQueueBench n = foldr go [] [1..2*n] 11 | where go x acc 12 | | even x = x : acc 13 | | otherwise = init acc 14 | 15 | queueBench :: Int -> Queue Int 16 | queueBench n = foldr go initQueue [1..2*n] 17 | where initQueue = Queue [] [] 18 | go x acc 19 | | even x = push x acc 20 | | otherwise = let Just (_, acc') = pop acc in acc' 21 | 22 | sequenceBench :: Int -> Seq Int 23 | sequenceBench n = foldr go empty [1..2*n] 24 | where go x acc 25 | | even x = x <| acc 26 | | otherwise = let acc' :> _ = viewr acc in acc' 27 | 28 | benchmarks :: [Benchmark] 29 | benchmarks = 30 | [ bench "list queue" $ nf listQueueBench 123456 31 | , bench "queue" $ whnf queueBench 123456 32 | , bench "sequence" $ whnf sequenceBench 123456 33 | ] 34 | 35 | {- Reference benchmark results 36 | 37 | benchmarking Queue/list queue 38 | time 27.27 ms (26.40 ms .. 27.86 ms) 39 | 0.996 R² (0.991 R² .. 0.999 R²) 40 | mean 27.70 ms (27.21 ms .. 28.66 ms) 41 | std dev 1.439 ms (768.4 μs .. 2.317 ms) 42 | variance introduced by outliers: 16% (moderately inflated) 43 | 44 | benchmarking Queue/queue 45 | time 10.75 ms (10.51 ms .. 11.01 ms) 46 | 0.996 R² (0.993 R² .. 0.998 R²) 47 | mean 10.98 ms (10.83 ms .. 11.27 ms) 48 | std dev 545.3 μs (329.6 μs .. 914.8 μs) 49 | variance introduced by outliers: 23% (moderately inflated) 50 | 51 | benchmarking Queue/sequence 52 | time 7.768 ms (7.597 ms .. 7.926 ms) 53 | 0.996 R² (0.993 R² .. 0.999 R²) 54 | mean 8.119 ms (7.932 ms .. 8.509 ms) 55 | std dev 719.3 μs (393.4 μs .. 1.096 ms) 56 | variance introduced by outliers: 51% (severely inflated) 57 | 58 | -} 59 | -------------------------------------------------------------------------------- /benchmark/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Criterion.Main 4 | 5 | import qualified BasicLibraries.ChapterExercises.DifferenceListBenchmark 6 | import qualified BasicLibraries.ChapterExercises.QueueBenchmark 7 | 8 | main :: IO () 9 | main = defaultMain 10 | [ 11 | bgroup "Difference List" BasicLibraries.ChapterExercises.DifferenceListBenchmark.benchmarks 12 | , bgroup "Queue" BasicLibraries.ChapterExercises.QueueBenchmark.benchmarks 13 | ] 14 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: haskell-programming-from-first-principles 2 | version: 0.1.0.0 3 | github: "BoeingX/haskell-programming-from-first-principles" 4 | license: BSD3 5 | author: "BoeingX" 6 | maintainer: "user@domain.com" 7 | copyright: "BSD3" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Education 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - transformers 25 | - containers 26 | - bytestring 27 | - text 28 | - raw-strings-qq 29 | - random 30 | - trifecta 31 | - parsers 32 | - hspec 33 | - QuickCheck 34 | - checkers 35 | - hspec-checkers 36 | - split 37 | - scotty 38 | - wai 39 | - time 40 | 41 | library: 42 | source-dirs: src 43 | 44 | benchmarks: 45 | haskell-programming-from-first-principles-benchmark: 46 | dependencies: 47 | - base 48 | - criterion 49 | ghc-options: 50 | - -O2 51 | - -rtsopts 52 | - -threaded 53 | - -with-rtsopts=-N 54 | main: Main.hs 55 | source-dirs: 56 | - src 57 | - benchmark 58 | 59 | tests: 60 | haskell-programming-from-first-principles-test: 61 | main: Spec.hs 62 | source-dirs: test 63 | ghc-options: 64 | - -threaded 65 | - -rtsopts 66 | - -with-rtsopts=-N 67 | dependencies: 68 | - haskell-programming-from-first-principles 69 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/BinaryTree/ConvertBinaryTreesToLists.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.ConvertBinaryTreesToLists where 2 | 3 | data BinaryTree a = Leaf 4 | | Node (BinaryTree a) a (BinaryTree a) 5 | deriving (Eq, Ord, Show) 6 | 7 | preorder :: BinaryTree a -> [a] 8 | preorder Leaf = [] 9 | preorder (Node l a r) = a : preorder l ++ preorder r 10 | 11 | inorder :: BinaryTree a -> [a] 12 | inorder Leaf = [] 13 | inorder (Node l a r) = inorder l ++ [a] ++ inorder r 14 | 15 | postorder :: BinaryTree a -> [a] 16 | postorder Leaf = [] 17 | postorder (Node l a r) = postorder l ++ postorder r ++ [a] 18 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/BinaryTree/WriteFoldrForBinaryTree.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.WriteFoldrForBinaryTree where 2 | 3 | data BinaryTree a = Leaf 4 | | Node (BinaryTree a) a (BinaryTree a) 5 | deriving (Eq, Ord, Show) 6 | 7 | foldTree :: (b -> a -> b -> b) -> b -> BinaryTree a -> b 8 | foldTree _ b Leaf = b 9 | foldTree f b (Node l a r) = f (foldTree f b l) a (foldTree f b r) 10 | 11 | {-- 12 | First, note that it is impossible to rewrite mapTree with the foldTree given in the book 13 | whose type is 14 | 15 | foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b 16 | 17 | Indeed, the type suggests first converting the tree to a list using either preorder or 18 | inorder or postorder, such as 19 | 20 | foldTree f b bt = foldr f b $ inorder bt 21 | 22 | After the traversal, the tree structure is lost, 23 | otherwise it would be possible to reconstruct a binary tree from one of its traversal. 24 | --} 25 | 26 | mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b 27 | mapTree f = foldTree (\l a r -> Node l (f a) r) Leaf 28 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/BinaryTree/WriteMapForBinaryTree.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.WriteMapForBinaryTree where 2 | 3 | data BinaryTree a = Leaf 4 | | Node (BinaryTree a) a (BinaryTree a) 5 | deriving (Eq, Ord, Show) 6 | 7 | mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b 8 | mapTree _ Leaf = Leaf 9 | mapTree f (Node l a r) = Node (mapTree f l) (f a) (mapTree f r) 10 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/AsPatterns.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.AsPatterns where 2 | 3 | import Data.Char 4 | import Data.List (elemIndex) 5 | 6 | isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool 7 | isSubsequenceOf [] _ = True 8 | isSubsequenceOf _ [] = False 9 | isSubsequenceOf xs@(x:xs') (y:ys') 10 | | x == y = isSubsequenceOf xs' ys' 11 | | otherwise = isSubsequenceOf xs ys' 12 | 13 | capitalizeWords :: String -> [(String, String)] 14 | capitalizeWords = map f . words 15 | where f xs'@(x:xs) = (xs', toUpper x : xs) 16 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/Ciphers.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.Ciphers where 2 | 3 | import Data.List 4 | import Data.Char 5 | 6 | -- Repeat the keyword for as many characters as there are in the original message 7 | calculateCompanion :: String -> String -> String 8 | calculateCompanion message keyword = (snd . foldl' f (0, "")) message 9 | where len = length keyword 10 | f (i, s) c 11 | | c == ' ' = (i, s ++ " ") 12 | | otherwise = (i + 1 `mod` len, s ++ [keyword !! i']) 13 | where i' = i `mod` len 14 | 15 | -- The core of the Vigenere cipher 16 | shift :: Char -> Char -> Char 17 | shift c c' 18 | | c' == ' ' = c 19 | | otherwise = c'' 20 | where diff = ord c' - ord 'A' 21 | c'' = chr $ ((ord c - ord 'A' + diff) `mod` 26) + ord 'A' 22 | 23 | -- API 24 | vigenereCipher :: String -> String -> String 25 | vigenereCipher message keyword = zipWith shift message companion 26 | where companion = calculateCompanion message keyword 27 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/HuttonRazor.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.HuttonRazor where 2 | 3 | data Expr = Lit Integer 4 | | Add Expr Expr 5 | deriving (Show, Eq) 6 | 7 | eval :: Expr -> Integer 8 | eval (Lit x) = x 9 | eval (Add x y) = eval x + eval y 10 | 11 | printExpr :: Expr -> String 12 | printExpr (Lit x) = show x 13 | printExpr (Add x y) = printExpr x ++ " + " ++ printExpr y 14 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/LanguageExercises.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.LanguageExercises where 2 | 3 | import Data.Char 4 | 5 | capitalizeWord :: String -> String 6 | capitalizeWord "" = "" 7 | capitalizeWord (c:cs) = toUpper c : cs 8 | 9 | capitalizeParagraph :: String -> String 10 | capitalizeParagraph "" = "" 11 | capitalizeParagraph cs = capitalizeWord p1 ++ punct ++ capitalizeParagraph p2 12 | where (p1, p2') = span (/= '.') cs 13 | (punct, p2) = span (`elem` ['.', ' ']) p2' 14 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/MultipleChoice.md: -------------------------------------------------------------------------------- 1 | 1. Given 2 | ```haskell 3 | data Weekday = 4 | Monday 5 | | Tuesday 6 | | Wednesday 7 | | Thursday 8 | | Friday 9 | ``` 10 | we can say that *a) `Weekday` is a type with five data constructors*. 11 | 12 | 2. With the same datatype, the type of 13 | ```haskell 14 | f Friday = "Miller Time" 15 | ``` 16 | has the type 17 | ```haskell 18 | f :: Weekday -> String 19 | ``` 20 | 21 | 3. Type defined with the `data` keyword *b) must begin with a capital letter*. 22 | 23 | 4. The function `g xs = xs !! (length xs - 1)` *c) delivers the final element of `xs`*. 24 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ChapterExercises/PhoneExercise.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.PhoneExercise where 2 | 3 | import Data.Char 4 | import Data.List 5 | import Control.Applicative 6 | 7 | type Digit = Char 8 | 9 | type Presses = Int 10 | 11 | type Combo = (Digit, Presses) 12 | 13 | data Button = Button Digit String 14 | 15 | newtype DaPhone = DaPhone {getButtons :: [Button]} 16 | 17 | -- Question 2 18 | getCombo :: Button -> Char -> Combo 19 | getCombo (Button x (y : ys)) c 20 | | y == c = (x, 1) 21 | | otherwise = (+1) <$> getCombo (Button x ys) c 22 | 23 | reverseTaps :: DaPhone -> Char -> [(Digit, Presses)] 24 | reverseTaps daPhone c 25 | | isUpper c = ('*', 1) : reverseTaps daPhone (toLower c) 26 | | otherwise = [getCombo button c] 27 | where button = findButton $ getButtons daPhone 28 | findButton (b@(Button d s) : bs) 29 | | c `elem` s = b 30 | | otherwise = findButton bs 31 | 32 | cellPhonesDead :: DaPhone 33 | -> String 34 | -> [(Digit, Presses)] 35 | cellPhonesDead daPhone = concatMap (reverseTaps daPhone) 36 | 37 | -- Question 3 38 | fingerTaps :: [(Digit, Presses)] -> Presses 39 | fingerTaps = sum . map snd 40 | 41 | -- Question 4 42 | mostPopularElement :: (Eq a, Ord a) => [a] -> a 43 | mostPopularElement = head . maximumBy (\x y -> compare (length x) (length y)) . group . sort 44 | 45 | mostPopularLetter :: String -> Char 46 | mostPopularLetter = mostPopularElement 47 | 48 | -- Question 5 49 | coolestLtr :: [String] -> Char 50 | coolestLtr = mostPopularLetter . concat 51 | 52 | coolestWord :: [String] -> String 53 | coolestWord = mostPopularElement . concatMap words 54 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ConstructingAndDeconstructingValues/Exercise.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ConstructingAndDeconstructingValues.Exercise where 2 | 3 | import Control.Applicative 4 | 5 | data OperatingSystem = 6 | GnuPlusLinux 7 | | OpenBSDPlusNevermindJustBSDStill 8 | | Mac 9 | | Windows 10 | deriving (Eq, Show) 11 | 12 | data ProgrammingLanguage = 13 | Haskell 14 | | Agda 15 | | Idris 16 | | PureScript 17 | deriving (Eq, Show) 18 | 19 | data Programmer = 20 | Programmer { os :: OperatingSystem 21 | , lang :: ProgrammingLanguage } 22 | deriving (Eq, Show) 23 | 24 | allOperatingSystems :: [OperatingSystem] 25 | allOperatingSystems = 26 | [ GnuPlusLinux 27 | , OpenBSDPlusNevermindJustBSDStill 28 | , Mac 29 | , Windows 30 | ] 31 | 32 | allLanguages :: [ProgrammingLanguage] 33 | allLanguages = [Haskell, Agda, Idris, PureScript] 34 | 35 | allProgrammers :: [Programmer] 36 | allProgrammers = liftA2 Programmer allOperatingSystems allLanguages 37 | 38 | -- Or without using Applicative 39 | allProgrammers' :: [Programmer] 40 | allProgrammers' = [Programmer os lang | os <- allOperatingSystems, lang <- allLanguages] 41 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/DataConstructorsAndValues/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | data DogueDeBordeaux doge = DogueDeBordeaux doge 3 | 4 | data Doggies a = 5 | Husky a 6 | | Mastiff a 7 | deriving (Eq, Show) 8 | ``` 9 | 10 | 1. `Doggies` is a type constructor. 11 | 12 | 2. The kind of `Doggies` is `* -> *`. 13 | 14 | 3. The kind of `Doggies String` is `*`. 15 | 16 | 4. The type of `Husky 10` is `(Num a) => Doggies a`. 17 | 18 | 5. The type of `Husky (10 :: Integer)` is `Doggies Integer`. 19 | 20 | 6. The type of `Mastiff "Scooby Doo"` is `Doggies String`. 21 | 22 | 7. `DogueDeBordeaux` is both a type and data constructor. 23 | 24 | 8. The type of `DogueDeBordeaux` is `DogueDeBordeaux a`. 25 | 26 | 9. Type of `DogueDeBordeaux "doggie!"` is `DogueDeBordeaux String`. 27 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/FunctionTypeIsExponential/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | Determine how many unique inhabitants each type has. 2 | 3 | 1. 4 | ```haskell 5 | data Quad = 6 | One 7 | | Two 8 | | Three 9 | | Four 10 | deriving (Eq, Show) 11 | ``` 12 | 13 | `eQuad :: Either Quad Quad` can take 8 forms (4 + 4). 14 | 15 | 2. `prodQuad :: (Quad, Quad)` can take 16 forms (4*4). 16 | 17 | 3. `funcQuad :: Quad -> Quad` can take 256 forms (4^4). 18 | 19 | 4. `prodTBool :: (Bool, Bool, Bool)` can take 8 forms (2*2*2). 20 | 21 | 5. `gTwo :: Bool -> Bool -> Bool` can take 16 forms ((2^2)^2). 22 | 23 | 6. `fTwo :: Bool -> Quad -> Quad` can take 65536 forms ((2^4)^4). 24 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/NormalForm/Exercises.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | data FlowerType = Gardenia 3 | | Daisy 4 | | Rose 5 | | Lilac 6 | deriving Show 7 | 8 | type Gardener = String 9 | 10 | data Garden = Garden Gardener FlowerType 11 | deriving Show 12 | ``` 13 | The normal form of `Garden` is 14 | ```haskell 15 | data Garden = GardenG Gardener Gardenia 16 | | GardenD Gardener Daisy 17 | | GardenR Gardener Rose 18 | | GardenL Gardener Lilac 19 | ``` 20 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/ProductTypes/JamminExercises.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ProductTypes.JamminExercises where 2 | 3 | import Data.List 4 | import Data.Ord 5 | 6 | data Fruit = 7 | Peach 8 | | Plum 9 | | Apple 10 | | Blackberry 11 | deriving (Eq, Show, Ord) 12 | 13 | data JamJars = 14 | Jam { fruit :: Fruit 15 | , jars :: Int } 16 | deriving (Eq, Show, Ord) 17 | 18 | -- Question 3 19 | -- The cardinality of JamJars is 4 * (2 ^ 64) 20 | 21 | -- Question 6 22 | totalNumberOfJars :: [JamJars] -> Int 23 | totalNumberOfJars = sum . map jars 24 | 25 | -- Question 7 26 | mostRow :: [JamJars] -> JamJars 27 | mostRow = maximumBy (comparing jars) 28 | 29 | -- Question 9 30 | sortJars :: [JamJars] -> [JamJars] 31 | sortJars = sortOn fruit 32 | 33 | -- Question 10 34 | groupJam :: [JamJars] -> [[JamJars]] 35 | groupJam = groupBy (\x y -> fruit x == fruit y) . sortJars 36 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/SumTypes/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | 1. Given a datatype 2 | ```haskell 3 | data BigSmall = Big Bool 4 | | Small Bool 5 | deriving (Eq, Show) 6 | ``` 7 | the cardinality of this data type is 4. 8 | 9 | 2. Given a datatype 10 | ```haskell 11 | -- needed to have Int8 in scope 12 | import Data.Int 13 | data NumberOrBool = Numba Int8 14 | | BoolyBool Bool 15 | deriving (Eq, Show) 16 | 17 | -- Example use of Numba, parentheses due to 18 | -- syntactic collision between (-) minus and 19 | -- the negate function 20 | let myNumba = Numba (-128) 21 | ``` 22 | The cardinality of `NumberOrBool` is 258. 23 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/WhatIsTypeAndWhatIsData/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.WhatIsTypeAndWhatIsData.IntermissionExercises where 2 | 3 | data Price = Price Integer deriving (Eq, Show) 4 | 5 | data Size = Size Integer deriving (Eq, Show) 6 | 7 | data Manufacturer = Mini 8 | | Mazda 9 | | Tata 10 | deriving (Eq, Show) 11 | 12 | data Airline = PapuAir 13 | | CatapultsR'Us 14 | | TakeYourChancesUnited 15 | deriving (Eq, Show) 16 | 17 | data Vehicle = Car Manufacturer Price 18 | | Plane Airline Size 19 | deriving (Eq, Show) 20 | 21 | myCar = Car Mini (Price 14000) 22 | urCar = Car Mazda (Price 20000) 23 | clownCar = Car Tata (Price 7000) 24 | doge = Plane PapuAir (Size 42) 25 | 26 | -- Question 1 27 | -- The type of `MyCar` is `MyCar :: Vehicle` 28 | 29 | -- Question 2 30 | isCar :: Vehicle -> Bool 31 | isCar (Car _ _) = True 32 | isCar _ = False 33 | 34 | isPlane :: Vehicle -> Bool 35 | isPlane (Plane _ _) = True 36 | isPlane _ = False 37 | 38 | areCars :: [Vehicle] -> [Bool] 39 | areCars = map isCar 40 | 41 | -- Question 3 42 | getManu :: Vehicle -> Manufacturer 43 | getManu (Car m _) = m 44 | getManu _ = error "This should not happen!" 45 | 46 | -- Question 4 47 | -- An error would be thrown if `getManu` is used on `Plane` data. 48 | 49 | -- Question 5 50 | -- c.f. above 51 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/WhatMakesDataTypesAlgebraic/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | 1. The cardinality of `data PugType = PugData` is 1. 2 | 3 | 2. The cardinality of 4 | ```haskell 5 | data Airline = PapuAir 6 | | CatapultsR'Us 7 | | TakeYourChancesUnited 8 | ``` 9 | is 3. 10 | 11 | 3. The cardinality of `Int16` is 65536. 12 | 13 | 4. For `Int`, we have 14 | ```haskell 15 | maxBound :: Int = 2 ^ 63 - 1 16 | minBound :: Int = - 2 ^ 63 17 | ``` 18 | whereas `Integer` is not bounded. 19 | 20 | 5. 2 ^ 8 = 256 21 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/WhatMakesDataTypesAlgebraic/NewType.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | module AlgebraicDataTypes.WhatMakesDataTypesAlgebraic.NewType where 4 | 5 | class TooMany a where 6 | tooMany :: a -> Bool 7 | 8 | instance TooMany Int where 9 | tooMany n = n > 42 10 | 11 | newtype Goats = Goats Int deriving (Eq, Show, TooMany) 12 | 13 | -- Question 1 14 | instance TooMany (Int, String) where 15 | tooMany (n, _) = n > 42 16 | 17 | -- Question 2 18 | instance TooMany (Int, Int) where 19 | tooMany (n', n'') = n' + n'' > 42 20 | 21 | -- Question3 22 | instance (Num a, TooMany a) => TooMany (a, a) where 23 | tooMany (n', n'') = (tooMany n') || (tooMany n'') 24 | -------------------------------------------------------------------------------- /src/AlgebraicDataTypes/WhatMakesDataTypesAlgebraic/SimpleDataTypesWithNullaryDataConstructors.md: -------------------------------------------------------------------------------- 1 | ```haskell 2 | data Example = MakeExample deriving Show 3 | ``` 4 | 5 | 1. The type of data constructor `MakeExample` is `Example`. We cannot query the type of a type constructor. 6 | 7 | 2. `:info Example` gives 8 | ```haskell 9 | data Example = MakeExample 10 | instance [safe] Show Exmaple 11 | ``` 12 | As we can see, one can tell what typeclass instances are defined for the Example type using `:info` in GHCi. 13 | 14 | 3. The type of `MakeExample` is still `Example` if a single type 15 | argument added to `MakeExample`. 16 | -------------------------------------------------------------------------------- /src/Applicative/ApplicativeInUse/ConstantExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.ConstantExercise ( 2 | Constant (..) 3 | ) where 4 | 5 | newtype Constant a b = Constant { getConstant :: a } 6 | deriving (Eq, Ord, Show) 7 | 8 | instance Functor (Constant a) where 9 | fmap _ (Constant a) = Constant a 10 | 11 | instance Monoid a => Applicative (Constant a) where 12 | pure _ = Constant mempty 13 | Constant a <*> Constant b = Constant $ a <> b 14 | -------------------------------------------------------------------------------- /src/Applicative/ApplicativeInUse/IdentityExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.IdentityExercise ( 2 | Identity (..) 3 | ) where 4 | 5 | newtype Identity a = Identity a 6 | deriving (Eq, Ord, Show) 7 | 8 | instance Functor Identity where 9 | fmap f (Identity a) = Identity $ f a 10 | 11 | instance Applicative Identity where 12 | pure = Identity 13 | Identity f <*> Identity a = Identity $ f a 14 | -------------------------------------------------------------------------------- /src/Applicative/ApplicativeInUse/MaybeExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.MaybeExercise () where 2 | 3 | maybe :: Maybe String 4 | maybe = const <$> Just "Hello" <*> pure "World" 5 | 6 | maybe' :: Maybe (Int, Int, String, [Int]) 7 | maybe' = (,,,) <$> Just 90 <*> Just 10 <*> Just "Tierness" <*> pure [1, 2, 3] 8 | -------------------------------------------------------------------------------- /src/Applicative/ApplicativeInUse/ShortExercises.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.ShortExercises () where 2 | 3 | import Data.List (elemIndex) 4 | 5 | -- Question 1 6 | added :: Maybe Integer 7 | added = fmap (+3) (lookup 3 $ zip [1, 2, 3] [4, 5, 6]) 8 | 9 | -- Question 2 10 | y :: Maybe Integer 11 | y = lookup 3 $ zip [1, 2, 3] [4, 5, 6] 12 | 13 | z :: Maybe Integer 14 | z = lookup 2 $ zip [1, 2, 3] [4, 5, 6] 15 | 16 | tupled :: Maybe (Integer, Integer) 17 | tupled = (,) <$> y <*> z 18 | 19 | -- Question 3 20 | x :: Maybe Int 21 | x = elemIndex 3 [1, 2, 3, 4, 5] 22 | 23 | y' :: Maybe Int 24 | y' = elemIndex 4 [1, 2, 3, 4, 5] 25 | 26 | max' :: Int -> Int -> Int 27 | max' = max 28 | 29 | maxed :: Maybe Int 30 | maxed = max' <$> x <*> y' 31 | 32 | -- Question 4 33 | xs = [1, 2, 3] 34 | ys = [4, 5, 6] 35 | 36 | x' :: Maybe Integer 37 | x' = lookup 3 $ zip xs ys 38 | 39 | y'' :: Maybe Integer 40 | y'' = lookup 2 $ zip xs ys 41 | 42 | summed :: Maybe Integer 43 | summed = fmap sum $ (,) <$> x' <*> y'' 44 | -------------------------------------------------------------------------------- /src/Applicative/ApplicativeLaws/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BoeingX/haskell-programming-from-first-principles/ffb637f536597f552a4e4567fee848ed27f3ba74/src/Applicative/ApplicativeLaws/.gitkeep -------------------------------------------------------------------------------- /src/Applicative/ChapterExercises/Combinations.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ChapterExercises.Combinations ( 2 | stops 3 | , vowels 4 | , combos 5 | ) where 6 | 7 | import Control.Applicative (liftA3) 8 | 9 | stops, vowels :: String 10 | stops = "pbtdkg" 11 | vowels = "aeiou" 12 | 13 | combos :: [a] -> [b] -> [c] -> [(a, b, c)] 14 | combos = liftA3 (,,) 15 | -------------------------------------------------------------------------------- /src/Applicative/ChapterExercises/SpecializeTypes.md: -------------------------------------------------------------------------------- 1 | Given a type that has an instance of Applicative, specialize the types of the methods. 2 | 3 | 1. `[]` 4 | ```haskell 5 | pure :: a -> [a] 6 | (<*>) :: [(a -> b)] -> [a] -> [b] 7 | ``` 8 | 9 | 2. `IO` 10 | ```haskell 11 | pure :: a -> IO a 12 | (<*>) :: IO (a -> b) -> IO a -> IO b 13 | ``` 14 | 15 | 3. `(,) a` 16 | ```haskell 17 | pure :: a -> (t, a) 18 | (<*>) :: (t, (a -> b)) -> (t, a) -> (t, b) 19 | ``` 20 | 21 | 4. `(->) e` 22 | ```haskell 23 | pure :: a -> (e -> a) 24 | (<*>) :: (e -> (a -> b)) -> (e -> a) -> (e -> b) 25 | ``` 26 | -------------------------------------------------------------------------------- /src/Applicative/YouKnewThisWasComing/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/BoeingX/haskell-programming-from-first-principles/ffb637f536597f552a4e4567fee848ed27f3ba74/src/Applicative/YouKnewThisWasComing/.gitkeep -------------------------------------------------------------------------------- /src/Applicative/ZipListMonoid/ListApplicativeExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ListApplicativeExercise ( 2 | List (..) 3 | , Arbitrary 4 | ) where 5 | 6 | import Test.QuickCheck 7 | 8 | data List a = Nil 9 | | Cons a (List a) 10 | deriving (Eq, Show) 11 | 12 | instance Functor List where 13 | fmap _ Nil = Nil 14 | fmap f (Cons a as) = Cons (f a) (fmap f as) 15 | 16 | instance Arbitrary a => Arbitrary (List a) where 17 | arbitrary = do 18 | a <- arbitrary 19 | as <- arbitrary 20 | elements [Nil, Cons a as] 21 | 22 | append :: List a -> List a -> List a 23 | append Nil ys = ys 24 | append (Cons x xs) ys = Cons x $ xs `append` ys 25 | 26 | {-- 27 | A naive version using explicit pattern matching 28 | instance Applicative List where 29 | pure a = Cons a Nil 30 | Nil <*> _ = Nil 31 | _ <*> Nil = Nil 32 | Cons f fs <*> Cons a as = pure (f a) `append` (f <$> as) `append` (fs <*> pure a) `append` (fs <*> as) 33 | --} 34 | 35 | fold :: (a -> b -> b) -> b -> List a -> b 36 | fold _ b Nil = b 37 | fold f b (Cons a as) = f a (fold f b as) 38 | 39 | concat' :: List (List a) -> List a 40 | concat' = fold append Nil 41 | 42 | flatMap :: (a -> List b) -> List a -> List b 43 | flatMap f = concat' . fmap f 44 | 45 | instance Applicative List where 46 | pure a = Cons a Nil 47 | Nil <*> _ = Nil 48 | _ <*> Nil = Nil 49 | fs <*> xs = flatMap (`fmap` xs) fs 50 | -- fs <*> xs = flatMap (\x -> fmap ($x) fs) xs also works, but the order is different 51 | -------------------------------------------------------------------------------- /src/Applicative/ZipListMonoid/ValidationExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ValidationExercise ( 2 | Sum (..) 3 | , Validation (..) 4 | ) where 5 | 6 | import Test.QuickCheck 7 | import Test.QuickCheck.Checkers 8 | 9 | data Sum a b = First a 10 | | Second b 11 | deriving (Eq, Show) 12 | 13 | instance Functor (Sum a) where 14 | fmap _ (First a) = First a 15 | fmap f (Second b) = Second $ f b 16 | 17 | instance Applicative (Sum a) where 18 | pure = Second 19 | First a <*> _ = First a 20 | _ <*> First a = First a 21 | Second f <*> Second b = Second $ f b 22 | 23 | instance (Arbitrary a, Arbitrary b) => Arbitrary (Sum a b) where 24 | arbitrary = do 25 | a <- arbitrary 26 | b <- arbitrary 27 | elements [First a, Second b] 28 | 29 | instance (Eq a, Eq b) => EqProp (Sum a b) where (=-=) = eq 30 | 31 | -- We rename Error and Success to Err and Succ 32 | -- since QuickCheck already exports these names 33 | data Validation e a = Err e 34 | | Succ a 35 | deriving (Eq, Show) 36 | 37 | -- same as Sum/Either 38 | instance Functor (Validation e) where 39 | fmap _ (Err e) = Err e 40 | fmap f (Succ a) = Succ $ f a 41 | 42 | -- This is different 43 | instance Monoid e => Applicative (Validation e) where 44 | pure = Succ 45 | Err e1 <*> Err e2 = Err $ e1 <> e2 46 | Err e <*> _ = Err e 47 | _ <*> Err e = Err e 48 | Succ f <*> Succ a = Succ $ f a 49 | 50 | instance (Arbitrary a, Arbitrary b) => Arbitrary (Validation a b) where 51 | arbitrary = do 52 | a <- arbitrary 53 | b <- arbitrary 54 | elements [Err a, Succ b] 55 | 56 | instance (Eq a, Eq b) => EqProp (Validation a b) where (=-=) = eq 57 | -------------------------------------------------------------------------------- /src/Applicative/ZipListMonoid/ZipListApplicativeExercise.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ZipListApplicativeExercise ( 2 | ZipList' (..) 3 | ) where 4 | 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Checkers 7 | import Applicative.ZipListMonoid.ListApplicativeExercise 8 | 9 | newtype ZipList' a = ZipList' (List a) 10 | deriving (Eq, Show) 11 | 12 | instance Functor ZipList' where 13 | fmap f (ZipList' xs) = ZipList' $ fmap f xs 14 | 15 | zipWith' :: (a -> b -> c) -> List a -> List b -> List c 16 | zipWith' _ Nil _ = Nil 17 | zipWith' _ _ Nil = Nil 18 | zipWith' f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith' f xs ys) 19 | 20 | instance Applicative ZipList' where 21 | pure = ZipList' . repeat' 22 | where repeat' a = Cons a (repeat' a) 23 | ZipList' fs <*> ZipList' xs = ZipList' $ zipWith' (\f x -> f x) fs xs 24 | 25 | instance Arbitrary a => Arbitrary (ZipList' a) where 26 | arbitrary = ZipList' <$> arbitrary 27 | 28 | take' :: Int -> List a -> List a 29 | take' _ Nil = Nil 30 | take' n (Cons a as) 31 | | n <= 0 = Nil 32 | | otherwise = Cons a (take' (n - 1) as) 33 | 34 | instance Eq a => EqProp (ZipList' a) where 35 | xs =-= ys = xs' `eq` ys' 36 | where xs' = let (ZipList' l) = xs 37 | in take' 3000 l 38 | ys' = let (ZipList' l) = ys 39 | in take' 3000 l 40 | -------------------------------------------------------------------------------- /src/BasicDatatypes/BasicDatatypes/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | Given the following datatype 4 | ```haskell 5 | data Mood = Blah | Woot deriving Show 6 | ``` 7 | 8 | 1. The type constructor is `Mood`. 9 | 10 | 2. If the function requires a `Mood` value, 11 | we could use `Blah` and `Woot`. 12 | 13 | 3. `changeMood :: Mood -> Woot` does not type check because 14 | `Woot` is a data constructor, not a type constructor. 15 | 16 | 4. We have 17 | ```haskell 18 | changeMood Blah = Woot 19 | changeMood _ = Blah 20 | ``` 21 | -------------------------------------------------------------------------------- /src/BasicDatatypes/ChapterExercises/Awesome.hs: -------------------------------------------------------------------------------- 1 | module BasicDatatypes.ChapterExercises.Awesome where 2 | 3 | awesome = ["Papuchon", "curry", ":)"] 4 | alsoAwesome = ["Quake", "The Simons"] 5 | allAwesome = [awesome, alsoAwesome] 6 | 7 | -- Question 1 8 | -- length :: [a] -> Int 9 | -- or length :: (Foldable t) => t a -> Int 10 | 11 | -- Question 2 12 | -- length [1, 2, 3, 4, 5] = 5 13 | -- length [(1, 2), (2, 3), (3, 4)] = 3 14 | -- length allAwesome = 2 15 | -- length (concat allAwesome) = 5 16 | 17 | -- Question 3 18 | -- 6 / 3 works 19 | -- but 6 / length [1, 2, 3] does not type check because 20 | -- Int has no instance of Fractional 21 | 22 | -- Question 4 23 | -- 6 `div` length [1, 2, 3] 24 | 25 | -- Question 5 26 | -- 2 + 3 == 5 :: Bool 27 | 28 | -- Question 6 29 | -- let x = 5 30 | -- x + 3 == 5 :: Bool 31 | 32 | -- Question 7 33 | q71 = length allAwesome == 2 34 | q72 = length ['1', 'a', '3', 'b'] 35 | q73 = length allAwesome + length awesome 36 | q74 = (8 == 8) && ('b' < 'a') 37 | q75 = (8 == 8) && True 38 | 39 | -- Question 8 40 | isPalindrome :: (Eq a) => [a] -> Bool 41 | isPalindrome x = x == reverse x 42 | 43 | -- Question 9 44 | myAbs :: Integer -> Integer 45 | myAbs x = if x < 0 then -x else x 46 | 47 | -- Question 10 48 | f :: (a, b) -> (c, d) -> ((b, d), (a, c)) 49 | f ab cd = ((snd ab, snd cd), (fst ab, fst cd)) 50 | -------------------------------------------------------------------------------- /src/BasicDatatypes/ChapterExercises/MatchTheFunctionNamesToTheirTypes.md: -------------------------------------------------------------------------------- 1 | # Match the function names to their types 2 | 3 | 1. c) `Show a => a -> String` is the type of `show`. 4 | 5 | 2. b) `Eq a => a -> a -> Bool` is the type of `==`. 6 | 7 | 3. a) `(a, b) -> a` is the type of `fst`. 8 | 9 | 4. d) `Num a => a -> a -> a` is the type of `(+)`. 10 | -------------------------------------------------------------------------------- /src/BasicDatatypes/ChapterExercises/ReadingSyntax.hs: -------------------------------------------------------------------------------- 1 | module BasicDatatypes.ChapterExercises.ReadingSyntax where 2 | 3 | -- Question 1 4 | x = (+) 5 | f xs = w `x` 1 6 | where w = length xs 7 | 8 | -- Question 2 9 | id' = \ x -> x 10 | 11 | -- Question 3 12 | head' = \ (x : xs) -> x 13 | 14 | -- Question 4 15 | f' (a, b) = a 16 | -------------------------------------------------------------------------------- /src/BasicDatatypes/ComparingValues/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module BasicDatatypes.ComparingValues.IntermissionExercises where 2 | 3 | -- Question 1 4 | a = not True && True 5 | 6 | -- Question 2 7 | b = not (5 == 6) 8 | 9 | -- Question 3 10 | c = (1 * 2) > 5 11 | 12 | -- Question 4 13 | d = "Merry" > "Happy" 14 | 15 | -- Question 5 16 | e = ['1', '2', '3'] ++ "look at me!" 17 | -------------------------------------------------------------------------------- /src/BasicLibraries/ChapterExercises/DifferenceList.hs: -------------------------------------------------------------------------------- 1 | module BasicLibraries.ChapterExercises.DifferenceList where 2 | 3 | newtype DList a = DL { unDL :: [a] -> [a] } 4 | 5 | empty :: DList a 6 | empty = DL id 7 | {-# INLINE empty #-} 8 | 9 | singleton :: a -> DList a 10 | singleton a = DL $ const [a] 11 | {-# INLINE singleton #-} 12 | 13 | toList :: DList a -> [a] 14 | toList xs = unDL xs [] 15 | {-# INLINE toList #-} 16 | 17 | -- Prepend a single element to a dlist. 18 | infixr `cons` 19 | cons :: a -> DList a -> DList a 20 | cons x xs = DL ((x:) . unDL xs) 21 | {-# INLINE cons #-} 22 | 23 | -- Append a single element to a dlist. 24 | infixl `snoc` 25 | snoc :: DList a -> a -> DList a 26 | snoc xs x = DL (unDL xs . (x:)) 27 | {-# INLINE snoc #-} 28 | 29 | -- Append dlists. 30 | append :: DList a -> DList a -> DList a 31 | append xs ys = DL $ unDL xs . unDL ys 32 | {-# INLINE append #-} 33 | -------------------------------------------------------------------------------- /src/BasicLibraries/ChapterExercises/Queue.hs: -------------------------------------------------------------------------------- 1 | module BasicLibraries.ChapterExercises.Queue where 2 | 3 | -- From Okasaki's Purely Functional Data Structures 4 | data Queue a = 5 | Queue { enqueue :: [a] 6 | , dequeue :: [a] 7 | } deriving (Eq, Show) 8 | 9 | -- adds an item 10 | push :: a -> Queue a -> Queue a 11 | push x (Queue [] []) = Queue [] [x] 12 | push x (Queue xs ys) = Queue (x : xs) ys 13 | 14 | pop :: Queue a -> Maybe (a, Queue a) 15 | pop (Queue [] []) = Nothing 16 | pop (Queue xs []) = Just (y, Queue [] ys) 17 | where (y : ys) = reverse xs 18 | pop (Queue xs (y : ys)) = Just (y, Queue xs ys) 19 | -------------------------------------------------------------------------------- /src/BuildingProjects/ChapterExercises/ModifyingCode/GimmePerson.hs: -------------------------------------------------------------------------------- 1 | module BuildingProjects.ChapterExercises.ModifyingCode.GimmePerson where 2 | 3 | import System.IO 4 | 5 | type Name = String 6 | type Age = Integer 7 | data Person = Person Name Age deriving Show 8 | data PersonInvalid = NameEmpty 9 | | AgeTooLow 10 | | PersonInvalidUnknown String 11 | deriving (Eq, Show) 12 | 13 | mkPerson :: Name -> Age -> Either PersonInvalid Person 14 | mkPerson name age 15 | | name /= "" && age > 0 = Right $ Person name age 16 | | name == "" = Left NameEmpty 17 | | not (age > 0) = Left AgeTooLow 18 | | otherwise = Left $ PersonInvalidUnknown $ 19 | "Name was: " ++ show name ++ 20 | " Age was: " ++ show age 21 | 22 | gimmePerson :: IO () 23 | gimmePerson = do 24 | hSetBuffering stdout NoBuffering 25 | putStr "Please input your name: " 26 | name <- getLine 27 | putStr "Please input your age: " 28 | age <- getLine 29 | let person = mkPerson name (read age :: Age) 30 | case person of 31 | Left NameEmpty -> putStrLn "Name empty!" 32 | Left AgeTooLow -> putStrLn "Age too low!" 33 | Left (PersonInvalidUnknown s) -> putStrLn s 34 | _ -> putStrLn $ "Yay! Successfully got a person: " ++ show person 35 | -------------------------------------------------------------------------------- /src/BuildingProjects/ChapterExercises/ModifyingCode/Palindrome.hs: -------------------------------------------------------------------------------- 1 | module BuildingProjects.ChapterExercises.ModifyingCode.Palindrome where 2 | 3 | import Control.Monad 4 | import Data.Char 5 | import System.Exit 6 | 7 | palindrome :: IO () 8 | palindrome = forever $ do 9 | line1 <- getLine 10 | case (line1 == reverse line1) of 11 | True -> putStrLn "It's a palindrome!" 12 | False -> do 13 | putStrLn "Nope!" 14 | exitSuccess 15 | 16 | palindrome' :: IO () 17 | palindrome' = forever $ do 18 | line1 <- getLine 19 | let line2 = (map toLower . filter isAlpha) line1 20 | case (line2 == reverse line2) of 21 | True -> putStrLn "It's a palindrome!" 22 | False -> do 23 | putStrLn "Nope!" 24 | exitSuccess 25 | -------------------------------------------------------------------------------- /src/BuildingProjects/ImportingModules/CheckYourUnderstanding.md: -------------------------------------------------------------------------------- 1 | Given the list of import 2 | ```haskell 3 | import qualified Control.Concurrent as CC 4 | import qualified Control.Concurrent.MVar as MV 5 | import qualified Data.ByteString.Char8 as B 6 | import qualified Data.Locator as DL 7 | import qualified Data.Time.Clock.POSIX as PSX 8 | import qualified Filesystem as FS 9 | import qualified Filesystem.Path.CurrentOS as FPC 10 | import qualified Network.Info as NI 11 | import qualified Safe 12 | import Control.Exception (mask, try) 13 | import Control.Monad (forever, when) 14 | import Data.Bits 15 | import Data.Bits.Bitwise (fromListBE) 16 | import Data.List.Split (chunksOf) 17 | import Database.Blacktip.Types 18 | import System.IO.Unsafe (unsafePerformIO) 19 | ``` 20 | 21 | 1. `forever` and `when` are imported from `Control.Monad`. 22 | 23 | 2. `Data.Bits` and `Database.Blacktip.Types` are both unqualified and imported in their entirety. 24 | 25 | 3. `Database.Blacktip.Types` probably defines a list of types for database operation. 26 | 27 | 4. Given moreover 28 | ```haskell 29 | writeTimestamp :: MV.MVar ServerState 30 | -> FPC.FilePath 31 | -> IO CC.ThreadId 32 | writeTimestamp s path = do 33 | CC.forkIO go 34 | where go = forever $ do 35 | ss <- MV.readMVar s 36 | mask $ \_ -> do 37 | FS.writeFile path (B.pack (show (ssTime ss))) 38 | -- sleep for 1 second 39 | CC.threadDelay 1000000 40 | ``` 41 | a) `MV` refers to `Control.Concurrent.MVar`, `FPC` refers to `Filesystem.Path.CurrentOS`, 42 | and `CC` refers to `Control.Concurrent`. 43 | b) `FS.writeFile` refers to `import qualified Filesystem as FS` 44 | c) `forever` comes from `Control.Monad`. 45 | -------------------------------------------------------------------------------- /src/ComposingTypes/IntermissionExercises/Bifunctor.hs: -------------------------------------------------------------------------------- 1 | module ComposingTypes.IntermissionExercises.Bifunctor where 2 | 3 | -- It’s a functor that can map over two type arguments instead of just one. 4 | class Bifunctor p where 5 | {-# MINIMAL bimap | first, second #-} 6 | bimap :: (a -> b) -> (c -> d) -> p a c -> p b d 7 | bimap f g = first f . second g 8 | 9 | first :: (a -> b) -> p a c -> p b c 10 | first f = bimap f id 11 | 12 | second :: (b -> c) -> p a b -> p a c 13 | second = bimap id 14 | 15 | 16 | -- Question 1 17 | data Deux a b = Deux a b 18 | 19 | instance Bifunctor Deux where 20 | bimap f g (Deux a b) = Deux (f a) (g b) 21 | 22 | -- Question 2 23 | data Const a b = Const a 24 | 25 | instance Bifunctor Const where 26 | bimap f _ (Const a) = Const (f a) 27 | 28 | -- Question 3 29 | data Drei a b c = Drei a b c 30 | 31 | instance Bifunctor (Drei a) where 32 | bimap f g (Drei a b c) = Drei a (f b) (g c) 33 | 34 | -- Question 4 35 | data SuperDrei a b c = SuperDrei a b 36 | 37 | instance Bifunctor (SuperDrei a) where 38 | bimap f _ (SuperDrei a b) = SuperDrei a (f b) 39 | 40 | -- Question 5 41 | data SemiDrei a b c = SemiDrei a 42 | 43 | instance Bifunctor (SemiDrei a) where 44 | bimap _ _ (SemiDrei a) = SemiDrei a 45 | 46 | -- Question 6 47 | data Quadriceps a b c d = Quadzzz a b c d 48 | 49 | instance Bifunctor (Quadriceps a b) where 50 | bimap f g (Quadzzz a b c d) = Quadzzz a b (f c) (g d) 51 | 52 | -- Question 7 53 | data Either' a b = Left' a | Right' b 54 | 55 | instance Bifunctor Either' where 56 | bimap f _ (Left' a) = Left' $ f a 57 | bimap _ g (Right' b) = Right' $ g b 58 | -------------------------------------------------------------------------------- /src/ComposingTypes/IntermissionExercises/FoldableAndTraversableForCompose.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | module ComposingTypes.IntermissionExercises.FoldableAndTraversableForCompose where 3 | 4 | newtype Compose f g a = Compose { getCompose :: f (g a) } 5 | deriving (Eq, Show) 6 | 7 | instance (Functor f, Functor g) => Functor (Compose f g) where 8 | fmap f (Compose fga) = Compose $ (fmap . fmap) f fga 9 | 10 | -- Foldable 11 | instance (Foldable f, Foldable g) => Foldable (Compose f g) where 12 | foldMap :: (Monoid m) => (a -> m) -> Compose f g a -> m 13 | foldMap h (Compose fga) = foldMap (foldMap h) fga 14 | 15 | -- Traversable 16 | instance (Traversable f, Traversable g) => Traversable (Compose f g) where 17 | traverse :: (Applicative h) => (a -> h b) -> Compose f g a -> h (Compose f g b) 18 | traverse ahb (Compose fga) = Compose <$> traverse (traverse ahb) fga 19 | -------------------------------------------------------------------------------- /src/ComposingTypes/Twinplicative/Exercise.hs: -------------------------------------------------------------------------------- 1 | module ComposingTypes.Twinplicative.Exercise where 2 | 3 | import Control.Applicative (liftA2) 4 | 5 | newtype Compose f g a = Compose { getCompose :: f (g a) } 6 | deriving (Eq, Show) 7 | 8 | instance (Functor f, Functor g) => Functor (Compose f g) where 9 | fmap f (Compose fga) = Compose $ (fmap . fmap) f fga 10 | 11 | instance (Applicative f, Applicative g) => Applicative (Compose f g) where 12 | pure = Compose . pure . pure 13 | Compose fgab <*> Compose fga = Compose $ liftA2 (<*>) fgab fga 14 | -------------------------------------------------------------------------------- /src/Foldable/ChapterExercises/WriteFilterFunction.hs: -------------------------------------------------------------------------------- 1 | module Foldable.ChapterExercises.WriteFilterFunction where 2 | 3 | filterF :: (Applicative f, Foldable f, Monoid (f a)) => (a -> Bool) -> f a -> f a 4 | filterF f = foldMap (\a -> if f a then pure a else mempty) 5 | -------------------------------------------------------------------------------- /src/Foldable/ChapterExercises/WriteFoldableInstances.hs: -------------------------------------------------------------------------------- 1 | module Foldable.ChapterExercises.WriteFoldableInstances where 2 | 3 | -- Question 1 4 | data Constant a b = Constant a 5 | deriving (Show, Eq) 6 | 7 | instance Foldable (Constant a) where 8 | foldMap _ (Constant a) = mempty 9 | 10 | data Two a b = Two a b 11 | deriving (Show, Eq) 12 | 13 | instance Foldable (Two a) where 14 | foldMap f (Two a b) = f b 15 | 16 | data Three a b c = Three a b c 17 | deriving (Show, Eq) 18 | 19 | instance Foldable (Three a b) where 20 | foldMap f (Three a b c) = f c 21 | 22 | data Three' a b = Three' a b b 23 | deriving (Show, Eq) 24 | 25 | instance Foldable (Three' a) where 26 | foldMap f (Three' a b b') = f b `mappend` f b' 27 | 28 | data Four' a b = Four' a b b b 29 | deriving (Show, Eq) 30 | 31 | instance Foldable (Four' a) where 32 | foldMap f (Four' a b b' b'') = mconcat [f b, f b', f b''] 33 | -------------------------------------------------------------------------------- /src/Foldable/SomeBasicDerivedOperations/Exercises.hs: -------------------------------------------------------------------------------- 1 | module Foldable.SomeBasicDerivedOperations.Exercises where 2 | 3 | import Data.Monoid 4 | 5 | -- Question 1 6 | sum' :: (Foldable t, Num a) => t a -> a 7 | sum' = getSum . foldMap Sum 8 | 9 | -- Question 2 10 | product' :: (Foldable t, Num a) => t a -> a 11 | product' = getProduct . foldMap Product 12 | 13 | -- Question 3 14 | elem' :: (Foldable t, Eq a) => a -> t a -> Bool 15 | elem' t = foldr (\x acc -> x == t || acc) False 16 | 17 | -- Question 4 18 | minimum' :: (Foldable t, Ord a) => t a -> Maybe a 19 | minimum' = foldr comp Nothing 20 | where comp x Nothing = Just x 21 | comp x y = fmap (min x) y 22 | 23 | -- Question 5 24 | maximum' :: (Foldable t, Ord a) => t a -> Maybe a 25 | maximum' = foldr comp Nothing 26 | where comp x Nothing = Just x 27 | comp x y = fmap (max x) y 28 | 29 | -- Question 6 30 | null' :: (Foldable t) => t a -> Bool 31 | null' = foldr (\x acc -> False) True 32 | 33 | -- Question 7 34 | length' :: (Foldable t) => t a -> Int 35 | length' = foldr (\x acc -> acc + 1) 0 36 | 37 | -- Question 8 38 | toList' :: (Foldable t) => t a -> [a] 39 | toList' = foldr (:) [] 40 | 41 | -- Question 9 42 | fold' :: (Foldable t, Monoid m) => t m -> m 43 | fold' = foldMap id 44 | 45 | -- Question 10 46 | foldMap' :: (Foldable t, Monoid m) => (a -> m) -> t a -> m 47 | foldMap' f = foldr (\x acc -> f x `mappend` acc) mempty 48 | -------------------------------------------------------------------------------- /src/FoldingLists/ChapterExercises/RewritingFunctionsUsingFolds.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.ChapterExercises.RewritingFunctionsUsingFolds where 2 | 3 | myOr :: [Bool] -> Bool 4 | myOr = foldr (||) False 5 | 6 | myAny :: (a -> Bool) -> [a] -> Bool 7 | myAny f = foldr go True 8 | where go x = (&&) (f x) 9 | 10 | myElem :: Eq a => a -> [a] -> Bool 11 | myElem x = any ((==) x) 12 | 13 | myReverse :: [a] -> [a] 14 | myReverse = foldl (flip (:)) [] 15 | 16 | myMap :: (a -> b) -> [a] -> [b] 17 | myMap f = foldr (\x acc -> f x : acc) [] 18 | 19 | myFilter :: (a -> Bool) -> [a] -> [a] 20 | myFilter f = foldr (\x acc -> if f x then x : acc else acc) [] 21 | 22 | squish :: [[a]] -> [a] 23 | squish = foldr (++) [] 24 | 25 | squishMap :: (a -> [b]) -> [a] -> [b] 26 | squishMap f = foldr (\x acc -> f x ++ acc) [] 27 | 28 | squishAgain :: [[a]] -> [a] 29 | squishAgain = squishMap id 30 | 31 | myMaximumBy :: (a -> a -> Ordering) -> [a] -> a 32 | myMaximumBy f = foldr1 go 33 | where go x acc = case f x acc of 34 | GT -> x 35 | otherwise -> acc 36 | 37 | myMinimumBy :: (a -> a -> Ordering) -> [a] -> a 38 | myMinimumBy f = foldr1 go 39 | where go x acc = case f x acc of 40 | LT -> x 41 | otherwise -> acc 42 | 43 | -------------------------------------------------------------------------------- /src/FoldingLists/ChapterExercises/WarmUpAndReview.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.ChapterExercises.WarmUpAndReview where 2 | 3 | -- Question 1 4 | stops = "pbtdkg" 5 | vowels = "aeiou" 6 | 7 | stopVowelStop :: [(Char, Char, Char)] 8 | stopVowelStop = [(x, y, z) | x <- stops, y <- vowels, z <- stops] 9 | 10 | stopVowelStop' :: [(Char, Char, Char)] 11 | stopVowelStop' = filter go stopVowelStop 12 | where go ('p', _, _) = True 13 | go _ = False 14 | 15 | -- Question 2 16 | -- This function calculates the average word length in a sentence 17 | seekritFunc x = 18 | div (sum (map length (words x))) 19 | (length (words x)) 20 | 21 | -- Question 3 22 | seekritFunc' x = y / z 23 | where y = fromIntegral $ sum $ map length $ words x 24 | z = fromIntegral $ length $ words x 25 | -------------------------------------------------------------------------------- /src/FoldingLists/FoldLeft/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | ## Question 1 2 | 3 | `foldr (*) 1 [1..5]` will return the same result as 4 | `b) foldl (flip (*)) 1 [1..5]` and 5 | `c) foldl (*) 1 [1..5]`. 6 | 7 | ## Question 2 8 | 9 | ```haskell 10 | foldl (flip (*)) 1 [1..3] 11 | flip (*) (flip (*) (flip (*) 1 1) 2) 3 12 | flip (*) (flip (*) (1 * 1) 2) 3 13 | flip (*) (flip (*) 1 2) 3 14 | flip (*) (2 * 1) 3 15 | flip (*) 2 3 16 | 3 * 2 17 | 6 18 | ``` 19 | 20 | ## Question 3 21 | 22 | One difference between `foldr` and `foldl` is 23 | `c) foldr , but not foldl , associates to the right`. 24 | 25 | ## Question 4 26 | 27 | Folds are catamorphisms, 28 | which means they are generally used to 29 | `a) reduce structure`. 30 | 31 | ## Question 5 32 | 33 | a) foldr (++) "" ["woot", "WOOT", "woot"] 34 | b) foldr max 'a' "fear is the little death" 35 | c) foldr (&&) True [False, True] 36 | d) foldr (||) False [False, True] 37 | e) foldl (\acc x -> acc ++ show x) "" [1..5] 38 | f) foldl const 'a' [1..5] 39 | g) foldl const 0 "tacos" 40 | h) foldr (flip const) 0 "burritos" 41 | i) foldr (flip const) 'z' [1..5] 42 | -------------------------------------------------------------------------------- /src/FoldingLists/HowToWriteFoldFunctions/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.HowToWriteFoldFunctions.IntermissionExercises where 2 | 3 | import Data.List 4 | import Data.Ord 5 | import Data.Time 6 | 7 | data DatabaseItem = DbString String 8 | | DbNumber Integer 9 | | DbDate UTCTime 10 | deriving (Eq, Ord, Show) 11 | 12 | -- Question 1 13 | filterDbDate :: [DatabaseItem] -> [UTCTime] 14 | filterDbDate = foldr go [] 15 | where go (DbDate t) acc = t : acc 16 | go _ acc = acc 17 | 18 | -- Question 2 19 | filterDbNumber :: [DatabaseItem] -> [Integer] 20 | filterDbNumber = foldr go [] 21 | where go (DbNumber x) acc = x : acc 22 | go _ acc = acc 23 | 24 | -- Question 3 25 | -- Descending sort https://ro-che.info/articles/2016-04-02-descending-sort-haskell 26 | mostRecent :: [DatabaseItem] -> UTCTime 27 | mostRecent = head . sortOn Down . filterDbDate 28 | 29 | -- Question 4 30 | sumDb :: [DatabaseItem] -> Integer 31 | sumDb = sum . filterDbNumber 32 | 33 | -- Question 5 34 | avgDb :: [DatabaseItem] -> Double 35 | avgDb = avg . filterDbNumber 36 | where avg :: [Integer] -> Double 37 | avg xs = s / l 38 | where s = fromIntegral $ sum xs 39 | l = fromIntegral $ length xs 40 | -------------------------------------------------------------------------------- /src/FoldingLists/Scans/ScansExercises.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.Scans.ScansExercises where 2 | 3 | import Data.List 4 | 5 | -- Question 1 6 | fibs :: [Integer] 7 | fibs = scanl (+) 1 fibs 8 | 9 | fibs' :: [Integer] 10 | fibs' = take 20 fibs 11 | 12 | -- Question 2 13 | fibs'' :: [Integer] 14 | fibs'' = takeWhile (<100) fibs 15 | 16 | -- Question 3 17 | factorial :: [Integer] 18 | factorial = scanl (*) 1 [2..] 19 | -------------------------------------------------------------------------------- /src/Functor/ChapterExercises/DetermineIfAValidFunctorCanBeWritten.md: -------------------------------------------------------------------------------- 1 | 1. `data Bool = False | True` 2 | 3 | Impossible, because the kind of \inlinecode{Bool} is \inlinecode{*}. 4 | 5 | 2. `data BoolAndSomethingElse a = False' a | True' a` 6 | 7 | Yes, since the kind of \inlinecode{BoolAndSomethingElse a} is \inlinecode{* -> *}. 8 | 9 | 3. `data BoolAndMaybeSomethingElse a = Falsish | Truish a` 10 | 11 | Yes, same argument as above. 12 | 13 | 4. `newtype Mu f = InF { outF :: f (Mu f) }` 14 | 15 | Yes, same argument as above. 16 | 17 | 5. Define 18 | ```haskell 19 | import GHC.Arr 20 | data D = D (Array Word Word) Int Int 21 | ``` 22 | No, because the kind of \inlinecode{D} is \inlinecode{*}. 23 | -------------------------------------------------------------------------------- /src/Functor/ChapterExercises/RearrangeArguments.hs: -------------------------------------------------------------------------------- 1 | module Functor.ChapterExercises.RearrangeArguments ( 2 | More (..) 3 | ) where 4 | 5 | data Sum a b = First a | Second b 6 | 7 | instance Functor (Sum e) where 8 | fmap _ (First a) = First a 9 | fmap f (Second b) = Second $ f b 10 | 11 | data Company a b c = DeepBlue a c | Something b 12 | instance Functor (Company e e') where 13 | fmap f (DeepBlue a c) = DeepBlue a (f c) 14 | fmap _ (Something b) = Something b 15 | 16 | data More a b = L b a b | R a b a 17 | deriving (Eq, Show) 18 | instance Functor (More x) where 19 | fmap f (L a b a') = L (f a) b (f a') 20 | fmap f (R b a b') = R b (f a) b' 21 | -------------------------------------------------------------------------------- /src/Functor/CommonlyUsedFunctors/LiftingExercises.hs: -------------------------------------------------------------------------------- 1 | module Functor.CommonlyUsedFunctors.LiftingExercises ( 2 | a 3 | , b 4 | , c 5 | , d 6 | , e 7 | ) where 8 | 9 | a = fmap (+1) $ read "[1]" :: [Int] 10 | 11 | b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"]) 12 | 13 | c = (*2) . (\x -> x - 2) 14 | 15 | d = ((return '1' ++) . show) . (\x -> [x, 1..3]) 16 | 17 | e :: IO Integer 18 | e = let ioi = readIO "1" :: IO Integer 19 | changed = fmap (read . ("123"++) . show) ioi 20 | in fmap (*3) changed 21 | -------------------------------------------------------------------------------- /src/Functor/IgnoringPossibilities/ShortExercise.hs: -------------------------------------------------------------------------------- 1 | module Functor.IgnoringPossibilities.ShortExercise ( 2 | Possibly (..) 3 | , Sum (..) 4 | ) where 5 | 6 | import Test.QuickCheck 7 | 8 | data Possibly a = LolNope 9 | | Yeppers a 10 | deriving (Eq, Show) 11 | 12 | instance Functor Possibly where 13 | fmap _ LolNope = LolNope 14 | fmap f (Yeppers a) = Yeppers $ f a 15 | 16 | instance (Arbitrary a) => Arbitrary (Possibly a) where 17 | arbitrary = do 18 | a <- arbitrary 19 | elements [LolNope, Yeppers a] 20 | 21 | data Sum a b = First a 22 | | Second b 23 | deriving (Eq, Show) 24 | 25 | instance Functor (Sum a) where 26 | fmap _ (First a) = First a 27 | fmap f (Second b) = Second $ f b 28 | 29 | instance (Arbitrary a, Arbitrary b) => Arbitrary (Sum a b) where 30 | arbitrary = do 31 | a <- arbitrary 32 | b <- arbitrary 33 | elements [First a, Second b] 34 | -------------------------------------------------------------------------------- /src/Functor/LetUsTalkAboutF/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | 1. The kind of `a` such that `a -> a` is `*`. 2 | 3 | 2. In `a -> b a -> T (b a)`, the kind of `b` is `* -> *`, 4 | that of `T` is also `* -> *`. 5 | 6 | 3. Given `c a b -> c b a`, the kind of `c` is `* -> * -> *`. 7 | -------------------------------------------------------------------------------- /src/Lists/ChapterExercises/Char.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.Char where 2 | 3 | import Data.Char 4 | 5 | -- Question 2 6 | keepOnlyUppercase :: String -> String 7 | keepOnlyUppercase = filter isUpper 8 | 9 | -- Question 3 10 | captializeFirstLetter :: String -> String 11 | captializeFirstLetter (x:xs) = toUpper x : xs 12 | 13 | -- Question 4 14 | captialize :: String -> String 15 | captialize "" = "" 16 | captialize (x:xs) = toUpper x : captialize xs 17 | 18 | -- Question 5 19 | captializeFirstLetter' :: String -> Char 20 | captializeFirstLetter' = head . captializeFirstLetter 21 | -------------------------------------------------------------------------------- /src/Lists/ChapterExercises/Ciphers.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.Ciphers where 2 | 3 | import Data.Char 4 | 5 | chars :: [Char] 6 | chars = ['a'..'z'] ++ ['A'..'Z'] 7 | 8 | caesar :: Int -> String -> String 9 | caesar _ "" = "" 10 | caesar n (x : xs) 11 | | not $ x `elem` chars = x : caesar n xs 12 | | otherwise = let base = if isUpper x then ord 'A' else ord 'a' 13 | x' = chr $ ((ord x + n) - base) `mod` 26 + base 14 | in x' : caesar n xs 15 | 16 | unCaesar :: Int -> String -> String 17 | unCaesar _ "" = "" 18 | unCaesar n (x : xs) 19 | | not $ x `elem` chars = x : unCaesar n xs 20 | | otherwise = let base = if isUpper x then ord 'A' else ord 'a' 21 | x' = chr $ ((ord x - n) - base) `mod` 26 + base 22 | in x' : unCaesar n xs 23 | -------------------------------------------------------------------------------- /src/Lists/ChapterExercises/WritingYourOwnStandardFunctions.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.WritingYourOwnStandardFunctions where 2 | 3 | -- Question 1 4 | myOr :: [Bool] -> Bool 5 | myOr [] = False 6 | myOr (x : xs) 7 | | x = True 8 | | otherwise = myOr xs 9 | 10 | -- Question 2 11 | myAny :: (a -> Bool) -> [a] -> Bool 12 | myAny _ [] = False 13 | myAny f (x : xs) 14 | | f x = True 15 | | otherwise = myAny f xs 16 | 17 | -- Question 3 18 | myElem :: Eq a => a -> [a] -> Bool 19 | myElem x = myAny (==x) 20 | 21 | -- Question 4 22 | myReverse :: [a] -> [a] 23 | myReverse [] = [] 24 | myReverse (x : xs) = myReverse xs ++ [x] 25 | 26 | -- Question 5 27 | squish :: [[a]] -> [a] 28 | squish [] = [] 29 | squish (x : xs) = x ++ squish xs 30 | 31 | -- Question 6 32 | squishMap :: (a -> [b]) -> [a] -> [b] 33 | squishMap _ [] = [] 34 | squishMap f (x : xs) = f x ++ squishMap f xs 35 | 36 | -- Question 7 37 | squishAgain :: [[a]] -> [a] 38 | squishAgain = squishMap id 39 | 40 | -- Question 8 41 | myMaximumBy :: (a -> a -> Ordering) -> [a] -> a 42 | myMaximumBy _ [x] = x 43 | myMaximumBy f (x : xs) = case f x y of 44 | GT -> x 45 | otherwise -> y 46 | where y = myMaximumBy f xs 47 | 48 | -- Question 9 49 | myMinimumBy :: (a -> a -> Ordering) -> [a] -> a 50 | myMinimumBy _ [x] = x 51 | myMinimumBy f (x : xs) = case f x y of 52 | LT -> x 53 | otherwise -> y 54 | where y = myMinimumBy f xs 55 | 56 | -- Question 10 57 | myMaximum :: (Ord a) => [a] -> a 58 | myMaximum = myMaximumBy compare 59 | 60 | -- Question 11 61 | myMinimum :: (Ord a) => [a] -> a 62 | myMinimum = myMinimumBy compare 63 | -------------------------------------------------------------------------------- /src/Lists/ExtractingPortionsOfLists/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module Lists.ExtractingPortionsOfLists.IntermissionExercises where 2 | 3 | -- Question 1 4 | splitBy :: Char -> String -> [String] 5 | splitBy _ "" = [] 6 | splitBy x xs = let xs' = dropWhile (== x) xs 7 | w = takeWhile (/= x) xs' 8 | ws = dropWhile (/= x) xs' 9 | in if null w 10 | then splitBy x ws 11 | else w : splitBy x ws 12 | 13 | myWords :: String -> [String] 14 | myWords = splitBy ' ' 15 | 16 | 17 | myLines :: String -> [String] 18 | myLines = splitBy '\n' 19 | -------------------------------------------------------------------------------- /src/Lists/FilteringListsOfValues/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module Lists.FilteringListsOfValues.IntermissionExercises where 2 | 3 | -- Question 1 4 | multiplesOfThree :: [Int] -> [Int] 5 | multiplesOfThree = filter (\x -> x `rem` 3 == 0) 6 | 7 | -- Question 2 8 | howManyMultiplesOfThree :: [Int] -> Int 9 | howManyMultiplesOfThree = length . multiplesOfThree 10 | 11 | -- Question 3 12 | removeArticles :: String -> [String] 13 | removeArticles = filter (\x -> not (x `elem` ["the", "a", "an"])) . words 14 | -------------------------------------------------------------------------------- /src/Lists/ListComprehensions/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module Lists.ListComprehensions.IntermissionExercises where 2 | 3 | mySqr = [x^2 | x <- [1..5]] 4 | myCube = [y^3 | y <- [1..5]] 5 | 6 | -- Question 1 7 | mySqrCube = [(x, y) | x <- mySqr, y <- myCube] 8 | 9 | -- Question 2 10 | mySqrCube' = [(x, y) | x <- mySqr, y <- myCube, x <= 50, y<= 50] 11 | 12 | -- Question 3 13 | len = length mySqrCube' 14 | -------------------------------------------------------------------------------- /src/Lists/SpinesAndNonStrictEvaluation/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | ## Will this blow up? 2 | 3 | 1. `[x^y | x <- [1..5], y <- [2, undefined]]` returns the bottom. 4 | 5 | 2. `take 1 $ [x^y | x <- [1..5], y <- [2, undefined]]` returns `1`. 6 | 7 | 3. `sum [1, undefined, 3]` returns the bottom. 8 | 9 | 4. `length [1, 2, undefined]` returns `3`. 10 | 11 | 5. `length $ [1, 2, 3] ++ undefined` returns the bottom because the bottom is part of the spine. 12 | 13 | 6. `take 1 $ filter even [1, 2, 3, undefined]` returns `2`. 14 | 15 | 7. `take 1 $ filter even [1, 3, undefined]` returns the bottom. 16 | 17 | 8. `take 1 $ filter odd [1, 3, undefined]` returns `1`. 18 | 19 | 9. `take 2 $ filter odd [1, 3, undefined]` returns `[1,3]`. 20 | 21 | 10. `take 3 $ filter odd [1, 3, undefined]` returns the bottom. 22 | 23 | ## Is it in normal form? 24 | 25 | 1. `[1, 2, 3, 4, 5]` is in NF. 26 | 27 | 2. `1 : 2 : 3 : 4 : _` is in WHNF. 28 | 29 | 3. `enumFromTo 1 10` is in neither NF nor WHNF. 30 | 31 | 4. `length [1, 2, 3, 4, 5]` is in neither NF nor WHNF. 32 | 33 | 5. `sum (enumFromTo 1 10)` is in neither NF nor WHNF. 34 | 35 | 6. `['a'..'m'] ++ ['n'..'z']` is in neither NF nor WHNF. 36 | 37 | 7. `(_, 'b')` is in WHNF. 38 | -------------------------------------------------------------------------------- /src/Lists/TransformingListsOfValues/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. `take 1 $ map (+1) [undefined, 2, 3]` returns the bottom. 4 | 5 | 2. `take 1 $ map (+1) [1, undefined, 3]` returns `2`. 6 | 7 | 3. `take 2 $ map (+1) [1, undefined, 3]` returns the bottom. 8 | 9 | 4. `itIsMystery xs = map (\x -> elem x "aeiou") xs` has type `itIsMystery :: String -> [Bool]` 10 | which tells if each character a vowel. 11 | 12 | 5. We have 13 | a) `map (^2) [1..10] = [1, 2, 4, ..., 100]`. 14 | b) `map minimum [[1..10], [10..20], [20..30]] = [1, 10, 20]`. 15 | c) `map sum [[1..5], [1..5], [1..5]] = [15, 15, 15]` 16 | 17 | 6. `map (\x -> if x == 3 then (-x) else (x)) [1..10]` could be rewritten as follows 18 | ```haskell 19 | import Data.Bool 20 | 21 | map (\x -> bool (-x) x (x == 3)) [1..10] 22 | ``` 23 | -------------------------------------------------------------------------------- /src/Lists/UsingRangesToConstructLists/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Lists.UsingRangesToConstructLists.Exercise where 2 | 3 | eftBool :: Bool -> Bool -> [Bool] 4 | eftBool x y 5 | | x == y = [x] 6 | eftBool False _ = [False, True] 7 | eftBool True False = [] 8 | 9 | eftOrd :: Ordering -> Ordering -> [Ordering] 10 | eftOrd x y 11 | | x == y = [x] 12 | | x > y = [] 13 | | otherwise = x : eftOrd (succ x) y 14 | 15 | eftInt :: Int -> Int -> [Int] 16 | eftInt x y 17 | | x == y = [x] 18 | | x > y = [] 19 | | otherwise = x : eftInt (succ x) y 20 | 21 | eftChar :: Char -> Char -> [Char] 22 | eftChar x y 23 | | x == y = [x] 24 | | x > y = [] 25 | | otherwise = x : eftChar (succ x) y 26 | -------------------------------------------------------------------------------- /src/Lists/ZippingLists/ZippingExercises.hs: -------------------------------------------------------------------------------- 1 | module Lists.ZippingLists.ZippingExercises where 2 | 3 | -- Question 1 4 | zip' :: [a] -> [b] -> [(a, b)] 5 | zip' [] _ = [] 6 | zip' _ [] = [] 7 | zip' (x:xs) (y:ys) = (x, y) : zip' xs ys 8 | 9 | -- Question 2 10 | zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c] 11 | zipWith' _ [] _ = [] 12 | zipWith' _ _ [] = [] 13 | zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys 14 | 15 | -- Question 3 16 | zip'' :: [a] -> [b] -> [(a, b)] 17 | zip'' = zipWith' (,) 18 | -------------------------------------------------------------------------------- /src/Monad/ChapterExercises/RewriteFunctions.hs: -------------------------------------------------------------------------------- 1 | module Monad.ChapterExercises.RewriteFunctions where 2 | 3 | -- Question 1 4 | j :: Monad m => m (m a) -> m a 5 | j m = m >>= id 6 | -- or even j = join 7 | 8 | -- Question 2 9 | l1 :: Monad m => (a -> b) -> m a -> m b 10 | l1 = fmap 11 | 12 | -- Question 3 13 | l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c 14 | l2 f a b = f <$> a <*> b 15 | -- or even l2 = liftA2 16 | 17 | -- Question 4 18 | a :: Monad m => m a -> m (a -> b) -> m b 19 | a = flip (<*>) 20 | 21 | -- Question 5 22 | meh :: Monad m => [a] -> (a -> m b) -> m [b] 23 | meh [] _ = return [] 24 | meh (x:xs) f = (:) <$> (f x) <*> (meh xs f) 25 | 26 | -- Question 6 27 | flipType :: (Monad m) => [m a] -> m [a] 28 | flipType = flip meh id 29 | -------------------------------------------------------------------------------- /src/Monad/ExampleOfMonadUse/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Monad.ExampleOfMonadUse.Exercise where 2 | 3 | import Test.QuickCheck 4 | import Test.QuickCheck.Checkers 5 | 6 | data Sum a b = 7 | First a 8 | | Second b 9 | deriving (Eq, Show) 10 | 11 | instance Functor (Sum a) where 12 | fmap _ (First a) = First a 13 | fmap f (Second b) = Second $ f b 14 | 15 | instance Applicative (Sum a) where 16 | pure = Second 17 | First a <*> _ = First a 18 | Second b <*> First a = First a 19 | Second b <*> Second b' = Second $ b b' 20 | 21 | instance Monad (Sum a) where 22 | return = pure 23 | First a >>= _ = First a 24 | Second b >>= f = f b 25 | 26 | instance (Arbitrary a, Arbitrary b) => Arbitrary (Sum a b) where 27 | arbitrary = do 28 | a <- arbitrary 29 | b <- arbitrary 30 | elements [First a, Second b] 31 | 32 | instance (Eq a, Eq b) => EqProp (Sum a b) where (=-=) = eq 33 | -------------------------------------------------------------------------------- /src/Monad/Monad/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Monad.Monad.Exercise where 2 | 3 | import Control.Monad (join) 4 | 5 | bind :: Monad m => (a -> m b) -> m a -> m b 6 | bind f = join . fmap f 7 | -------------------------------------------------------------------------------- /src/MonadTransformers/ChapterExercises/FixTheCode.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.ChapterExercises.FixTheCode where 2 | 3 | import Control.Monad.Trans.Maybe 4 | import Control.Monad.Trans.Class 5 | import Control.Monad 6 | 7 | isValid :: String -> Bool 8 | isValid v = '!' `elem` v 9 | 10 | maybeExcite :: MaybeT IO String 11 | maybeExcite = do 12 | -- v :: String because MaybeT IO String is a monad 13 | -- |_______| |____| 14 | -- m a 15 | -- thus v :: a, i.e. v :: String 16 | v <- (lift :: IO String -> MaybeT IO String) getLine 17 | guard $ isValid (v :: String) 18 | return v 19 | 20 | doExcite :: IO () 21 | doExcite = do 22 | putStrLn "say something excite!" 23 | -- excite :: Maybe String because (runMaybeT maybeExcite) :: IO (Maybe String) 24 | -- |__| |___________| 25 | -- m a 26 | excite <- runMaybeT (maybeExcite :: MaybeT IO String) 27 | case excite of 28 | Nothing -> putStrLn "MOAR EXCITE" 29 | Just e -> putStrLn ("Good, was very excite: " ++ e) 30 | -------------------------------------------------------------------------------- /src/MonadTransformers/ChapterExercises/Morra.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.ChapterExercises.Morra where 2 | 3 | import Control.Monad 4 | import Control.Monad.Trans.State 5 | import System.Exit 6 | import System.Random 7 | 8 | data GameState = GameState { 9 | score1 :: Int 10 | , score2 :: Int 11 | , trigram :: [Int] 12 | } 13 | deriving (Eq, Show) 14 | 15 | gameOver :: GameState -> IO () 16 | gameOver (GameState s1 s2 _) 17 | | s1 < 3 && s2 < 3 = return () 18 | | otherwise = do 19 | putStrLn "- Game over" 20 | putStrLn $ "- Player got " ++ show s1 ++ " points" 21 | putStrLn $ "- Computer got " ++ show s2 ++ " points" 22 | if s1 == 3 then 23 | putStrLn "- Player wins the game" 24 | else 25 | putStrLn "- Computer wins the game" 26 | exitSuccess 27 | 28 | makeMove :: GameState -> IO Int 29 | makeMove s = do 30 | let t = trigram s 31 | c1 = length $ filter (==1) t 32 | c2 = length $ filter (==2) t 33 | case compare c1 c2 of 34 | GT -> return 1 35 | LT -> return 2 36 | EQ -> randomRIO (1, 2) 37 | 38 | updateTrigram :: Int -> [Int] -> [Int] 39 | updateTrigram x xs = take 3 (x : xs) 40 | 41 | game :: StateT GameState IO Int 42 | game = forever $ StateT $ \s -> do 43 | p1 <- (read <$> getLine) :: IO Int 44 | putStrLn $ "P: " ++ show p1 45 | p2 <- makeMove s 46 | putStrLn $ "C: " ++ show p2 47 | let p = p1 + p2 48 | if odd p then 49 | putStrLn "- P wins" 50 | else 51 | putStrLn "- C wins" 52 | let (s1, s2) = if odd p then 53 | (score1 s +1, score2 s) 54 | else 55 | (score1 s, score2 s + 1) 56 | t = updateTrigram p1 $ trigram s 57 | newGameState = GameState s1 s2 t 58 | gameOver newGameState 59 | return (p, newGameState) 60 | 61 | main :: IO () 62 | main = do 63 | putStrLn "-- p is Player" 64 | putStrLn "-- c is Computer" 65 | putStrLn "-- Player is odds, computer is evens." 66 | (a, s) <- runStateT game (GameState 0 0 []) 67 | return () 68 | -------------------------------------------------------------------------------- /src/MonadTransformers/ChapterExercises/WriteTheCode.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.ChapterExercises.WriteTheCode where 2 | 3 | import Control.Monad.Trans.Reader 4 | import Control.Monad.Trans.State 5 | import Data.Functor.Identity 6 | 7 | -- Question 1 8 | rDec :: Num a => Reader a a 9 | rDec = ReaderT $ \r -> Identity (r - 1) 10 | 11 | -- Question 2 12 | rDec' :: Num a => Reader a a 13 | rDec' = ReaderT $ fmap Identity ((-1) + ) 14 | 15 | -- Question 3 16 | rShow :: Show a => ReaderT a Identity String 17 | rShow = ReaderT $ \a -> Identity (show a) 18 | 19 | -- Question 4 20 | rShow' :: Show a => ReaderT a Identity String 21 | rShow' = ReaderT (fmap Identity show) 22 | 23 | -- Question 5 24 | rPrintAndInc :: (Num a, Show a) => ReaderT a IO a 25 | rPrintAndInc = ReaderT $ \r -> do 26 | putStrLn $ "Hi: " ++ show r 27 | return $ r + 1 28 | 29 | -- Question 6 30 | sPrintIncAccum :: (Num a, Show a) => StateT a IO String 31 | sPrintIncAccum = StateT $ \s -> do 32 | putStrLn $ "Hi: " ++ show s 33 | return (show s, s + 1) 34 | -------------------------------------------------------------------------------- /src/MonadTransformers/EitherT/Exercises.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.EitherT.Exercises where 2 | 3 | import Control.Applicative (liftA2) 4 | 5 | newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) } 6 | 7 | -- Question 1 8 | instance (Functor m) => Functor (EitherT e m) where 9 | fmap f (EitherT mea) = EitherT $ (fmap . fmap) f mea 10 | 11 | -- Question 2 12 | instance (Applicative m) => Applicative (EitherT e m) where 13 | pure = EitherT . pure . pure 14 | EitherT fmeab <*> EitherT mea = EitherT $ liftA2 (<*>) fmeab mea 15 | 16 | -- Question 3 17 | instance (Monad m) => Monad (EitherT e m) where 18 | return = pure 19 | EitherT mea >>= f = EitherT $ do 20 | ea <- mea 21 | case ea of 22 | Left e -> return (Left e) 23 | Right a -> (runEitherT . f) a 24 | 25 | -- Question 4 26 | swapEither :: Either e a -> Either a e 27 | swapEither (Left e) = Right e 28 | swapEither (Right a) = Left a 29 | 30 | swapEitherT :: (Functor m) => EitherT e m a -> EitherT a m e 31 | swapEitherT (EitherT mea) = EitherT (fmap swapEither mea) 32 | 33 | -- Question 5 34 | eitherT :: Monad m => (a -> m c) -> (b -> m c) -> EitherT a m b -> m c 35 | eitherT f g (EitherT mab) = do 36 | ab <- mab 37 | case ab of 38 | Left a -> f a 39 | Right b -> g b 40 | -------------------------------------------------------------------------------- /src/MonadTransformers/LexicallyInnerIsStructurallyOuter/Exercise.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.LexicallyInnerIsStructurallyOuter.Exercise where 2 | 3 | import Control.Monad.Trans.Except 4 | import Control.Monad.Trans.Maybe 5 | import Control.Monad.Trans.Reader 6 | 7 | embedded :: MaybeT (ExceptT String (ReaderT () IO)) Int 8 | embedded = MaybeT $ ExceptT $ ReaderT $ return <$> const (Right (Just 1)) 9 | 10 | -- Or more explicitely 11 | embedded' :: MaybeT (ExceptT String (ReaderT () IO)) Int 12 | embedded' = MaybeT ma 13 | where ma :: (ExceptT String (ReaderT () IO)) (Maybe Int) 14 | ma = ExceptT mb 15 | where mb :: (ReaderT () IO) (Either String (Maybe Int)) 16 | mb = ReaderT mc 17 | where mc :: () -> IO (Either String (Maybe Int)) 18 | mc = return <$> const (Right (Just 1)) 19 | -------------------------------------------------------------------------------- /src/MonadTransformers/MonadIO/Exercises.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.MonadIO.Exercises where 2 | 3 | import Control.Monad.IO.Class 4 | import Control.Monad.Trans.Class 5 | 6 | -- MaybeT 7 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } 8 | 9 | instance (Functor m) => Functor (MaybeT m) where 10 | fmap = undefined 11 | 12 | instance (Applicative m) => Applicative (MaybeT m) where 13 | pure = undefined 14 | (<*>) = undefined 15 | 16 | instance (Monad m) => Monad (MaybeT m) where 17 | return = pure 18 | (>>=) = undefined 19 | 20 | instance MonadTrans MaybeT where 21 | lift = MaybeT . fmap Just 22 | 23 | instance (MonadIO m) => MonadIO (MaybeT m) where 24 | liftIO = lift . liftIO 25 | 26 | -- ReaderT 27 | newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a } 28 | 29 | instance (Functor m) => Functor (ReaderT r m) where 30 | fmap = undefined 31 | 32 | instance (Applicative m) => Applicative (ReaderT r m) where 33 | pure = undefined 34 | (<*>) = undefined 35 | 36 | instance (Monad m) => Monad (ReaderT r m) where 37 | return = pure 38 | (>>=) = undefined 39 | 40 | instance MonadTrans (ReaderT r) where 41 | lift = ReaderT . const 42 | 43 | instance (MonadIO m) => MonadIO (ReaderT r m) where 44 | liftIO = lift . liftIO 45 | 46 | -- StateT 47 | newtype StateT s m a = StateT { runStateT :: s -> m (a, s) } 48 | 49 | instance (Functor m) => Functor (StateT s m) where 50 | fmap = undefined 51 | 52 | instance (Monad m) => Applicative (StateT s m) where 53 | pure = undefined 54 | (<*>) = undefined 55 | 56 | instance (Monad m) => Monad (StateT s m) where 57 | return = pure 58 | (>>=) = undefined 59 | 60 | instance MonadTrans (StateT s) where 61 | lift ma = StateT $ \s -> do 62 | a <- ma 63 | return (a, s) 64 | 65 | instance (MonadIO m ) => MonadIO (StateT s m) where 66 | liftIO = lift . liftIO 67 | -------------------------------------------------------------------------------- /src/MonadTransformers/MonadTrans/Exercises.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.MonadTrans.Exercises where 2 | 3 | import Control.Monad.Trans.Class 4 | 5 | newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) } 6 | 7 | instance MonadTrans (EitherT e) where 8 | lift = EitherT . (fmap Right) 9 | 10 | newtype StateT s m a = StateT { runStateT :: s -> m (a, s) } 11 | 12 | instance MonadTrans (StateT s) where 13 | lift ma = StateT $ \s -> do 14 | a <- ma 15 | return (a, s) 16 | -------------------------------------------------------------------------------- /src/MonadTransformers/StateT/Exercises.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.StateT.Exercises where 2 | 3 | import Control.Applicative 4 | 5 | newtype StateT s m a = StateT { runStateT :: s -> m (a, s)} 6 | 7 | instance (Functor m) => Functor (StateT s m) where 8 | fmap f (StateT sma) = StateT $ \s -> fmap f' (sma s) 9 | where f' (a, s) = (f a, s) 10 | 11 | -- See this Stackoverflow post the reason why we need a Monad instance of m 12 | -- https://stackoverflow.com/questions/18673525/is-it-possible-to-implement-applicative-m-applicative-statet-s-m 13 | instance (Monad m) => Applicative (StateT s m) where 14 | pure a = StateT $ \s -> pure (a, s) 15 | StateT smab <*> StateT sma = StateT $ \s -> do 16 | (ab, s') <- smab s 17 | (a, s'') <- sma s' 18 | return (ab a, s'') 19 | 20 | instance (Monad m) => Monad (StateT s m) where 21 | return = pure 22 | StateT sma >>= asmb = StateT $ \s -> do 23 | (a, s') <- sma s 24 | runStateT (asmb a) s' 25 | -------------------------------------------------------------------------------- /src/Monoid/BetterLivingThroughQuickCheck/IntermissionExercise.hs: -------------------------------------------------------------------------------- 1 | module Monoid.BetterLivingThroughQuickCheck.IntermissionExercise where 2 | 3 | import Test.QuickCheck 4 | import Monoid.ReusingAlgebras.Exercise 5 | 6 | newtype First a = First { getFirst :: Optional a } 7 | deriving (Eq, Show) 8 | 9 | instance Semigroup (First a) where 10 | First (Only a) <> _ = First (Only a) 11 | First Nada <> x = x 12 | 13 | instance Monoid (First a) where 14 | mempty = First Nada 15 | 16 | instance (Arbitrary a) => Arbitrary (First a) where 17 | arbitrary = do 18 | a <- arbitrary 19 | elem <- elements [Nada, Only a] 20 | return $ First elem 21 | -------------------------------------------------------------------------------- /src/Monoid/ChapterExercises/MonoidExercises.hs: -------------------------------------------------------------------------------- 1 | module Monoid.ChapterExercises.MonoidExercises where 2 | 3 | import Monoid.ChapterExercises.SemigroupExercises 4 | 5 | -- Question 1 6 | instance Monoid Trivial where 7 | mempty = Trivial 8 | 9 | -- Question 2 10 | instance (Monoid a) => Monoid (Identity a) where 11 | mempty = Identity mempty 12 | 13 | -- Question 3 14 | instance (Monoid a, Monoid b) => Monoid (Two a b) where 15 | mempty = Two mempty mempty 16 | 17 | -- Question 4 18 | instance Monoid BoolConj where 19 | mempty = BoolConj True 20 | 21 | -- Question 5 22 | instance Monoid BoolDisj where 23 | mempty = BoolDisj False 24 | 25 | -- Question 6 26 | instance (Monoid b) => Monoid (Combine a b) where 27 | mempty = Combine mempty 28 | 29 | -- Question 7 30 | instance (Semigroup a) => Monoid (Comp a) where 31 | mempty = Comp id 32 | 33 | -- Question 8 34 | newtype Mem s a = 35 | Mem { 36 | runMem :: s -> (a,s) 37 | } 38 | 39 | instance (Semigroup a) => Semigroup (Mem s a) where 40 | Mem f <> Mem g = Mem h 41 | where h s = (a' <> a'', s'') 42 | where (a', s') = f s 43 | (a'', s'') = g s' 44 | 45 | -- Question 9 46 | instance (Monoid a) => Monoid (Mem s a) where 47 | mempty = Mem $ \s -> (mempty, s) 48 | -------------------------------------------------------------------------------- /src/Monoid/Madness/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Monoid.Madness.Exercise where 2 | 3 | import Data.Monoid 4 | 5 | type Verb = String 6 | 7 | type Adjective = String 8 | 9 | type Adverb = String 10 | 11 | type Noun = String 12 | 13 | type Exclamation = String 14 | 15 | madlibbin' :: Exclamation 16 | -> Adverb 17 | -> Noun 18 | -> Adjective 19 | -> String 20 | madlibbin' e adv noun adj = 21 | e <> "! he said " <> 22 | adv <> " as he jumped into his car " <> 23 | noun <> " and drove off with this " <> 24 | adj <> " wife." 25 | 26 | madlibbinBetter' :: Exclamation 27 | -> Adverb 28 | -> Noun 29 | -> Adjective 30 | -> String 31 | madlibbinBetter' e adv noun adj = mconcat [e, 32 | "! he said", 33 | adv, 34 | " as he jumped into his car ", 35 | noun, 36 | " and drove off with this ", 37 | adj, 38 | " wife."] 39 | -------------------------------------------------------------------------------- /src/Monoid/ReusingAlgebras/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Monoid.ReusingAlgebras.Exercise where 2 | 3 | data Optional a = Nada 4 | | Only a 5 | deriving (Eq, Show) 6 | 7 | instance (Semigroup a) => Semigroup (Optional a) where 8 | (<>) (Only x) (Only y) = Only (x <> y) 9 | (<>) Nada x = x 10 | (<>) x Nada = x 11 | 12 | instance Monoid a => Monoid (Optional a) where 13 | mempty = Nada 14 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/AnonymousFunctions/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. All expressions are equivalent. 4 | 5 | 2. The type of `mTh 3` is `Num a => a -> a -> a`. 6 | 7 | 3. We have 8 | 9 | ```haskell 10 | addOneIfOdd n = case odd n of 11 | True -> f n 12 | False -> n 13 | where f = \n -> n + 1 14 | 15 | addFive x y = \x y -> (if x > y then y else x) + 5 16 | 17 | mflip f x y = f y x 18 | ``` 19 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/CaseExpressions/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module MoreFunctionalPatterns.CaseExpressions.IntermissionExercises where 2 | 3 | functionC x y = case compare x y of 4 | GT -> x 5 | _ -> y 6 | 7 | ifEvenAdd2 n = case even n of 8 | True -> n+2 9 | _ -> n 10 | 11 | nums x = case compare x 0 of 12 | LT -> -1 13 | EQ -> 0 14 | GT -> 1 15 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/ChapterExercises/LetUsWriteCode.hs: -------------------------------------------------------------------------------- 1 | module MoreFunctionalPatterns.ChapterExercises.LetUsWriteCode where 2 | 3 | -- Question 1 4 | tensDigit :: Integral a => a -> a 5 | tensDigit x = d 6 | where (xLast, _) = x `divMod` 10 7 | (_, d) = xLast `divMod` 10 8 | 9 | 10 | hunsDigit :: Integral a => a -> a 11 | hunsDigit x = d 12 | where xLast = x `div` 100 13 | d = xLast `mod` 10 14 | 15 | -- Question 2 16 | foldBool :: a -> a -> Bool -> a 17 | foldBool x y z = case z of 18 | True -> x 19 | _ -> y 20 | 21 | foldBool' :: a -> a -> Bool -> a 22 | foldBool' x y z 23 | | z = x 24 | | otherwise = y 25 | 26 | -- Question 3 27 | g :: (a -> b) -> (a, c) -> (b, c) 28 | g f (a, c) = (f a, c) 29 | 30 | -- Question 5 31 | roundTrip :: (Show a, Read a) => a -> a 32 | roundTrip = read . show 33 | 34 | -- Question 6 35 | roundTrip' :: (Show a, Read b) => a -> b 36 | roundTrip' = read . show 37 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/ChapterExercises/MultipleChoice.md: -------------------------------------------------------------------------------- 1 | # Multiple Choice 2 | 3 | 1. A polymorphic function d) may resolve to values of different types, depending on inputs. 4 | 5 | 2. Two functions named `f` and `g` have types `Char -> String` and 6 | `String -> [String]` respectively. 7 | The composed function `g . f` has the type 8 | b) `Char -> [String]`. 9 | 10 | 3. A function `f` has the type `Ord a => a -> a -> Bool` 11 | and we apply it to one numeric value, 12 | its type is now d) `(Num a, Ord a) => a -> Bool`. 13 | 14 | 4. A function with type `(a -> b) -> c` b) is a higher-order function 15 | 16 | 5. Given the following definition of `f` 17 | ```haskell 18 | f :: a -> a 19 | f x = x 20 | ``` 21 | the type of `f True` is a) `f True :: Bool`. 22 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/Guards/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 3. The following function 4 | ```haskell 5 | pal xs 6 | | xs == reverse xs = True 7 | | otherwise = False 8 | ``` 9 | b) returns `True` when `xs` is a palindrome. 10 | 11 | 5. `pal :: [a] -> Bool` (or `pal :: (Foldable t) => t a -> Bool`). 12 | 13 | 6. The following function 14 | ```haskell 15 | numbers x 16 | | x < 0 = -1 17 | | x == 0 = 0 18 | | x > 0 = 1 19 | ``` 20 | c) returns an indication of whether its argument is a positive or negative number or zero 21 | 22 | 8. `numbers :: (Num a, Ord a) => a -> a` 23 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/HigherOrderFunctions/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module MoreFunctionalPatterns.HigherOrderFunctions.IntermissionExercises where 2 | 3 | dodgy :: (Num a) => a -> a -> a 4 | dodgy x y = x + y * 10 5 | 6 | oneIsOne :: (Num a) => a -> a 7 | oneIsOne = dodgy 1 8 | 9 | oneIsTwo :: (Num a) => a -> a 10 | oneIsTwo = (flip dodgy) 2 11 | -------------------------------------------------------------------------------- /src/MoreFunctionalPatterns/PatternMatching/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. Given the following declarations 4 | ```haskell 5 | k (x, y) = x 6 | k1 = k ((4-1), 10) 7 | k2 = k ("three", (1 + 2)) 8 | k3 = k (3, True) 9 | ``` 10 | a) `k :: (a, b) -> a`. 11 | b) `k2 :: String`, which is different from `k1 :: Num a => a` and `k3 :: Num a => a`. 12 | c) `k1` and `k3` returns `3` as result. 13 | 14 | 2. We have 15 | ```haskell 16 | f :: (a, b, c) -> (d, e, f) -> ((a, d), (c, f)) 17 | f (a, b, c) (d, e, f) = ((a, d), (c, f)) 18 | ``` 19 | -------------------------------------------------------------------------------- /src/ParserCombinators/Alternative/IntermissionExercise.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.Alternative.IntermissionExercise where 2 | 3 | import Control.Applicative 4 | import Data.Ratio ((%)) 5 | import Text.Trifecta 6 | 7 | instance (Eq a) => Eq (Result a) where 8 | Success a == Success b = a == b 9 | Failure a == Failure b = True 10 | _ == _ = False 11 | 12 | parseFraction :: Parser Rational 13 | parseFraction = do 14 | numerator <- decimal 15 | char '/' 16 | denominator <- decimal 17 | case denominator of 18 | 0 -> fail "Denominator cannot be zero" 19 | _ -> return (numerator % denominator) 20 | 21 | type IntegerOrRational = Either Rational Integer 22 | 23 | parseIor :: Parser IntegerOrRational 24 | parseIor = try (Left <$> parseFraction) <|> try (Right <$> decimal) 25 | -- This will not work 26 | -- parseIor = (Left <$> parseFraction) <|> (Right <$> decimal) 27 | -------------------------------------------------------------------------------- /src/ParserCombinators/ChapterExercises/IPV4Addresses.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.IPV4Addresses where 2 | 3 | import Control.Applicative 4 | import Data.Word 5 | import Data.List 6 | import Text.Trifecta 7 | import Test.QuickCheck (Arbitrary, arbitrary) 8 | 9 | instance (Eq a) => Eq (Result a) where 10 | Success a == Success b = a == b 11 | Failure a == Failure b = True 12 | _ == _ = False 13 | 14 | data IPAddress = IPAddress Word32 15 | deriving (Eq, Ord) 16 | 17 | instance Show IPAddress where 18 | show (IPAddress x) = intercalate "." $ map (show . binToDecimal) x'' 19 | where x' = pad 32 0 $ decimalToBin x 20 | x'' = separateEvery 8 x' 21 | 22 | instance Arbitrary IPAddress where 23 | arbitrary = IPAddress <$> arbitrary 24 | 25 | ipAddress :: Parser IPAddress 26 | ipAddress = IPAddress . fromIntegral . binToDecimal . dotDecimalToBin <$> sepBy integer (char '.') 27 | 28 | decimalToBin :: (Integral a) => a -> [a] 29 | decimalToBin n 30 | | n <= 1 = [n] 31 | | otherwise = decimalToBin (n `div` 2) ++ [n `mod` 2] 32 | 33 | pad :: Int -> a -> [a] -> [a] 34 | pad n a xs = replicate nPad a ++ xs 35 | where nPad = max (n - length xs) 0 36 | 37 | dotDecimalToBin :: (Integral a) => [a] -> [a] 38 | dotDecimalToBin = concatMap (pad 8 0 . decimalToBin) 39 | 40 | binToDecimal :: (Integral a) => [a] -> a 41 | binToDecimal = foldl' (\acc x -> acc * 2 + x) 0 42 | 43 | separateEvery :: Int -> [a] -> [[a]] 44 | separateEvery _ [] = [] 45 | separateEvery n xs = take n xs : separateEvery n (drop n xs) 46 | -------------------------------------------------------------------------------- /src/ParserCombinators/ChapterExercises/ParseDigitAndInteger.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.ParseDigitAndInteger where 2 | 3 | import Control.Applicative 4 | import Data.List 5 | import Text.Trifecta 6 | 7 | instance (Eq a) => Eq (Result a) where 8 | Success a == Success b = a == b 9 | Failure a == Failure b = True 10 | _ == _ = False 11 | 12 | parseDigit :: Parser Char 13 | parseDigit = oneOf $ concatMap show [0..9] 14 | 15 | readChar :: (Read a) => Char -> a 16 | readChar a = read [a] 17 | 18 | base10Integer :: Parser Integer 19 | base10Integer = do 20 | -- () give parser a name 21 | -- See https://hackage.haskell.org/package/parsers-0.12.9/docs/Text-Parser-Combinators.html 22 | digits <- some parseDigit "integer" 23 | return $ (foldl1' (\acc x -> 10 * acc + x) . map readChar) digits 24 | 25 | base10Integer' :: Parser Integer 26 | base10Integer' = (char '+' >> base10Integer) 27 | <|> (char '-' >> base10Integer >>= \x -> return (-x)) 28 | <|> base10Integer 29 | -------------------------------------------------------------------------------- /src/ParserCombinators/ChapterExercises/PhoneNumbers.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.PhoneNumbers where 2 | 3 | import Control.Applicative 4 | import Data.List 5 | import Text.Trifecta 6 | 7 | instance (Eq a) => Eq (Result a) where 8 | Success a == Success b = a == b 9 | Failure a == Failure b = True 10 | _ == _ = False 11 | 12 | type NumberingPlanArea = Int -- aka area code 13 | type Exchange = Int 14 | type LineNumber = Int 15 | 16 | data PhoneNumber = 17 | PhoneNumber NumberingPlanArea Exchange LineNumber 18 | deriving (Eq, Show) 19 | 20 | number :: String -> Int 21 | number = foldl' (\acc x -> acc * 10 + read [x]) 0 22 | 23 | parseNumberingPlanArea :: Parser NumberingPlanArea 24 | parseNumberingPlanArea = do 25 | _ <- optional (string "1-") 26 | numberingPlanArea <- char '(' *> count 3 digit <* char ')' <* char ' ' 27 | <|> (count 3 digit <* optional (char '-')) 28 | return $ number numberingPlanArea 29 | 30 | parseExchange :: Parser Exchange 31 | parseExchange = number <$> count 3 digit 32 | 33 | parseLineNumber :: Parser LineNumber 34 | parseLineNumber = number <$> count 4 digit 35 | 36 | parsePhone :: Parser PhoneNumber 37 | parsePhone = do 38 | numberingPlanArea <- parseNumberingPlanArea 39 | exchange <- parseExchange 40 | _ <- optional (char '-') 41 | lineNumber <- parseLineNumber 42 | return $ PhoneNumber numberingPlanArea exchange lineNumber 43 | -------------------------------------------------------------------------------- /src/ParserCombinators/ParsingFractions/IntermissionExercise.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ParsingFractions.IntermissionExercise where 2 | 3 | import Text.Trifecta 4 | 5 | instance (Eq a) => Eq (Result a) where 6 | Success a == Success b = a == b 7 | Failure a == Failure b = True 8 | _ == _ = False 9 | 10 | parseInteger :: Parser Integer 11 | parseInteger = do 12 | a <- integer 13 | b <- eof 14 | return a 15 | -------------------------------------------------------------------------------- /src/ParserCombinators/UnderstandingTheParsingProcess/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.UnderstandingTheParsingProcess.IntermissionExercises where 2 | 3 | import Control.Applicative 4 | import Text.Trifecta 5 | import Text.Parser.Combinators 6 | 7 | instance (Eq a) => Eq (Result a) where 8 | Success a == Success b = a == b 9 | -- TODO: better handling the Failure case 10 | Failure a == Failure b = True 11 | _ == _ = False 12 | 13 | -- Question 1 14 | one :: Parser () 15 | one = char '1' >> eof 16 | 17 | oneTwo :: Parser () 18 | oneTwo = char '1' >> char '2' >> eof 19 | 20 | -- Question 2 21 | oneTwoThree :: Parser String 22 | oneTwoThree = choice [string "123", string "12", string "1"] 23 | -- or 24 | -- oneTwoThree = string "123" <|> string "12" <|> string "1" 25 | 26 | -- Question 3 27 | string' :: (CharParsing m) => String -> m String 28 | string' = traverse char 29 | -------------------------------------------------------------------------------- /src/Reader/ButUhReader/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Reader.ButUhReader.Exercise where 2 | 3 | newtype Reader r a = Reader { runReader :: r -> a } 4 | 5 | ask :: Reader a a 6 | ask = Reader id 7 | -------------------------------------------------------------------------------- /src/Reader/ChapterExercises/WarmUpStretch.hs: -------------------------------------------------------------------------------- 1 | module Reader.ChapterExercises.WarmUpStretch where 2 | 3 | import Control.Applicative 4 | import Data.Maybe 5 | 6 | x = [1, 2, 3] 7 | y = [4, 5, 6] 8 | z = [7, 8, 9] 9 | 10 | lookup' :: Eq a => a -> [(a, b)] -> Maybe b 11 | lookup' _ [] = Nothing 12 | lookup' a ((x', x''):xs) 13 | | a == x' = Just x'' 14 | | otherwise = lookup' a xs 15 | 16 | xs :: Maybe Integer 17 | xs = lookup' 3 $ zip x y 18 | 19 | ys :: Maybe Integer 20 | ys = lookup' 6 $ zip y z 21 | 22 | zs :: Maybe Integer 23 | zs = lookup 4 $ zip x y 24 | 25 | -- now zip x and z using a variable lookup key 26 | z' :: Integer -> Maybe Integer 27 | z' n = lookup' n $ zip x z 28 | 29 | -- Have x1 make a tuple of xs and ys 30 | x1 :: Maybe (Integer, Integer) 31 | x1 = liftA2 (,) xs ys 32 | 33 | -- and x2 make a tuple of ys and zs 34 | x2 :: Maybe (Integer, Integer) 35 | x2 = liftA2 (,) ys zs 36 | 37 | -- x3 which takes one input and makes a tuple of the results of two applications of z' from above 38 | x3 :: Integer -> (Maybe Integer, Maybe Integer) 39 | x3 = liftA2 (,) z' z' 40 | 41 | uncurry' :: (a -> b -> c) -> (a, b) -> c 42 | uncurry' f (a, b) = f a b 43 | 44 | summed :: Num c => (c, c) -> c 45 | summed = uncurry' (+) 46 | 47 | bolt :: Integer -> Bool 48 | -- use &&, >3, <8 49 | bolt = liftA2 (&&) (>3) (<8) 50 | 51 | fromMaybe' :: a -> Maybe a -> a 52 | fromMaybe' _ (Just a) = a 53 | fromMaybe' a Nothing = a 54 | 55 | sequA :: Integral a => a -> [Bool] 56 | sequA m = sequenceA [(>3), (<8), even] m 57 | 58 | s' :: Maybe Integer 59 | s' = summed <$> ((,) <$> xs <*> ys) 60 | -------------------------------------------------------------------------------- /src/Reader/FunctionsHaveAnApplicativeToo/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Reader.FunctionsHaveAnApplicativeToo.Exercise where 2 | 3 | newtype Reader r a = Reader { runReader :: r -> a } 4 | 5 | -- Question 1 6 | myLiftA2 :: Applicative f => 7 | (a -> b -> c) 8 | -> f a -> f b -> f c 9 | myLiftA2 f a b = f <$> a <*> b 10 | 11 | -- Question 2 12 | asks :: (r -> a) -> Reader r a 13 | asks f = Reader f 14 | 15 | -- Question 3 16 | instance Functor (Reader r) where 17 | fmap f (Reader ra) = Reader $ f . ra 18 | 19 | instance Applicative (Reader r) where 20 | pure = Reader . const 21 | Reader f <*> Reader ra = Reader $ myLiftA2 ($) f ra 22 | -- Or more explicitely 23 | -- Reader f <*> Reader ra = Reader $ \r -> (f r) (ra r) 24 | 25 | -- Question 4 26 | newtype HumanName = HumanName String 27 | deriving (Eq, Show) 28 | 29 | newtype DogName = DogName String 30 | deriving (Eq, Show) 31 | 32 | newtype Address = Address String 33 | deriving (Eq, Show) 34 | 35 | data Person = Person { 36 | humanName :: HumanName 37 | , dogName :: DogName 38 | , address :: Address 39 | } deriving (Eq, Show) 40 | 41 | data Dog = Dog { 42 | dogsName :: DogName 43 | , dogsAddress :: Address 44 | } deriving (Eq, Show) 45 | 46 | getDogR :: Reader Person Dog 47 | getDogR = Dog <$> Reader dogName <*> Reader address 48 | -------------------------------------------------------------------------------- /src/Reader/Reader/ShortExercise.hs: -------------------------------------------------------------------------------- 1 | module Reader.Reader.ShortExercise where 2 | 3 | import Data.Char 4 | 5 | cap :: [Char] -> [Char] 6 | cap xs = map toUpper xs 7 | 8 | rev :: [Char] -> [Char] 9 | rev xs = reverse xs 10 | 11 | composed :: [Char] -> [Char] 12 | composed = cap . rev 13 | 14 | fmapped :: [Char] -> [Char] 15 | fmapped = fmap cap rev 16 | 17 | tupled :: [Char] -> ([Char], [Char]) 18 | tupled = (,) <$> cap <*> rev 19 | 20 | tupled' :: [Char] -> ([Char], [Char]) 21 | tupled' = do 22 | a <- cap 23 | b <- rev 24 | return (a, b) 25 | -------------------------------------------------------------------------------- /src/Reader/TheMonadOfFunctions/Exercise.hs: -------------------------------------------------------------------------------- 1 | module Reader.TheMonadOfFunctions.Exercise where 2 | 3 | import Control.Applicative (liftA2) 4 | 5 | newtype Reader r a = Reader { runReader :: r -> a } 6 | 7 | instance Functor (Reader r) where 8 | fmap f (Reader ra) = Reader $ f . ra 9 | 10 | instance Applicative (Reader r) where 11 | pure = Reader . const 12 | Reader f <*> Reader ra = Reader $ liftA2 ($) f ra 13 | 14 | -- Question 1 15 | instance Monad (Reader r) where 16 | return = pure 17 | (Reader ra) >>= aRb = Reader $ \r -> runReader (aRb (ra r)) r 18 | 19 | -- Question 2 20 | newtype HumanName = HumanName String 21 | deriving (Eq, Show) 22 | 23 | newtype DogName = DogName String 24 | deriving (Eq, Show) 25 | 26 | newtype Address = Address String 27 | deriving (Eq, Show) 28 | 29 | data Person = Person { 30 | humanName :: HumanName 31 | , dogName :: DogName 32 | , address :: Address 33 | } deriving (Eq, Show) 34 | 35 | data Dog = Dog { 36 | dogsName :: DogName 37 | , dogsAddress :: Address 38 | } deriving (Eq, Show) 39 | 40 | getDogRM :: Reader Person Dog 41 | getDogRM = do 42 | name <- Reader dogName 43 | addr <- Reader address 44 | return $ Dog name addr 45 | -- or without do syntax 46 | -- getDogRM = Reader dogName >>= \name -> Reader address >>= \addr -> return $ Dog name addr 47 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/FixingDividedBy.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.FixingDividedBy where 2 | 3 | data DividedResult = Result Integer | DividedByZero 4 | deriving (Eq, Show) 5 | 6 | div' :: Integer -> Integer -> DividedResult 7 | div' _ 0 = DividedByZero 8 | div' 0 _ = Result 0 9 | div' x y 10 | | x < 0 && y < 0 = div' (-x) (-y) 11 | div' x y 12 | | x < 0 = let Result z = div' (x + y) y 13 | in Result $ -1 + z 14 | | y < 0 = let Result z = div' (x + y) y 15 | in Result $ -1 + z 16 | div' x y 17 | | x < y = Result 0 18 | | otherwise = let Result z = div' (x - y) y 19 | in Result $ 1 + z 20 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/McCarthy91Function.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.McCarthy91Function where 2 | 3 | mc91 :: Integer -> Integer 4 | mc91 n 5 | | n > 100 = n - 10 6 | | otherwise = mc91 $ mc91 $ n + 11 7 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/NumbersIntoWords.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.NumbersIntoWords where 2 | 3 | import Data.List (intersperse) 4 | 5 | digitToWord :: Int -> String 6 | digitToWord n = case n of 7 | 0 -> "zero" 8 | 1 -> "one" 9 | 2 -> "two" 10 | 3 -> "three" 11 | 4 -> "four" 12 | 5 -> "five" 13 | 6 -> "six" 14 | 7 -> "seven" 15 | 8 -> "eight" 16 | 9 -> "nine" 17 | _ -> error "This should not happen" 18 | 19 | digits :: Int -> [Int] 20 | digits n 21 | | n < 0 = error "Negative number" 22 | | n < 10 = [n] 23 | | otherwise = digits (n `div` 10) ++ [n `mod` 10] 24 | 25 | wordNumber :: Int -> String 26 | wordNumber = concat . intersperse "-" . map digitToWord . digits 27 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/Recursion.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.Recursion where 2 | 3 | sumToN :: (Eq a, Num a) => a -> a 4 | sumToN 1 = 1 5 | sumToN n = n + sumToN (n - 1) 6 | 7 | multiply :: (Integral a) => a -> a -> a 8 | multiply 0 _ = 0 9 | multiply _ 0 = 0 10 | multiply x y 11 | | x > y = multiply y x 12 | | y < 0 = multiply (-x) (-y) 13 | | x < 0 = -multiply (-x) y 14 | | x == 1 = y 15 | | otherwise = y + multiply (x - 1) y 16 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/ReviewOfTypes.md: -------------------------------------------------------------------------------- 1 | # Review of Types 2 | 3 | 1. The type of `[[True, False], [True, True], [False, True]]` is d) `[[Bool]]`. 4 | 5 | 2. b) `[[3 == 3], [6 > 5], [3 < 4]]` has the same type as `[[True, False], [True, True], [False, True]]`. 6 | 7 | 3. For the function 8 | ```haskell 9 | func :: [a] -> [a] -> [a] 10 | func x y = x ++ y 11 | ``` 12 | we have 13 | a) `x` and `y` must be of the same type 14 | b) `x` and `y` must both be lists 15 | c) if `x` is a `String` then `y` must be a `String` 16 | 17 | 4. For the `func` code above, b) `func "Hello" "World"` is a valid application to both of its arguments. 18 | -------------------------------------------------------------------------------- /src/Recursion/ChapterExercises/ReviewingCurrying.md: -------------------------------------------------------------------------------- 1 | # Reviewing Currying 2 | 3 | Given the following definition 4 | ```haskell 5 | cattyConny :: String -> String -> String 6 | cattyConny x y = x ++ " mrow " ++ y 7 | ``` 8 | we have 9 | ```haskell 10 | flippy :: String -> String -> String 11 | flippy = flip cattyConny 12 | 13 | appedCatty :: String -> String 14 | appedCatty = cattyConny "woops" 15 | 16 | frappe :: String -> String 17 | frappe = flippy "haha" 18 | ``` 19 | 20 | 1. The result of `appedCatty "woohoo!"` is `"woops mrow woohoo!"`. 21 | 22 | 2. The result of `frappe "1"` is `"1 mrow haha"`. 23 | 24 | 3. The result of `frappe (appedCatty "2")` is `"woops mrow 2 mrow haha"`. 25 | 26 | 4. The result of `appedCatty (frappe "blue")` is `"woops mrow blue mrow haha"`. 27 | 28 | 5. `cattyConny (frappe "pink") (cattyConny "green" (appedCatty "blue"))` 29 | gives `"pink mrow haha mrow green mrow woops mrow blue"`. 30 | 31 | 6. `cattyConny (flippy "Pugs" "are") "awesome"` gives 32 | `"are mrow Pugs mrow awesome"`. 33 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/DetermineTheKinds.md: -------------------------------------------------------------------------------- 1 | 1. Given 2 | ```haskell 3 | id :: a -> a 4 | id = undefined 5 | ``` 6 | the kind of `a` is `*`. 7 | 8 | 2. Given 9 | ```haskell 10 | r :: a -> f a 11 | r = undefined 12 | ``` 13 | the kind of `a` is `*` and that of `f` is `* -> *`. 14 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/ItIsOnlyNatural.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.ItIsOnlyNatural where 2 | 3 | data Nat = Zero 4 | | Succ Nat 5 | deriving (Eq, Show) 6 | 7 | natToInteger :: Nat -> Integer 8 | natToInteger Zero = 0 9 | natToInteger (Succ n) = 1 + natToInteger n 10 | 11 | integerToNat :: Integer -> Maybe Nat 12 | integerToNat n 13 | | n < 0 = Nothing 14 | | n == 0 = Just Zero 15 | | otherwise = Just $ Succ $ getNat $ integerToNat $ n - 1 16 | where getNat (Just x) = x 17 | getNat _ = error "This should not happen" 18 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/IterateAndUnfoldr.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.IterateAndUnfoldr where 2 | 3 | myIterate :: (a -> a) -> a -> [a] 4 | myIterate f a = b : myIterate f b 5 | where b = f a 6 | 7 | myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a] 8 | myUnfoldr f b = case f b of 9 | Nothing -> [] 10 | Just (x, y) -> x : myUnfoldr f y 11 | 12 | betterIterate :: (a -> a) -> a -> [a] 13 | betterIterate f = myUnfoldr (\y -> Just (y, f y)) 14 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/SmallLibraryForEither.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.SmallLibraryForEither where 2 | 3 | lefts' :: [Either a b] -> [a] 4 | lefts' = foldr f [] 5 | where f (Left a) acc = a : acc 6 | f _ acc = acc 7 | 8 | rights' :: [Either a b] -> [b] 9 | rights' = foldr f [] 10 | where f (Right b) acc = b : acc 11 | f _ acc = acc 12 | 13 | partitionEithers' :: [Either a b] -> ([a], [b]) 14 | partitionEithers' = foldr f ([], []) 15 | where f (Left a) (l, r) = (a : l, r) 16 | f (Right b) (l, r) = (l, b : r) 17 | 18 | eitherMaybe' :: (b -> c) -> Either a b -> Maybe c 19 | eitherMaybe' _ (Left _) = Nothing 20 | eitherMaybe' f (Right b) = Just (f b) 21 | 22 | either' :: (a -> c) -> (b -> c) -> Either a b -> c 23 | either' f _ (Left a) = f a 24 | either' _ g (Right b) = g b 25 | 26 | eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c 27 | eitherMaybe'' f = either' (const Nothing) (Just . f) 28 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/SmallLibraryForMaybe.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.SmallLibraryForMaybe where 2 | 3 | -- Question 1 4 | isJust :: Maybe a -> Bool 5 | isJust (Just _) = True 6 | isJust _ = False 7 | 8 | isNothing :: Maybe a -> Bool 9 | isNothing = not . isJust 10 | 11 | -- Question 2 12 | mayybee :: b -> (a -> b) -> Maybe a -> b 13 | mayybee b f (Just a) = f a 14 | mayybee b _ Nothing = b 15 | 16 | -- Question 3 17 | fromMaybe :: a -> Maybe a -> a 18 | fromMaybe a Nothing = a 19 | fromMaybe _ (Just a) = a 20 | 21 | fromMaybe' :: a -> Maybe a -> a 22 | fromMaybe' a = mayybee a id 23 | 24 | -- Question 4 25 | listToMaybe :: [a] -> Maybe a 26 | listToMaybe (x:xs) = Just x 27 | listToMaybe _ = Nothing 28 | 29 | maybeToList :: Maybe a -> [a] 30 | maybeToList (Just a) = [a] 31 | maybeToList _ = [] 32 | 33 | -- Question 5 34 | catMaybes :: [Maybe a] -> [a] 35 | catMaybes = map (fromMaybe undefined) . filter isJust 36 | 37 | -- Question 6 38 | flipMaybe :: [Maybe a] -> Maybe [a] 39 | flipMaybe xs 40 | | any isNothing xs = Nothing 41 | | otherwise = Just $ catMaybes xs 42 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/SomethingOtherThanList.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.SomethingOtherThanList where 2 | 3 | data BinaryTree a = Leaf 4 | | Node (BinaryTree a) a (BinaryTree a) 5 | deriving (Eq, Ord, Show) 6 | 7 | unfold :: (a -> Maybe (a, b, a)) -> a -> BinaryTree b 8 | unfold f a = case f a of 9 | Nothing -> Leaf 10 | Just (a', b, a'') -> Node (unfold f a') b (unfold f a'') 11 | 12 | treeBuild :: Integer -> BinaryTree Integer 13 | treeBuild n = unfold f 0 14 | where f m 15 | | m == n = Nothing 16 | | otherwise = Just (m + 1, m , m + 1) 17 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/StringProcessing.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.StringProcessing ( 2 | notThe 3 | , replaceThe 4 | , countTheBeforeVowel 5 | , countVowels 6 | ) where 7 | 8 | -- Question 1 9 | notThe :: String -> Maybe String 10 | notThe s 11 | | s == "the" = Nothing 12 | | otherwise = Just s 13 | 14 | replaceThe :: String -> String 15 | replaceThe "" = "" 16 | replaceThe s = (replace . notThe) firstWord ++ next 17 | where (firstWord, nextWords) = span (/= ' ') s 18 | replace Nothing = "a" 19 | replace (Just s) = s 20 | next 21 | | nextWords == "" = "" 22 | | otherwise = " " ++ (replaceThe . dropWhile (== ' ')) nextWords 23 | 24 | -- Even simpler 25 | replaceThe' :: String -> String 26 | replaceThe' = unwords . map (replaceThe . notThe) . words 27 | where replaceThe Nothing = "a" 28 | replaceThe (Just s) = s 29 | 30 | -- Question 2 31 | isVowel :: Char -> Bool 32 | isVowel = (`elem` "aeiouAEIOU") 33 | 34 | countTheBeforeVowel :: String -> Integer 35 | countTheBeforeVowel "" = 0 36 | countTheBeforeVowel s = ( 37 | if firstWord == "the" && beginWithVowel otherWordsTrim 38 | then 1 39 | else 0 40 | ) 41 | + countTheBeforeVowel otherWordsTrim 42 | where (firstWord, otherWords) = span (/= ' ') s 43 | otherWordsTrim = dropWhile (== ' ') otherWords 44 | beginWithVowel "" = False 45 | beginWithVowel (x:xs) = isVowel x 46 | 47 | -- Question 3 48 | countVowels :: String -> Integer 49 | countVowels = fromIntegral . length . filter isVowel 50 | -------------------------------------------------------------------------------- /src/SignalingAdversity/ChapterExercises/ValidateTheWord.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.ValidateTheWord where 2 | 3 | import Data.List 4 | newtype Word' = Word' String deriving (Eq, Show) 5 | 6 | vowels :: String 7 | vowels = "aeiou" 8 | 9 | isVowel :: Char -> Bool 10 | isVowel = (`elem` vowels) 11 | 12 | mkWord :: String -> Maybe Word' 13 | mkWord s 14 | | length vs > length cs = Nothing 15 | | otherwise = Just (Word' s) 16 | where (vs, cs) = partition isVowel s 17 | -------------------------------------------------------------------------------- /src/State/ChapterExercises/Exercises.hs: -------------------------------------------------------------------------------- 1 | module State.ChapterExercises.Exercises where 2 | 3 | newtype State s a = State { runState :: s -> (a, s) } 4 | 5 | instance Functor (State s) where 6 | fmap f (State g) = State $ \x -> let (a, s) = g x in (f a, s) 7 | 8 | instance Applicative (State s) where 9 | pure a = State $ (,) a 10 | (State f) <*> (State g) = State $ \s -> let (ab, s') = f s 11 | (a, s'') = g s 12 | in (ab a, s'') 13 | 14 | instance Monad (State s) where 15 | return = pure 16 | (State f) >>= g = State $ \x -> let (a, s) = f x 17 | State h = g a 18 | in h s 19 | 20 | -- Question 1 21 | get :: State s s 22 | get = State $ \s -> (s, s) 23 | 24 | -- Question 2 25 | put :: s -> State s () 26 | put s = State $ const ((), s) 27 | 28 | -- Question 3 29 | exec :: State s a -> s -> s 30 | exec (State sa) = snd . sa 31 | 32 | -- Question 4 33 | eval :: State s a -> s -> a 34 | eval (State sa) = fst . sa 35 | 36 | -- Question 5 37 | modify :: (s -> s) -> State s () 38 | modify f = State $ \s -> ((), f s) 39 | -------------------------------------------------------------------------------- /src/State/GetACodingJobWithOneWierdTrick/FizzbuzzDifferently.hs: -------------------------------------------------------------------------------- 1 | module State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferently where 2 | 3 | import Control.Monad 4 | import Control.Monad.Trans.State 5 | 6 | fizzBuzz :: Integer -> String 7 | fizzBuzz n 8 | | n `mod` 15 == 0 = "FizzBuzz" 9 | | n `mod` 5 == 0 = "Fizz" 10 | | n `mod` 3 == 0 = "Buzz" 11 | | otherwise = show n 12 | 13 | fizzbuzzList :: [Integer] -> [String] 14 | fizzbuzzList list = execState (mapM_ addResult list) [] 15 | 16 | addResult :: Integer -> State [String] () 17 | addResult n = do 18 | xs <- get 19 | let result = fizzBuzz n 20 | put (result : xs) 21 | 22 | fizzbuzzFromTo :: Integer -> Integer -> [String] 23 | fizzbuzzFromTo a b = fizzbuzzList [b, b-1 ..a] 24 | -------------------------------------------------------------------------------- /src/State/ThrowDown/Exercises.hs: -------------------------------------------------------------------------------- 1 | module State.ThrowDown.Exercises where 2 | 3 | import System.Random 4 | 5 | data Die = 6 | DieOne 7 | | DieTwo 8 | | DieThree 9 | | DieFour 10 | | DieFive 11 | | DieSix 12 | deriving (Eq, Show) 13 | 14 | intToDie :: Int -> Die 15 | intToDie n = 16 | case n of 17 | 1 -> DieOne 18 | 2 -> DieTwo 19 | 3 -> DieThree 20 | 4 -> DieFour 21 | 5 -> DieFive 22 | 6 -> DieSix 23 | -- Use this tactic _extremely_ sparingly. 24 | x -> error $ "intToDie got non 1-6 integer: " ++ show x 25 | 26 | -- Exercise 1 27 | rollsToGetN :: Int -> StdGen -> Int 28 | rollsToGetN limit = go 0 0 29 | where go :: Int -> Int -> StdGen -> Int 30 | go sum count gen 31 | | sum >= limit = count 32 | | otherwise = go (sum + die) (count + 1) nextGen 33 | where (die, nextGen) = randomR (1, 6) gen 34 | 35 | -- Exercise 2 36 | rollsCountLogged :: Int -> StdGen -> (Int, [Die]) 37 | rollsCountLogged limit = go 0 0 [] 38 | where go :: Int -> Int -> [Die] -> StdGen -> (Int, [Die]) 39 | go sum count dies gen 40 | | sum >= limit = (count, dies) 41 | | otherwise = go (sum + die) (count + 1) (intToDie die : dies) nextGen 42 | where (die, nextGen) = randomR (1, 6) gen 43 | -------------------------------------------------------------------------------- /src/State/WriteStateForYourself/Exercise.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE InstanceSigs #-} 2 | module State.WriteStateForYourself.Exercise where 3 | 4 | newtype Moi s a = Moi { runMoi :: s -> (a, s) } 5 | 6 | instance Functor (Moi s) where 7 | fmap :: (a -> b) -> Moi s a -> Moi s b 8 | fmap f (Moi g) = Moi $ \x -> let (a, s) = g x in (f a, s) 9 | 10 | instance Applicative (Moi s) where 11 | pure :: a -> Moi s a 12 | pure a = Moi $ (,) a 13 | (Moi f) <*> (Moi g) = Moi $ \s -> let (ab, s') = f s 14 | (a, s'') = g s 15 | in (ab a, s'') 16 | 17 | instance Monad (Moi s) where 18 | return = pure 19 | (>>=) :: Moi s a -> (a -> Moi s b) -> Moi s b 20 | (Moi f) >>= g = Moi $ \x -> let (a, s) = f x 21 | Moi h = g a 22 | in h s 23 | -------------------------------------------------------------------------------- /src/Strings/ChapterExercises/BuildingFunctions.hs: -------------------------------------------------------------------------------- 1 | module Strings.ChapterExercises.BuildingFunctions where 2 | 3 | -- Question 3 4 | thirdLetter :: String -> Char 5 | thirdLetter x = x !! 2 6 | 7 | -- Question 4 8 | letterIndex :: Int -> Char 9 | letterIndex x = "Curry is awesome!" !! x 10 | -------------------------------------------------------------------------------- /src/Strings/ChapterExercises/ReadingSyntax.md: -------------------------------------------------------------------------------- 1 | # Reading syntax 2 | 3 | 1. For the following lines of code, read the syntax carefully and 4 | decide if they are written correctly. 5 | a) concat [[1, 2, 3], [4, 5, 6]] 6 | b) (++) [1, 2, 3] [4, 5, 6] 7 | c) (++) "hello" " world" 8 | d) ["hello" ++ " world"] 9 | e) "hello" !! 4 10 | f) (!!) "hello" 4 11 | g) take 4 "lovely" 12 | h) take 3 "awesome" 13 | 14 | 2. We have 15 | a) `concat [[1 * 6], [2 * 6], [3 * 6]] = [6, 12, 18]` 16 | b) `"rain" ++ drop 2 "elbow" = "rainbow"` 17 | c) `10 * head [1, 2, 3] = 10` 18 | d) `(take 3 "Julie") ++ (tail "yes") = "Jules"` 19 | e) `concat [tail [1, 2, 3], tail [4, 5, 6], tail [7, 8, 9]] = [2,3,5,6,8,9]` 20 | -------------------------------------------------------------------------------- /src/Strings/PrintingSimpleStrings/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. In the following code 4 | ```haskell 5 | Prelude> let x = 5 6 | Prelude> let y = 7 7 | Prelude> let z = x * y 8 | ``` 9 | `y` is in scope for `z`. 10 | 11 | 2. In the following code 12 | ```haskell 13 | Prelude> let f = 3 14 | Prelude> let g = 6 * f + h 15 | ``` 16 | `h` is not in scope of `g`. 17 | 18 | 3. In the following code 19 | ```haskell 20 | area d = pi * (r * r) 21 | r = d / 2 22 | ``` 23 | everything is in scope for executing `area`. 24 | 25 | 4. In 26 | ```haskell 27 | area d = pi * (r * r) 28 | where r = d / 2 29 | ``` 30 | `r` and `d` are in scope for `area`. 31 | -------------------------------------------------------------------------------- /src/Strings/TypesOfConcatenationFunctions/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. `(++) [1, 2, 3] [4, 5, 6]` 4 | 5 | 2. `"<3" ++ " Haskell"` 6 | 7 | 3. `concat ["<3", " Haskell"]` 8 | -------------------------------------------------------------------------------- /src/Testing/ChapterExercises/Idempotence.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.Idempotence where 2 | 3 | import Data.Char 4 | 5 | twice f = f . f 6 | fourTimes = twice . twice 7 | 8 | capitalizeWord :: String -> String 9 | capitalizeWord = map toUpper 10 | -------------------------------------------------------------------------------- /src/Testing/ChapterExercises/MakeAGenRandomGeneratorForTheDataType.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.MakeAGenRandomGeneratorForTheDataType where 2 | 3 | import Test.QuickCheck 4 | 5 | data Fool = Fulse 6 | | Frue 7 | deriving (Eq, Show) 8 | 9 | -- Question 1 10 | genFool :: Gen Fool 11 | genFool = elements [Fulse, Frue] 12 | 13 | -- Question 2 14 | genFool' :: Gen Fool 15 | genFool' = elements [Fulse, Fulse, Frue] 16 | -------------------------------------------------------------------------------- /src/Testing/ChapterExercises/UsingQuickCheck.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.UsingQuickCheck where 2 | 3 | import Data.List (sort) 4 | 5 | half :: Double -> Double 6 | half x = x / 2 7 | -------------------------------------------------------------------------------- /src/Testing/ChapterExercises/ValidatingNumbersIntoWords.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.ValidatingNumbersIntoWords where 2 | 3 | import Data.List (intersperse) 4 | 5 | digitToWord :: Int -> String 6 | digitToWord n 7 | | n == 0 = "zero" 8 | | n == 1 = "one" 9 | | n == 2 = "two" 10 | | n == 3 = "three" 11 | | n == 4 = "four" 12 | | n == 5 = "five" 13 | | n == 6 = "six" 14 | | n == 7 = "seven" 15 | | n == 8 = "eight" 16 | | n == 9 = "nine" 17 | | otherwise = error "This should not happen" 18 | digits :: Int -> [Int] 19 | digits = map (\x -> read [x]) . show 20 | wordNumber :: Int -> String 21 | wordNumber = concat . intersperse "-" . map digitToWord . digits 22 | -------------------------------------------------------------------------------- /src/Testing/ConventionalTesting/IntermissionExercise.hs: -------------------------------------------------------------------------------- 1 | module Testing.ConventionalTesting.IntermissionExercise where 2 | 3 | dividedBy :: Integral a => a -> a -> (a, a) 4 | dividedBy num denom = go num denom 0 5 | where go n d count 6 | | n < d = (count, n) 7 | | otherwise = go (n - d) d (count + 1) 8 | 9 | multiply :: (Integral a, Ord a) => a -> a -> a 10 | multiply x y 11 | | x > y = multiply y x 12 | | x == 0 = 0 13 | | x < 0 = - multiply (-x) y 14 | | otherwise = y + multiply (x - 1) y 15 | -------------------------------------------------------------------------------- /src/Traversable/ChapterExercises/InstancesForTree.hs: -------------------------------------------------------------------------------- 1 | module Traversable.ChapterExercises.InstancesForTree where 2 | 3 | import Test.QuickCheck 4 | import Test.QuickCheck.Checkers 5 | 6 | data Tree a = Empty 7 | | Leaf a 8 | | Node (Tree a) a (Tree a) 9 | deriving (Eq, Show) 10 | 11 | instance Functor Tree where 12 | fmap _ Empty = Empty 13 | fmap f (Leaf a) = Leaf $ f a 14 | fmap f (Node l a r) = Node (fmap f l) (f a) (fmap f r) 15 | 16 | instance Foldable Tree where 17 | foldMap _ Empty = mempty 18 | foldMap f (Leaf a) = f a 19 | foldMap f (Node l a r) = foldMap f l <> f a <> foldMap f r 20 | 21 | instance Traversable Tree where 22 | traverse f Empty = pure Empty 23 | traverse f (Leaf a) = Leaf <$> f a 24 | traverse f (Node l a r) = Node <$> traverse f l <*> f a <*> traverse f r 25 | 26 | instance (Arbitrary a) => Arbitrary (Tree a) where 27 | arbitrary = do 28 | a <- arbitrary 29 | l <- arbitrary 30 | r <- arbitrary 31 | elements [Empty, Leaf a, Node l a r] 32 | 33 | instance (Eq a) => EqProp (Tree a) where (=-=) = eq 34 | -------------------------------------------------------------------------------- /src/Typeclasses/ChapterExercises/DoesItTypecheck.md: -------------------------------------------------------------------------------- 1 | # Does it typecheck? 2 | 3 | 1. The following code 4 | ```haskell 5 | data Person = Person Bool 6 | 7 | printPerson :: Person -> IO () 8 | printPerson person = putStrLn (show person) 9 | ``` 10 | does not typecheck because `Person` has no instance of `Show`. 11 | 12 | 2. The following code 13 | ```haskell 14 | data Mood = Blah 15 | | Woot deriving Show 16 | 17 | settleDown x = if x == Woot 18 | then Blah 19 | else x 20 | ``` 21 | does not typecheck because `Mood` has no instance of `Eq`. 22 | 23 | 3. Suppose that we were able to get `settleDown` to typecheck, then 24 | a) it accepts `Blah` and `Woot` as input 25 | b) `settleDown 9` gives an error saying *No instance for (Num Mood) arising from the literal '9'*. 26 | c) `Blah > Woot` gives an error because `Mood` has no instance of `Ord`. 27 | 28 | 4. The following code 29 | ```haskell 30 | type Subject = String 31 | type Verb = String 32 | type Object = String 33 | 34 | data Sentence = Sentence Subject Verb Object 35 | deriving (Eq, Show) 36 | 37 | s1 = Sentence "dogs" "drool" 38 | s2 = Sentence "Julie" "loves" "dogs" 39 | ``` 40 | does typecheck. 41 | -------------------------------------------------------------------------------- /src/Typeclasses/ChapterExercises/GivenDatatypeDeclarationWhatCanWeDo.md: -------------------------------------------------------------------------------- 1 | # Given a datatype declaration, what can we do? 2 | 3 | Given the following datatype definitions: 4 | ```haskell 5 | data Rocks = Rocks String deriving (Eq, Show) 6 | data Yeah = Yeah Bool deriving (Eq, Show) 7 | data Papu = Papu Rocks Yeah deriving (Eq, Show) 8 | ``` 9 | 10 | 1. `phew = Papu "chases" True` does not typecheck because `"chases"` is not of type `Rocks` and `True` is not of type `Yeah`. 11 | 12 | 2. `truth = Papu (Rocks "chomskydoz") (Yeah True)` typechecks. 13 | 14 | 3. The following 15 | ```haskell 16 | equalityForall :: Papu -> Papu -> Bool 17 | equalityForall p p' = p == p' 18 | ``` 19 | typechecks. 20 | 21 | 4. The following 22 | ```haskell 23 | comparePapus :: Papu -> Papu -> Bool 24 | comparePapus p p' = p > p' 25 | ``` 26 | does not typecheck because `Papu` has no instance of `Ord`. 27 | -------------------------------------------------------------------------------- /src/Typeclasses/ChapterExercises/MatchTheTypes.md: -------------------------------------------------------------------------------- 1 | # Match the types 2 | 3 | 1. For the following definition 4 | ```haskell 5 | i :: Num a => a 6 | i = 1 7 | ``` 8 | we cannot replace the type signature with `i :: a`. 9 | Indeed, `i :: a` means that `i` could be resolved as **any** type, 10 | it is clearly impossible to resolve `1` as `String`. 11 | 12 | 2. In 13 | ```haskell 14 | f :: Float 15 | f = 1.0 16 | ``` 17 | we cannot replace the type signature by `f :: Num a => a`. 18 | Again, `f :: Num a => a` means `f` could be **any** type which 19 | has instance of `Num`. 20 | `1.0` clearly cannot be a `Integer`. 21 | Instead, `f :: (Fractional a) => a` **typechecks** 22 | (which answers the question 3). 23 | 24 | 4. In 25 | ```haskell 26 | f :: Float 27 | f = 1.0 28 | ``` 29 | we can replace the type signature by `f :: (RealFrac a) => a`. 30 | 5. In 31 | ```haskell 32 | freud :: a -> a 33 | freud x = x 34 | ``` 35 | we can replace the type signature by `freud :: Ord a => a -> a`. 36 | 37 | 6. In 38 | ```haskell 39 | freud' :: a -> a 40 | freud' x = x 41 | ``` 42 | we can replace the type signature by `freud' :: Int -> Int`. 43 | 44 | 7. In 45 | ```haskell 46 | myX = 1 :: Int 47 | 48 | sigmund :: Int -> Int 49 | sigmund x = myX 50 | ``` 51 | we **cannot** write `sigmund :: a -> a` because `myX :: Int` could 52 | **not** be resolved as for example `String`. 53 | Similarly, `sigmund :: (Num a) => a -> a` does **not** typecheck 54 | (which answers the question 8). 55 | 56 | 9. In 57 | ```haskell 58 | jung :: Ord a => [a] -> a 59 | jung xs = head (sort xs) 60 | ``` 61 | we can write `jung :: [Int] -> Int`. 62 | 63 | 10. In 64 | ```haskell 65 | young :: [Char] -> Char 66 | young xs = head (sort xs) 67 | ``` 68 | we can write `young :: Ord a => [a] -> a`. 69 | 70 | 11. In 71 | ```haskell 72 | mySort :: [Char] -> [Char] 73 | mySort = sort 74 | 75 | signifier :: [Char] -> Char 76 | signifier xs = head (mySort xs) 77 | ``` 78 | we cannot write `signifier :: Ord a => [a] -> a` because `mySort` expects `[Char]` and returns `[Char]`. 79 | -------------------------------------------------------------------------------- /src/Typeclasses/ChapterExercises/MultipleChoice.md: -------------------------------------------------------------------------------- 1 | # Multiple Choice 2 | 3 | 1. The `Eq` class c) makes equality tests possible. 4 | 5 | 2. The typeclass `Ord` b) is a subclass of `Eq`. 6 | 7 | 3. Suppose the typeclass `Ord` has an operator `>`. Then the type of 8 | `>` is a) `Ord a => a -> a -> Bool`. 9 | 10 | 4. In `x = divMod 16 12`, c) the type of `x` is a tuple. 11 | 12 | 5. The typeclass `Integral` includes a) `Int` and `Integer` numbers. 13 | -------------------------------------------------------------------------------- /src/Typeclasses/ChapterExercises/TypeKwonDo.hs: -------------------------------------------------------------------------------- 1 | module Typeclasses.ChapterExercises.TypeKwonDo where 2 | 3 | -- Question 1 4 | chk :: Eq b => (a -> b) -> a -> b -> Bool 5 | chk f a = (==) (f a) 6 | 7 | -- Question 2 8 | arith :: Num b => (a -> b) -> Integer -> a -> b 9 | arith f _ = f 10 | -------------------------------------------------------------------------------- /src/Typeclasses/Ord/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. `max (length [1, 2, 3]) (length [8, 9, 10, 11, 12]) = 5` 4 | 5 | 2. `compare (3 * 4) (3 * 5) = LT` 6 | 7 | 3. `compare "Julie" True` gives an error because `"Julie" :: String` and `True :: Bool` 8 | 9 | 4. `(5 + 3) > (3 + 6) = False` 10 | -------------------------------------------------------------------------------- /src/Typeclasses/WritingTypeclassInstances/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module Typeclasses.WritingTypeclassInstances.IntermissionExercises where 2 | 3 | -- Question 1 4 | data TisAnInteger = TisAn Integer 5 | 6 | instance Eq TisAnInteger where 7 | TisAn x == TisAn y = x == y 8 | 9 | -- Question 2 10 | data TwoIntegers = Two Integer Integer 11 | 12 | instance Eq TwoIntegers where 13 | Two x y == Two x' y' = x == x' && y == y' 14 | 15 | -- Question 3 16 | data StringOrInt = TisAnInt Int | TisAString String 17 | 18 | instance Eq StringOrInt where 19 | TisAnInt x == TisAnInt y = x == y 20 | TisAString x == TisAString y = x == y 21 | _ == _ = False 22 | 23 | -- Question 4 24 | data Pair a = Pair a a 25 | 26 | instance (Eq a) => Eq (Pair a) where 27 | Pair a a' == Pair b b' = a == b && a' == b' 28 | 29 | -- Question 5 30 | data Tuple a b = Tuple a b 31 | 32 | instance (Eq a, Eq b) => Eq (Tuple a b) where 33 | Tuple a b == Tuple a' b' = a == a' && b == b' 34 | 35 | -- Question 6 36 | data Which a = ThisOne a | ThatOne a 37 | 38 | instance (Eq a) => Eq (Which a) where 39 | ThisOne a == ThisOne a' = a == a' 40 | ThatOne a == ThatOne a' = a == a' 41 | _ == _ = False 42 | 43 | -- Question 7 44 | data EitherOr a b = Hello a | Goodbye b 45 | 46 | instance (Eq a, Eq b) => Eq (EitherOr a b) where 47 | Hello a == Hello a' = a == a' 48 | Goodbye b == Goodbye b' = b == b' 49 | _ == _ = False 50 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/DetermineTheType.md: -------------------------------------------------------------------------------- 1 | # Determine the type 2 | 3 | 1. All function applications return a value. Determine the value 4 | returned by these function applications and the type of that 5 | value. 6 | a) `(* 9) 6 = 54 :: (Num a) => a`. 7 | b) `head [(0,"doge"),(1,"kitteh")] = (0, "doge") :: (Num a) => (a, String)` 8 | c) `head [(0 :: Integer ,"doge"),(1,"kitteh")] = (0, "doge") :: (Integer, String)`. 9 | d) `if False then True else False = False :: Bool`. 10 | e) `length [1, 2, 3, 4, 5] = 5 :: Int` 11 | f) `(length [1, 2, 3, 4]) > (length "TACOCAT") = False :: Bool`. 12 | 13 | 2. Given 14 | ```haskell 15 | x = 5 16 | y = x + 5 17 | w = y * 10 18 | ``` 19 | the type of `w` is `(Num a) => a`. 20 | 21 | 3. Given 22 | ```haskell 23 | x = 5 24 | y = x + 5 25 | z y = y * 10 26 | ``` 27 | the type of `z` is `(Num a) => a -> a`. 28 | Note that `y` in the definition of `z` **shadows** `y = x + 5`. 29 | Therefore `z` is a function instead of a value. 30 | 31 | 4. Given 32 | ```haskell 33 | x = 5 34 | y = x + 5 35 | f = 4 / y 36 | ``` 37 | the type of `f` is `(Fractional a) => a`. 38 | 39 | 5. Given 40 | ```haskell 41 | x = "Julie" 42 | y = " <3 " 43 | z = "Haskell" 44 | f = x ++ y ++ z 45 | ``` 46 | the type of `f` is `String`. 47 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/DoesItCompile.md: -------------------------------------------------------------------------------- 1 | # Does it compile? 2 | 3 | 1. The following 4 | ```haskell 5 | bigNum = (^) 5 $ 10 6 | wahoo = bigNum $ 10 7 | ``` 8 | does not compile because `bigNum` is fully evaluated and takes 9 | no more argument. 10 | The following compiles 11 | ```haskell 12 | bigNum = (^) 5 13 | wahoo = bigNum 10 14 | ``` 15 | 16 | 2. The following 17 | ```haskell 18 | x = print 19 | y = print "woohoo!" 20 | z = x "hello world" 21 | ``` 22 | compiles. 23 | 24 | 3. The following 25 | ```haskell 26 | a = (+) 27 | b = 5 28 | c = b 10 29 | d = c 200 30 | ``` 31 | does not compile because `b` takes no argument, neither does `c`. 32 | The following instead compiles 33 | ```haskell 34 | a = (+) 35 | b = 5 36 | c = a 10 37 | d = c 200 38 | ``` 39 | 40 | 4. The following 41 | ```haskell 42 | a = 12 + b 43 | b = 10000 * c 44 | ``` 45 | does not compile because `b` and `c` are not defined. 46 | The following instead compiles 47 | ```haskell 48 | a b = 12 + b 49 | b c = 10000 * c 50 | ``` 51 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/FixIt.hs: -------------------------------------------------------------------------------- 1 | module Types.ChapterExercises.FixIt where 2 | 3 | -- Question 1 4 | fstString :: [Char] -> [Char] 5 | fstString x = x ++ " in the rain" 6 | 7 | sndString :: [Char] -> [Char] 8 | sndString x = x ++ " over the rainbow" 9 | 10 | sing :: [Char] 11 | sing = if (x > y) then fstString x else sndString y 12 | where x = "Singin" 13 | y = "Somewhere" 14 | 15 | -- Question 2 16 | main :: IO () 17 | main = do 18 | print $ 1 + 2 19 | putStrLn $ show 10 20 | print (negate (-1)) 21 | print ((+) 0 blah) 22 | where blah = negate 1 23 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/GivenATypeWriteTheFunction.hs: -------------------------------------------------------------------------------- 1 | module Types.ChapterExercises.GivenATypeWriteTheFunction where 2 | 3 | -- Question 1 4 | i :: a -> a 5 | -- or i = id 6 | i a = a 7 | 8 | -- Question 2 9 | c :: a -> b -> a 10 | -- or c = const 11 | c a _ = a 12 | 13 | -- Question 3 14 | c'' :: b -> a -> b 15 | c'' = c 16 | 17 | -- Question 4 18 | c' :: a -> b -> b 19 | c' _ b = b 20 | 21 | -- Question 5 22 | r :: [a] -> [a] 23 | r = id 24 | r' :: [a] -> [a] 25 | r' = reverse 26 | 27 | -- Question 6 28 | co :: (b -> c) -> (a -> b) -> (a -> c) 29 | co f g = f . g 30 | 31 | -- Question 7 32 | a :: (a -> c) -> a -> a 33 | a _ x = x 34 | 35 | -- Question 8 36 | a' :: (a -> b) -> a -> b 37 | a' f x = f x 38 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/MultipleChoice.md: -------------------------------------------------------------------------------- 1 | # Multiple choice 2 | 3 | 1. A value of type `[a]` is c) a list whose elements are all of some type `a`. 4 | 5 | 2. A function of type `[[a]] -> [a]` could a) take a list of strings as an argument. 6 | 7 | 3. A function of type `[a] -> Int -> a` b) returns one element of type `a` from a list. 8 | 9 | 4. A function of type `(a, b) -> a` c) takes a tuple argument and returns the first value. 10 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/TypeKwonDo.hs: -------------------------------------------------------------------------------- 1 | module Types.ChapterExercises.TypeKwonDo where 2 | 3 | -- Question 1 4 | f :: Int -> String 5 | f = undefined 6 | 7 | g :: String -> Char 8 | g = undefined 9 | 10 | h :: Int -> Char 11 | h = g . f 12 | 13 | -- Question 2 14 | data A 15 | data B 16 | data C 17 | 18 | q :: A -> B 19 | q = undefined 20 | 21 | w :: B -> C 22 | w = undefined 23 | 24 | e :: A -> C 25 | e = w . q 26 | 27 | -- Question 3 28 | data X 29 | data Y 30 | data Z 31 | 32 | xz :: X -> Z 33 | xz = undefined 34 | 35 | yz :: Y -> Z 36 | yz = undefined 37 | 38 | xform :: (X, Y) -> (Z, Z) 39 | xform (x, y) = (xz x, yz y) 40 | 41 | -- Question 4 42 | munge :: (x -> y) -> (y -> (w, z)) -> x -> w 43 | munge f g = fst . g . f 44 | -------------------------------------------------------------------------------- /src/Types/ChapterExercises/WriteATypeSignature.hs: -------------------------------------------------------------------------------- 1 | module Types.ChapterExercises.WriteATypeSignature where 2 | 3 | -- Question 1 4 | functionH :: [a] -> a 5 | functionH (x:_) = x 6 | 7 | -- Question 2 8 | functionC :: (Ord a) => a -> a -> Bool 9 | functionC x y = if (x > y) then True else False 10 | 11 | -- Question 3 12 | functionS :: (a, b) -> b 13 | functionS (x, y) = y 14 | -------------------------------------------------------------------------------- /src/Types/Currying/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Intermission: Exercises 2 | 3 | 1. If the type of `f` is `a -> a -> a -> a`, 4 | and the type of `x` is `Char`, 5 | then the type of `f x` is 6 | a) `Char -> Char -> Char`. 7 | 8 | 2. If the type of `g` is `a -> b -> c -> b`, 9 | then the type of `g 0 'c' "woot"` is d) `Char`. 10 | 11 | 3. If the type of `h` is `(Num a, Num b) => a -> b -> b`, 12 | then the type of `h 1.0 2` is 13 | d) `Num b => b`. 14 | 15 | 4. If the type of `h` is `(Num a, Num b) => a -> b -> b`, 16 | then the type of `h 1 (5.5 :: Double)` is 17 | c) `Double`. 18 | 19 | 5. If the type of `jackal` is `(Ord a, Eq b) => a -> b -> a`, then 20 | the type of `jackal "keyboard" "has the word jackal in it"` is 21 | a) `[Char]`. 22 | 23 | 6. If the type of `jackal` is `(Ord a, Eq b) => a -> b -> a`, then 24 | the type of `jackal "keyboard"` is 25 | e) `Eq b => b -> [Char]`. 26 | 27 | 7. If the type of `kessel` is `(Ord a, Num b) => a -> b -> a`, then 28 | the type of `kessel 1 2` is 29 | d) `(Num a, Ord a) => a`. 30 | 31 | 8. If the type of `kessel` is `(Ord a, Num b) => a -> b -> a`, then 32 | the type of `kessel 1 (2 :: Integer)` is a) `(Num a, Ord a) => a`. 33 | 34 | 9. If the type of `kessel` is `(Ord a, Num b) => a -> b -> a`, then 35 | the type of `kessel (1 :: Integer) 2` is c) `Integer`. 36 | -------------------------------------------------------------------------------- /src/Types/Polymorphism/IntermissionExercises.hs: -------------------------------------------------------------------------------- 1 | module Types.Polymorphism.IntermissionExercises where 2 | 3 | -- Question 1 4 | -- It is not possible to do other things than return the same value 5 | id' :: a -> a 6 | id' a = a 7 | 8 | -- Question 2 9 | -- Only two possible implementations 10 | func :: a -> a -> a 11 | func a b = a 12 | 13 | func' :: a -> a -> a 14 | func' a b = b 15 | 16 | -- Question 3 17 | -- Only one implementation 18 | func'' :: a -> b -> b 19 | func'' _ b = b 20 | -------------------------------------------------------------------------------- /src/Types/TypeInference/IntermissionExercises.md: -------------------------------------------------------------------------------- 1 | # Type inference 2 | 3 | 1. For `(++) :: [a] -> [a] -> [a]`, we have 4 | ```haskell 5 | myConcat :: String -> String 6 | myConcat x = x ++ " yo" 7 | ``` 8 | 9 | 2. For `(*) :: Num a => a -> a -> a`, we have 10 | ```haskell 11 | myMult :: (Fractional a) => a -> a 12 | myMult x = (x / 3) * 5 13 | ``` 14 | 15 | 3. For `take :: Int -> [a] -> [a]`, we have 16 | ```haskell 17 | myTake :: Int -> String 18 | myTake x = take x "hey you" 19 | ``` 20 | 21 | 4. For `(>) :: Ord a => a -> a -> Bool`, we have 22 | ```haskell 23 | myCom :: Int -> Bool 24 | myCom x = x > (length [1..10]) 25 | ``` 26 | 27 | 5. For `(<) :: Ord a => a -> a -> Bool`, we have 28 | ```haskell 29 | myAlph :: Char -> Bool 30 | myAlph x = x < 'z' 31 | ``` 32 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: [] 5 | resolver: lts-16.6 6 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/BinaryTree/ConvertBinaryTreesToListsSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.ConvertBinaryTreesToListsSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.BinaryTree.ConvertBinaryTreesToLists 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test preorder, inorder and postorder" $ do 9 | let testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf) 10 | it "preorder" $ do 11 | preorder testTree `shouldBe` [2, 1, 3] 12 | it "inorder" $ do 13 | inorder testTree `shouldBe` [1, 2, 3] 14 | it "postorder" $ do 15 | postorder testTree `shouldBe` [1, 3, 2] 16 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/BinaryTree/WriteFoldrForBinaryTreeSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.WriteFoldrForBinaryTreeSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.BinaryTree.WriteFoldrForBinaryTree 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test foldTree" $ do 9 | it "Test mapTree implemented with foldTree" $ do 10 | let testTree = Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf) 11 | let mapExpected = Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf) 12 | mapTree (+1) testTree `shouldBe` mapExpected 13 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/BinaryTree/WriteMapForBinaryTreeSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.BinaryTree.WriteMapForBinaryTreeSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.BinaryTree.WriteMapForBinaryTree 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test mapTree" $ do 9 | it "(+1)" $ do 10 | let testTree = Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf) 11 | let mapExpected = Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf) 12 | mapTree (+1) testTree `shouldBe` mapExpected 13 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ChapterExercises/AsPatternsSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.AsPatternsSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ChapterExercises.AsPatterns 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test isSubsequenceOf" $ do 9 | it "isSubsequenceOf \"blah\" \"blahwoot\"" $ do 10 | isSubsequenceOf "blah" "blahwoot" `shouldBe` True 11 | it "isSubsequenceOf \"blah\" \"wootblah\"" $ do 12 | isSubsequenceOf "blah" "wootblah" `shouldBe` True 13 | it "isSubsequenceOf \"blah\" \"wboloath\"" $ do 14 | isSubsequenceOf "blah" "wboloath" `shouldBe` True 15 | it "isSubsequenceOf \"blah\" \"wootbla\"" $ do 16 | isSubsequenceOf "blah" "wootbla" `shouldBe` False 17 | it "isSubsequenceOf \"blah\" \"halbwoot\"" $ do 18 | isSubsequenceOf "blah" "halbwoot" `shouldBe` False 19 | it "isSubsequenceOf \"abc\" \"cba\"" $ do 20 | isSubsequenceOf "abc" "cba" `shouldBe` False 21 | describe "Test capitalizeWords" $ do 22 | it "capitalizeWords \"hello world\"" $ do 23 | capitalizeWords "hello world" `shouldBe` [("hello", "Hello"), ("world", "World")] 24 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ChapterExercises/CiphersSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.CiphersSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ChapterExercises.Ciphers 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test calculateCompanion" $ do 9 | it "message=MEET AT DAWN and keyword=ALLY" $ do 10 | calculateCompanion "MEET AT DAWN" "ALLY" `shouldBe` "ALLY AL LYAL" 11 | describe "Test vigenereCipher" $ do 12 | it "message=MEET AT DAWN and keyword=ALLY" $ do 13 | vigenereCipher "MEET AT DAWN" "ALLY" `shouldBe` "MPPR AE OYWY" 14 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ChapterExercises/HuttonRazorSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.HuttonRazorSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ChapterExercises.HuttonRazor 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test eval" $ 9 | it "eval (Add (Lit 1) (Lit 9001))" $ do 10 | eval (Add (Lit 1) (Lit 9001)) `shouldBe` 9002 11 | describe "Test showExpr" $ do 12 | it "printExpr (Add (Lit 1) (Lit 9001))" $ do 13 | printExpr (Add (Lit 1) (Lit 9001)) `shouldBe` "1 + 9001" 14 | it "printExpr a3" $ do 15 | let a1 = Add (Lit 9001) (Lit 1) 16 | a2 = Add a1 (Lit 20001) 17 | a3 = Add (Lit 1) a2 18 | printExpr a3 `shouldBe` "1 + 9001 + 1 + 20001" 19 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ChapterExercises/LanguageExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.LanguageExercisesSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ChapterExercises.LanguageExercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test capitalizeWord" $ do 9 | it "Empty string" $ do 10 | capitalizeWord "" `shouldBe` "" 11 | it "Single char" $ do 12 | capitalizeWord "h" `shouldBe` "H" 13 | it "Single word" $ do 14 | capitalizeWord "hello" `shouldBe` "Hello" 15 | it "Multiple words" $ do 16 | capitalizeWord "hello world" `shouldBe` "Hello world" 17 | describe "Test capitalizeParagraph" $ do 18 | it "Empty string" $ do 19 | capitalizeParagraph "" `shouldBe` "" 20 | it "Single char" $ do 21 | capitalizeParagraph "h" `shouldBe` "H" 22 | it "Single word" $ do 23 | capitalizeParagraph "hello" `shouldBe` "Hello" 24 | it "Multiple words" $ do 25 | capitalizeParagraph "hello world" `shouldBe` "Hello world" 26 | it "Multiple phrases" $ do 27 | capitalizeParagraph "blah. woot ha." `shouldBe` "Blah. Woot ha." 28 | it "Comma" $ do 29 | capitalizeParagraph "blah, woot ha." `shouldBe` "Blah, woot ha." 30 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ChapterExercises/PhoneExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ChapterExercises.PhoneExerciseSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ChapterExercises.PhoneExercise 5 | 6 | daPhone :: DaPhone 7 | daPhone = DaPhone [ 8 | Button '1' "1", 9 | Button '2' "abc2", 10 | Button '3' "def3", 11 | Button '4' "ghi4", 12 | Button '5' "jkl5", 13 | Button '6' "mno6", 14 | Button '7' "pqrs7", 15 | Button '8' "tuv8", 16 | Button '9' "wxyz9", 17 | Button '*' "^*", 18 | Button '0' "+ 0", 19 | Button '#' ".,#" 20 | ] 21 | 22 | convo :: [String] 23 | convo = 24 | ["Wanna play 20 questions", 25 | "Ya", 26 | "U 1st haha", 27 | "Lol ok. Have u ever tasted alcohol lol", 28 | "Lol ya", 29 | "Wow ur cool haha. Ur turn", 30 | "Ok. Do u think I am pretty Lol", 31 | "Lol ya", 32 | "Haha thanks just making sure rofl ur turn"] 33 | 34 | spec :: Spec 35 | spec = do 36 | describe "Test reverseTaps" $ do 37 | it "reverseTaps daPhone 'a'" $ do 38 | reverseTaps daPhone 'a' `shouldBe` [('2', 1)] 39 | it "reverseTaps 'A'" $ do 40 | reverseTaps daPhone 'A' `shouldBe` [('*', 1), ('2', 1)] 41 | it "reverseTaps '7'" $ do 42 | reverseTaps daPhone '7' `shouldBe` [('7', 5)] 43 | it "reverseTaps '1'" $ do 44 | reverseTaps daPhone '1' `shouldBe` [('1', 1)] 45 | it "reverseTaps 'z'" $ do 46 | reverseTaps daPhone 'Z' `shouldBe` [('*', 1), ('9', 4)] 47 | it "reverseTaps ' '" $ do 48 | reverseTaps daPhone ' ' `shouldBe` [('0', 2)] 49 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ConstructingAndDeconstructingValues/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ConstructingAndDeconstructingValues.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ConstructingAndDeconstructingValues.Exercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test allProgrammers" $ do 9 | it "Test cardinality" $ do 10 | length allProgrammers `shouldBe` length allOperatingSystems * length allLanguages 11 | describe "Test allProgrammers'" $ do 12 | it "Test cardinality" $ do 13 | length allProgrammers' `shouldBe` length allOperatingSystems * length allLanguages 14 | -------------------------------------------------------------------------------- /test/AlgebraicDataTypes/ProductTypes/JamminExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module AlgebraicDataTypes.ProductTypes.JamminExercisesSpec where 2 | 3 | import Test.Hspec 4 | import AlgebraicDataTypes.ProductTypes.JamminExercises 5 | 6 | row1, row2, row3, row4, row5, row6 :: JamJars 7 | row1 = Jam Peach 5 8 | row2 = Jam Plum 2 9 | row3 = Jam Apple 1 10 | row4 = Jam Blackberry 7 11 | row5 = Jam Peach 4 12 | row6 = Jam Apple 8 13 | 14 | allJams :: [JamJars] 15 | allJams = [row1, row2, row3, row4, row5, row6] 16 | 17 | 18 | spec :: Spec 19 | spec = do 20 | describe "Test groupJam" $ do 21 | it "groupJam" $ do 22 | groupJam allJams `shouldBe` [[Jam Peach 5, Jam Peach 4], [Jam Plum 2], [Jam Apple 1, Jam Apple 8], [Jam Blackberry 7]] 23 | -------------------------------------------------------------------------------- /test/Applicative/ApplicativeInUse/ConstantExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.ConstantExerciseSpec where 2 | 3 | import Data.Monoid (Sum (..)) 4 | import Test.Hspec 5 | import Applicative.ApplicativeInUse.ConstantExercise 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test Constant implementation" $ do 10 | it "Constant (Sum 1) <*> Constant (Sum 2) should equal Constant (Sum 3)" $ do 11 | Constant (Sum 1) <*> Constant (Sum 2) `shouldBe` Constant (Sum 3) 12 | it "pure 1 :: Constant String Int should be Constant \"\"" $ do 13 | (pure 1 :: Constant String Int) `shouldBe` Constant "" 14 | -------------------------------------------------------------------------------- /test/Applicative/ApplicativeInUse/IdentityExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ApplicativeInUse.IdentityExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Applicative.ApplicativeInUse.IdentityExercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test Identity" $ do 9 | it "const <$> Identity [1, 2, 3] <*> Identity [9, 9, 9]" $ do 10 | const <$> Identity [1, 2, 3] <*> Identity [9, 9, 9] `shouldBe` Identity [1, 2, 3] 11 | -------------------------------------------------------------------------------- /test/Applicative/ChapterExercises/ApplicativeInstancesSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ChapterExercises.ApplicativeInstancesSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Classes 7 | import Applicative.ChapterExercises.ApplicativeInstances 8 | 9 | spec :: Spec 10 | spec = do 11 | testBatch $ applicative (undefined :: Identity (Integer, Integer, Integer)) 12 | testBatch $ applicative (undefined :: Pair (Integer, Integer, Integer)) 13 | testBatch $ applicative (undefined :: Two String (Integer, Integer, Integer)) 14 | testBatch $ applicative (undefined :: Three String String (Integer, Integer, Integer)) 15 | testBatch $ applicative (undefined :: Three' String (Integer, Integer, Integer)) 16 | testBatch $ applicative (undefined :: Four String String String (Integer, Integer, Integer)) 17 | testBatch $ applicative (undefined :: Four' String (Integer, Integer, Integer)) 18 | -------------------------------------------------------------------------------- /test/Applicative/ChapterExercises/CombinationsSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ChapterExercises.CombinationsSpec where 2 | 3 | import Test.Hspec 4 | import Applicative.ChapterExercises.Combinations 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test Combinations" $ do 9 | it "Cardinal should be ok" $ do 10 | length (combos stops vowels stops) `shouldBe` length stops * length vowels * length stops 11 | -------------------------------------------------------------------------------- /test/Applicative/ZipListMonoid/ListApplicativeExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ListApplicativeExerciseSpec where 2 | 3 | import Applicative.ZipListMonoid.ListApplicativeExercise 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test the ListApplicative implementation" $ do 9 | it "Cons (+1) (Cons (*2) Nil) <*> Cons 1 (Cons 2 Nil)" $ do 10 | Cons (+1) (Cons (*2) Nil) <*> Cons 1 (Cons 2 Nil) `shouldBe` Cons 2 (Cons 3 (Cons 2 (Cons 4 Nil))) 11 | -------------------------------------------------------------------------------- /test/Applicative/ZipListMonoid/ValidationExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ValidationExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Checkers 7 | import Test.QuickCheck.Classes 8 | import Applicative.ZipListMonoid.ValidationExercise 9 | 10 | spec :: Spec 11 | spec = do 12 | testBatch $ applicative (undefined :: Sum String (Integer, Integer, Integer)) 13 | -------------------------------------------------------------------------------- /test/Applicative/ZipListMonoid/ZipListApplicativeExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Applicative.ZipListMonoid.ZipListApplicativeExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Classes 7 | import Applicative.ZipListMonoid.ZipListApplicativeExercise 8 | 9 | spec :: Spec 10 | spec = do 11 | testBatch $ applicative (undefined :: ZipList' (Integer, Integer, Integer)) 12 | -------------------------------------------------------------------------------- /test/Foldable/ChapterExercises/WriteFilterFunctionSpec.hs: -------------------------------------------------------------------------------- 1 | module Foldable.ChapterExercises.WriteFilterFunctionSpec where 2 | 3 | import Data.Monoid 4 | import Test.Hspec 5 | import Foldable.ChapterExercises.WriteFilterFunction 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test filterF" $ do 10 | it "filterF (const False) (1, 1)" $ do 11 | (filterF (const False) (1, 1) :: (Sum Integer, Product Integer)) `shouldBe` (Sum 0, Product 1) 12 | it "filterF (const True) (2, 2)" $ do 13 | (filterF (const True) (2, 2) :: (Sum Integer, Product Integer)) `shouldBe` (Sum 0, Product 2) 14 | -------------------------------------------------------------------------------- /test/Foldable/ChapterExercises/WriteFoldableInstancesSpec.hs: -------------------------------------------------------------------------------- 1 | module Foldable.ChapterExercises.WriteFoldableInstancesSpec where 2 | 3 | import Data.Monoid 4 | import Test.Hspec 5 | import Foldable.ChapterExercises.WriteFoldableInstances 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test Constant a b" $ do 10 | it "foldMap (++\"hi\") (Constant 5 :: Constant Integer String)" $ do 11 | foldMap (++"hi") (Constant 5 :: Constant Integer String) `shouldBe` "" 12 | it "foldMap (*5) (Constant 5 :: Constant Integer (Sum Integer))" $ do 13 | foldMap (*5) (Constant 5 :: Constant Integer (Sum Integer)) `shouldBe` Sum 0 14 | describe "Test Two a b" $ do 15 | it "foldr (*) 10 (Two 1 2)" $ do 16 | foldr (*) 10 (Two 1 2) `shouldBe` 20 17 | -- foldMap still needs an Monoid constraints for type check 18 | it "foldMap (*5) (Two 1 2 :: Two (Sum Integer) (Sum Integer))" $ do 19 | foldMap (*5) (Two 1 2 :: Two (Sum Integer) (Sum Integer)) `shouldBe` Sum 10 20 | describe "Test Three a b c" $ do 21 | it "foldr (*) 10 (Three 1 2 3)" $ do 22 | foldr (*) 10 (Three 1 2 3) `shouldBe` 30 23 | describe "Test Three' a b" $ do 24 | it "foldr (*) 10 (Three' 1 2 3)" $ do 25 | foldr (*) 10 (Three' 1 2 3) `shouldBe` 60 26 | it "foldMap (*10) (Three' 1 2 3 :: Three' Integer (Sum Integer))" $ do 27 | foldMap (*10) (Three' 1 2 3 :: Three' Integer (Sum Integer)) `shouldBe` Sum 50 28 | describe "Test Four' a b" $ do 29 | it "foldMap (*10) (Four' 1 2 3 4 :: Four' Integer (Product Integer))" $ do 30 | foldMap (*10) (Four' 1 2 3 4 :: Four' Integer (Product Integer)) `shouldBe` Product (20 * 30 * 40) 31 | -------------------------------------------------------------------------------- /test/FoldingLists/ChapterExercises/RewritingFunctionsUsingFoldsSpec.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.ChapterExercises.RewritingFunctionsUsingFoldsSpec where 2 | 3 | import Test.Hspec 4 | import FoldingLists.ChapterExercises.RewritingFunctionsUsingFolds 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test myAny" $ do 9 | it "myAny even [1, 3, 5]" $ do 10 | myAny even [1, 3, 5] `shouldBe` False 11 | it "myAny odd [1, 3, 5]" $ do 12 | myAny odd [1, 3, 5] `shouldBe` True 13 | describe "Test myElem" $ do 14 | it "myElem 1 [1..10]" $ do 15 | myElem 1 [1..10] `shouldBe` True 16 | it "myElem 1 [2..10]" $ do 17 | myElem 1 [2..10] `shouldBe` False 18 | describe "Test myReverse" $ do 19 | it "myReverse \"blah\"" $ do 20 | myReverse "blah" `shouldBe` "halb" 21 | it "myReverse [1..5]" $ do 22 | myReverse [1..5] `shouldBe` [5,4,3,2,1] 23 | describe "Test squishMap" $ do 24 | it "squishMap (\\x -> [1, x, 3]) [2]" $ do 25 | squishMap (\x -> [1, x, 3]) [2] `shouldBe` [1,2,3] 26 | it "squishMap (\\x -> \"WO \" ++ [x] ++ \" OT \") \"blah\"" $ do 27 | squishMap (\x -> "WO " ++ [x] ++ " OT ") "blah" `shouldBe` "WO b OT WO l OT WO a OT WO h OT " 28 | describe "Test myMaximumBy" $ do 29 | it "myMaximumBy (\\_ _ -> GT) [1..10]" $ do 30 | myMaximumBy (\_ _ -> GT) [1..10] `shouldBe` 1 31 | it "myMaximumBy (\\_ _ -> LT) [1..10]" $ do 32 | myMaximumBy (\_ _ -> LT) [1..10] `shouldBe` 10 33 | it "myMaximumBy compare [1..10]" $ do 34 | myMaximumBy compare [1..10] `shouldBe` 10 35 | describe "Test myMinimumBy" $ do 36 | it "myMinimumBy (\\_ _ -> GT) [1..10]" $ do 37 | myMinimumBy (\_ _ -> GT) [1..10] `shouldBe` 10 38 | it "myMinimumBy (\\_ _ -> LT) [1..10]" $ do 39 | myMinimumBy (\_ _ -> LT) [1..10] `shouldBe` 1 40 | it "myMinimumBy compare [1..10]" $ do 41 | myMinimumBy compare [1..10] `shouldBe` 1 42 | -------------------------------------------------------------------------------- /test/FoldingLists/HowToWriteFoldFunctions/IntermissionExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.HowToWriteFoldFunctions.IntermissionExercisesSpec where 2 | 3 | import Data.Time 4 | import Test.Hspec 5 | 6 | import FoldingLists.HowToWriteFoldFunctions.IntermissionExercises 7 | 8 | theDatabase :: [DatabaseItem] 9 | theDatabase = 10 | [ DbDate (UTCTime 11 | (fromGregorian 1911 5 1) 12 | (secondsToDiffTime 34123)) 13 | , DbNumber 9001 14 | , DbString "Hello, world!" 15 | , DbDate (UTCTime 16 | (fromGregorian 1921 5 1) 17 | (secondsToDiffTime 34123)) 18 | ] 19 | 20 | spec :: Spec 21 | spec = do 22 | describe "Test filterDbDate" $ do 23 | it "filterDbDate theDatabase" $ do 24 | let t1 = UTCTime (fromGregorian 1911 5 1) (secondsToDiffTime 34123) 25 | t2 = UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123) 26 | filterDbDate theDatabase `shouldBe` [t1, t2] 27 | describe "Test filterDbNumber" $ do 28 | it "filterDbNumber theDatabase" $ do 29 | filterDbNumber theDatabase `shouldBe` [9001] 30 | describe "Test mostRecent" $ do 31 | it "mostRecent theDatabase" $ do 32 | mostRecent theDatabase `shouldBe` UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123) 33 | describe "Test sumDb" $ do 34 | it "sumDb theDatabase" $ do 35 | sumDb theDatabase `shouldBe` 9001 36 | describe "Test avgDb" $ do 37 | it "avgDb theDatabase" $ do 38 | avgDb theDatabase `shouldBe` 9001 39 | -------------------------------------------------------------------------------- /test/FoldingLists/Scans/ScansExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module FoldingLists.Scans.ScansExercisesSpec where 2 | 3 | import Test.Hspec 4 | import FoldingLists.Scans.ScansExercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test factorial" $ do 9 | it "take 5 factorial" $ do 10 | take 5 factorial `shouldBe` [1, 2, 6, 24, 120] 11 | -------------------------------------------------------------------------------- /test/Functor/ChapterExercises/RearrangeArgumentsSpec.hs: -------------------------------------------------------------------------------- 1 | module Functor.ChapterExercises.RearrangeArgumentsSpec where 2 | 3 | import Test.Hspec 4 | import Functor.ChapterExercises.RearrangeArguments 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test the implementation of More" $ do 9 | it "fmap (+1) (L 1 2 3)" $ do 10 | fmap (+1) (L 1 2 3) `shouldBe` L 2 2 4 11 | it "fmap (+1) (R 1 2 3)" $ do 12 | fmap (+1) (R 1 2 3) `shouldBe` R 1 3 3 13 | -------------------------------------------------------------------------------- /test/Functor/CommonlyUsedFunctors/LiftingExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Functor.CommonlyUsedFunctors.LiftingExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Functor.CommonlyUsedFunctors.LiftingExercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Lifting exercises" $ do 9 | it "check a" $ do 10 | a `shouldBe` [2] 11 | it "check b" $ do 12 | b `shouldBe` Just ["Hi,lol","Hellolol"] 13 | it "check c" $ do 14 | c 1 `shouldBe` -2 15 | it "check d" $ do 16 | d 0 `shouldBe` "1[0,1,2,3]" 17 | it "check e" $ do 18 | x <- e 19 | x `shouldBe` 3693 20 | -------------------------------------------------------------------------------- /test/Functor/IgnoringPossibilities/ShortExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Functor.IgnoringPossibilities.ShortExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Function 6 | import Functor.IgnoringPossibilities.ShortExercise 7 | 8 | functorIdentity :: (Functor f, Eq (f a)) => f a -> Bool 9 | functorIdentity f = fmap id f == f 10 | 11 | functorCompose :: (Functor f, Eq (f c)) => (f a) 12 | -> Fun a b 13 | -> Fun b c 14 | -> Bool 15 | functorCompose x (Fun _ f) (Fun _ g) = 16 | (fmap (g . f) x) == (fmap g . fmap f $ x) 17 | 18 | type IntToInt = Fun Int Int 19 | 20 | spec :: Spec 21 | spec = do 22 | describe "Test Functor implementation of Possibly and Sum" $ do 23 | it "Possibly identity" $ do 24 | property $ (functorIdentity :: Possibly Int -> Bool) 25 | it "Possibly compose" $ do 26 | property $ (functorCompose :: Possibly Int -> IntToInt -> IntToInt -> Bool) 27 | it "Sum identity" $ do 28 | property $ (functorIdentity :: Sum Int Int -> Bool) 29 | it "Sum compose" $ do 30 | property $ (functorCompose :: Sum Int Int -> IntToInt -> IntToInt -> Bool) 31 | -------------------------------------------------------------------------------- /test/Lists/ChapterExercises/CharSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.CharSpec where 2 | 3 | import Test.Hspec 4 | import Lists.ChapterExercises.Char 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test keepOnlyUppercase" $ do 9 | it "keepOnlyUppercase \"HbEfLrLxO\"" $ do 10 | keepOnlyUppercase "HbEfLrLxO" `shouldBe` "HELLO" 11 | describe "Test captializeFirstLetter" $ do 12 | it "captializeFirstLetter \"julie\"" $ do 13 | captializeFirstLetter "julie" `shouldBe` "Julie" 14 | describe "Test captialize" $ do 15 | it "captialize \"woot\"" $ do 16 | captialize "woot" `shouldBe` "WOOT" 17 | -------------------------------------------------------------------------------- /test/Lists/ChapterExercises/CiphersSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.CiphersSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Lists.ChapterExercises.Ciphers 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test caesar" $ do 10 | it "should be the inverse of unCaesar" $ property $ 11 | \x y -> (unCaesar x . caesar x) y == y 12 | -------------------------------------------------------------------------------- /test/Lists/ChapterExercises/WritingYourOwnStandardFunctionsSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.ChapterExercises.WritingYourOwnStandardFunctionsSpec where 2 | 3 | import Test.Hspec 4 | import Lists.ChapterExercises.WritingYourOwnStandardFunctions 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test myAny" $ do 9 | it "myAny even [1, 3, 5]" $ do 10 | myAny even [1, 3, 5] `shouldBe` False 11 | it "myAny odd [1, 3, 5]" $ do 12 | myAny odd [1, 3, 5] `shouldBe` True 13 | describe "Test myElem" $ do 14 | it "myElem 1 [1..10]" $ do 15 | myElem 1 [1..10] `shouldBe` True 16 | it "myElem 1 [2..10]" $ do 17 | myElem 1 [2..10] `shouldBe` False 18 | describe "Test myReverse" $ do 19 | it "myReverse \"blah\"" $ do 20 | myReverse "blah" `shouldBe` "halb" 21 | it "myReverse [1..5]" $ do 22 | myReverse [1..5] `shouldBe` [5, 4, 3, 2, 1] 23 | describe "Test squishMap" $ do 24 | it "squishMap (\\x -> [1, x, 3]) [2]" $ do 25 | squishMap (\x -> [1, x, 3]) [2] `shouldBe` [1,2,3] 26 | it "squishMap (\\x -> \"WO \"++[x]++\" HOO \") \"123\"" $ do 27 | squishMap (\x -> "WO "++[x]++" HOO ") "123" `shouldBe` "WO 1 HOO WO 2 HOO WO 3 HOO " 28 | describe "Test myMaximumBy" $ do 29 | it "myMaximumBy (\\_ _ -> GT) [1..10]" $ do 30 | myMaximumBy (\_ _ -> GT) [1..10] `shouldBe` 1 31 | it "myMaximumBy (\\_ _ -> LT) [1..10]" $ do 32 | myMaximumBy (\_ _ -> LT) [1..10] `shouldBe` 10 33 | it "myMaximumBy compare [1..10]" $ do 34 | myMaximumBy compare [1..10] `shouldBe` 10 35 | describe "Test myMinimumBy" $ do 36 | it "myMinimumBy (\\_ _ -> GT) [1..10]" $ do 37 | myMinimumBy (\_ _ -> GT) [1..10] `shouldBe` 10 38 | it "myMinimumBy (\\_ _ -> LT) [1..10]" $ do 39 | myMinimumBy (\_ _ -> LT) [1..10] `shouldBe` 1 40 | it "myMinimumBy compare [1..10]" $ do 41 | myMinimumBy compare [1..10] `shouldBe` 1 42 | -------------------------------------------------------------------------------- /test/Lists/ExtractingPortionsOfLists/IntermissionExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.ExtractingPortionsOfLists.IntermissionExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Lists.ExtractingPortionsOfLists.IntermissionExercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test myWords" $ do 9 | it "myWords \"all i wanna do is have some fun\"" $ do 10 | myWords "all i wanna do is have some fun" `shouldBe` ["all","i","wanna","do","is","have","some","fun"] 11 | it "myWords \" \"" $ do 12 | myWords " " `shouldBe` [] 13 | it "myWords \" Hello world \"" $ do 14 | myWords " Hello world " `shouldBe` ["Hello", "world"] 15 | describe "Test myLines" $ do 16 | it "myLines \"a\nb c\nd\"" $ do 17 | myLines "a\nb c\nd" `shouldBe` ["a", "b c", "d"] 18 | it "myLines sentences" $ do 19 | let firstSen = "Tyger Tyger, burning bright\n" 20 | secondSen = "In the forests of the night\n" 21 | thirdSen = "What immortal hand or eye\n" 22 | fourthSen = "Could frame thy fearful symmetry?" 23 | sentences = firstSen ++ secondSen 24 | ++ thirdSen ++ fourthSen 25 | shouldEqual = 26 | [ "Tyger Tyger, burning bright" 27 | , "In the forests of the night" 28 | , "What immortal hand or eye" 29 | , "Could frame thy fearful symmetry?" 30 | ] 31 | myLines sentences `shouldBe` shouldEqual 32 | -------------------------------------------------------------------------------- /test/Lists/FilteringListsOfValues/IntermissionExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.FilteringListsOfValues.IntermissionExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Lists.FilteringListsOfValues.IntermissionExercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test multiplesOfThree" $ do 9 | it "multiplesOfThree [1..10]" $ do 10 | multiplesOfThree [1..10] `shouldBe` [3, 6, 9] 11 | describe "Test howManyMultiplesOfThree" $ do 12 | it "howManyMultiplesOfThree [1..10]" $ do 13 | howManyMultiplesOfThree [1..10] `shouldBe` 3 14 | describe "Test removeArticles" $ do 15 | it "removeArticles \"the brown dog was a goof\"" $ do 16 | removeArticles "the brown dog was a goof" `shouldBe` ["brown","dog","was","goof"] 17 | -------------------------------------------------------------------------------- /test/Lists/UsingRangesToConstructLists/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.UsingRangesToConstructLists.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Lists.UsingRangesToConstructLists.Exercise 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test eftBool" $ do 10 | it "is equivalent to enumFromTo" $ property $ 11 | \x y -> eftBool x y == [x..y] 12 | describe "Test eftOrd" $ do 13 | it "is equivalent to enumFromTo" $ property $ 14 | \x y -> eftOrd x y == [x..y] 15 | describe "Test eftInt" $ do 16 | it "is equivalent to enumFromTo" $ property $ 17 | \x y -> eftInt x y == [x..y] 18 | describe "Test eftChar" $ do 19 | it "is equivalent to enumFromTo" $ property $ 20 | \x y -> eftChar x y == [x..y] 21 | -------------------------------------------------------------------------------- /test/Lists/ZippingLists/ZippingExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Lists.ZippingLists.ZippingExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Lists.ZippingLists.ZippingExercises 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test zip'" $ do 10 | it "behaves the same as zip" $ property $ 11 | \x y -> zip' x y == zip (x::[Int]) (y::[Int]) 12 | describe "Test zipWith'" $ do 13 | it "behaves the same as zipWith" $ property $ 14 | \x y -> zipWith' (+) x y == zipWith (+) (x::[Int]) (y::[Int]) 15 | describe "Test zip''" $ do 16 | it "behaves the same as zip" $ property $ 17 | \x y -> zip'' x y == zip (x::[Int]) (y::[Int]) 18 | -------------------------------------------------------------------------------- /test/Monad/ChapterExercises/RewriteFunctionsSpec.hs: -------------------------------------------------------------------------------- 1 | module Monad.ChapterExercises.RewriteFunctionsSpec where 2 | 3 | import Test.Hspec 4 | import Monad.ChapterExercises.RewriteFunctions 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test j" $ do 9 | it "j [[1, 2], [], [3]]" $ do 10 | j [[1, 2], [], [3]] `shouldBe` [1, 2, 3] 11 | it "j (Just (Just 1))" $ do 12 | j (Just (Just 1)) `shouldBe` Just 1 13 | it "j (Just Nothing)" $ do 14 | j (Just Nothing) `shouldBe` (Nothing :: Maybe Integer) 15 | it "j Nothing" $ do 16 | j Nothing `shouldBe` (Nothing :: Maybe Integer) 17 | -------------------------------------------------------------------------------- /test/Monad/ChapterExercises/WriteMonadInstancesSpec.hs: -------------------------------------------------------------------------------- 1 | module Monad.ChapterExercises.WriteMonadInstancesSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Checkers 7 | import Test.QuickCheck.Classes 8 | import Monad.ChapterExercises.WriteMonadInstances 9 | 10 | spec :: Spec 11 | spec = do 12 | describe "Test Nope a" $ do 13 | testBatch $ functor (undefined :: Nope (Integer, Integer, Integer)) 14 | testBatch $ applicative (undefined :: Nope (Integer, Integer, Integer)) 15 | testBatch $ monad (undefined :: Nope (Integer, Integer, Integer)) 16 | describe "Test PhhhbbtttEither b a" $ do 17 | testBatch $ functor (undefined :: PhhhbbtttEither Integer (Integer, Integer, Integer)) 18 | testBatch $ applicative (undefined :: PhhhbbtttEither Integer (Integer, Integer, Integer)) 19 | testBatch $ monad (undefined :: PhhhbbtttEither Integer (Integer, Integer, Integer)) 20 | describe "Test Identity a" $ do 21 | testBatch $ functor (undefined :: Identity (Integer, Integer, Integer)) 22 | testBatch $ applicative (undefined :: Identity (Integer, Integer, Integer)) 23 | testBatch $ monad (undefined :: Identity (Integer, Integer, Integer)) 24 | describe "Test List a" $ do 25 | testBatch $ functor (undefined :: List (Integer, Integer, Integer)) 26 | testBatch $ applicative (undefined :: List (Integer, Integer, Integer)) 27 | testBatch $ monad (undefined :: List (Integer, Integer, Integer)) 28 | -------------------------------------------------------------------------------- /test/Monad/ExampleOfMonadUse/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Monad.ExampleOfMonadUse.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Classes 7 | import Monad.ExampleOfMonadUse.Exercise 8 | 9 | spec :: Spec 10 | spec = do 11 | testBatch $ functor (undefined :: Sum Integer (Integer, Integer, Integer)) 12 | testBatch $ applicative (undefined :: Sum Integer (Integer, Integer, Integer)) 13 | testBatch $ monad (undefined :: Sum Integer (Integer, Integer, Integer)) 14 | -------------------------------------------------------------------------------- /test/Monad/Monad/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Monad.Monad.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Monad.Monad.Exercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test bind" $ do 9 | it "bind" $ do 10 | let f n 11 | | n >= 0 = Just n 12 | | otherwise = Nothing 13 | bind f (Just 1) `shouldBe` Just 1 14 | bind f (Just (-2)) `shouldBe` Nothing 15 | bind f Nothing `shouldBe` Nothing 16 | -------------------------------------------------------------------------------- /test/MonadTransformers/ChapterExercises/WriteTheCodeSpec.hs: -------------------------------------------------------------------------------- 1 | module MonadTransformers.ChapterExercises.WriteTheCodeSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Control.Monad.Trans.Reader 6 | import Control.Monad.Trans.State 7 | import MonadTransformers.ChapterExercises.WriteTheCode 8 | 9 | spec :: Spec 10 | spec = do 11 | describe "Test rDec" $ do 12 | it "runReader rDec 1" $ do 13 | runReader rDec 1 `shouldBe` 0 14 | it "fmap (runReader rDec) [1..10]" $ do 15 | fmap (runReader rDec) [1..10] `shouldBe` [0,1,2,3,4,5,6,7,8,9] 16 | it "is equivalent to rDec'" $ property $ 17 | \x -> runReader rDec x == runReader rDec' (x :: Int) 18 | describe "Test rShow" $ do 19 | it "runReader rShow 1" $ do 20 | runReader rShow 1 `shouldBe` "1" 21 | it "fmap (runReader rShow) [1..10]" $ do 22 | fmap (runReader rShow) [1..10] `shouldBe` ["1","2","3","4","5","6","7","8","9","10"] 23 | it "is equivalent to rShow'" $ property $ 24 | \x -> runReader rShow x == runReader rShow' (x :: Int) 25 | describe "Test rPrintAndInc" $ do 26 | it "runReaderT rPrintAndInc 1" $ do 27 | a <- runReaderT rPrintAndInc 1 28 | a `shouldBe` 2 29 | it "traverse (runReaderT rPrintAndInc) [1..10]" $ do 30 | a <- traverse (runReaderT rPrintAndInc) [1..10] 31 | a `shouldBe` [2,3,4,5,6,7,8,9,10,11] 32 | describe "Test sPrintIncAccum" $ do 33 | it "runStateT sPrintIncAccum 10" $ do 34 | a <- runStateT sPrintIncAccum 10 35 | a `shouldBe` ("10", 11) 36 | it "mapM (runStateT sPrintIncAccum) [1..5]" $ do 37 | a <- mapM (runStateT sPrintIncAccum) [1..5] 38 | a `shouldBe` [("1",2),("2",3),("3",4),("4",5),("5",6)] 39 | -------------------------------------------------------------------------------- /test/Monoid/ChapterExercises/MonoidExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Monoid.ChapterExercises.MonoidExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Monoid.ChapterExercises.SemigroupExercises 6 | import Monoid.ChapterExercises.MonoidExercises 7 | 8 | monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool 9 | monoidLeftIdentity a = (mempty <> a) == a 10 | 11 | monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool 12 | monoidRightIdentity a = (a <> mempty) == a 13 | 14 | spec :: Spec 15 | spec = do 16 | describe "Test Monoid implementations" $ do 17 | it "Trivial Left identity" $ do 18 | property (monoidLeftIdentity :: Trivial -> Bool) 19 | it "Trivial Right identity" $ do 20 | property (monoidRightIdentity :: Trivial -> Bool) 21 | it "Identity Left identity" $ do 22 | property (monoidLeftIdentity :: Identity String -> Bool) 23 | it "Identity Right identity" $ do 24 | property (monoidRightIdentity :: Identity String -> Bool) 25 | it "Two Left identity" $ do 26 | property (monoidLeftIdentity :: Two String String -> Bool) 27 | it "Two Right identity" $ do 28 | property (monoidRightIdentity :: Two String String -> Bool) 29 | it "BoolConj Left identity" $ do 30 | property (monoidLeftIdentity :: BoolConj -> Bool) 31 | it "BoolConj Right identity" $ do 32 | property (monoidRightIdentity :: BoolConj -> Bool) 33 | it "BoolDisj Left identity" $ do 34 | property (monoidLeftIdentity :: BoolDisj -> Bool) 35 | it "BoolDisj Right identity" $ do 36 | property (monoidRightIdentity :: BoolDisj -> Bool) 37 | describe "Mem implementation" $ do 38 | let f' = Mem $ \s -> ("hi", s + 1) 39 | it "runMem (f' <> mempty) 0" $ do 40 | runMem (f' <> mempty) 0 `shouldBe` ("hi",1) 41 | it "runMem (mempty <> f') 0" $ do 42 | runMem (mempty <> f') 0 `shouldBe` ("hi",1) 43 | it "(runMem mempty 0 :: (String, Int))" $ do 44 | (runMem mempty 0 :: (String, Int)) `shouldBe` ("",0) 45 | it "runMem (f' <> mempty) 0 == runMem f' 0" $ do 46 | runMem (f' <> mempty) 0 == runMem f' 0 `shouldBe` True 47 | it "runMem (mempty <> f') 0 == runMem f' 0" $ do 48 | runMem (mempty <> f') 0 == runMem f' 0 `shouldBe` True 49 | -------------------------------------------------------------------------------- /test/Monoid/ChapterExercises/SemigroupExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module Monoid.ChapterExercises.SemigroupExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Monoid.ChapterExercises.SemigroupExercises 6 | 7 | semigroupAssoc :: (Eq m, Semigroup m) => m -> m -> m -> Bool 8 | semigroupAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c) 9 | 10 | spec :: Spec 11 | spec = do 12 | describe "Test Semigroup implementations" $ do 13 | it "Trivial" $ do 14 | property (semigroupAssoc :: Trivial -> Trivial -> Trivial -> Bool) 15 | it "Identity a" $ do 16 | property (semigroupAssoc :: Identity String -> Identity String -> Identity String -> Bool) 17 | it "Two a b" $ do 18 | property (semigroupAssoc :: Two String String -> Two String String ->Two String String -> Bool) 19 | it "BoolConj" $ do 20 | property (semigroupAssoc :: BoolConj -> BoolConj -> BoolConj -> Bool) 21 | it "BoolDisj" $ do 22 | property (semigroupAssoc :: BoolDisj -> BoolDisj -> BoolDisj -> Bool) 23 | it "Or a b" $ do 24 | property (semigroupAssoc :: Or Integer Integer -> Or Integer Integer -> Or Integer Integer -> Bool) 25 | it "Validation a b" $ do 26 | property (semigroupAssoc :: Validation String String -> Validation String String -> Validation String String -> Bool) 27 | it "AccumulateRight a b" $ do 28 | property (semigroupAssoc :: AccumulateRight String String -> AccumulateRight String String -> AccumulateRight String String -> Bool) 29 | it "AccumulateBoth a b" $ do 30 | property (semigroupAssoc :: AccumulateBoth String String -> AccumulateBoth String String -> AccumulateBoth String String -> Bool) 31 | -------------------------------------------------------------------------------- /test/Monoid/ReusingAlgebras/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Monoid.ReusingAlgebras.ExerciseSpec where 2 | 3 | import Data.Monoid 4 | import Test.Hspec 5 | import Test.QuickCheck 6 | import Monoid.ReusingAlgebras.Exercise 7 | 8 | monoidAssoc :: (Eq m, Monoid m) => m -> m -> m -> Bool 9 | monoidAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c) 10 | 11 | monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool 12 | monoidLeftIdentity a = (mempty <> a) == a 13 | 14 | monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool 15 | monoidRightIdentity a = (a <> mempty) == a 16 | 17 | firstMappend :: First a -> First a -> First a 18 | firstMappend = mappend 19 | 20 | type FirstMappend = First String 21 | -> First String 22 | -> First String 23 | -> Bool 24 | 25 | spec :: Spec 26 | spec = do 27 | describe "Optional is monoid" $ do 28 | it "mappend of two Only Sum type should be Only the sum" $ do 29 | Only (Sum 1) `mappend` Only (Sum 1) `shouldBe` Only (Sum 2) 30 | it "mappend of two Only Product type should be Only the product" $ do 31 | Only (Product 4) `mappend` Only (Product 2) `shouldBe` Only (Product 8) 32 | it "mappend right Nada should always be the first" $ do 33 | property $ \x -> Only (Sum x) `mappend` Nada == Only (Sum (x :: Int)) 34 | it "mappend left Nada should always be the second" $ do 35 | property $ \x -> Nada `mappend` Only x == Only (x :: [Int]) 36 | -------------------------------------------------------------------------------- /test/MoreFunctionalPatterns/ChapterExercises/LetUsWriteCodeSpec.hs: -------------------------------------------------------------------------------- 1 | module MoreFunctionalPatterns.ChapterExercises.LetUsWriteCodeSpec where 2 | 3 | import Test.Hspec 4 | import MoreFunctionalPatterns.ChapterExercises.LetUsWriteCode 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test roundTrip'" $ do 9 | it "roundTrip' 4" $ do 10 | roundTrip' 4 `shouldBe` 4 11 | -------------------------------------------------------------------------------- /test/ParserCombinators/Alternative/IntermissionExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.Alternative.IntermissionExerciseSpec where 2 | 3 | import Data.Ratio ((%)) 4 | import Test.Hspec 5 | import Text.Trifecta 6 | import ParserCombinators.Alternative.IntermissionExercise 7 | 8 | spec :: Spec 9 | spec = do 10 | describe "Test parseIor" $ do 11 | it "parseString parseIor mempty \"1\"" $ do 12 | parseString parseIor mempty "1" `shouldBe` Success (Right 1) 13 | it "parseString parseIor mempty \"12\"" $ do 14 | parseString parseIor mempty "12" `shouldBe` Success (Right 12) 15 | it "parseString parseIor mempty \"1/2\"" $ do 16 | parseString parseIor mempty "1/2" `shouldBe` Success (Left (1 % 2)) 17 | it "parseString parseIor mempty \"1/0\"" $ do 18 | parseString parseIor mempty "1/0" `shouldBe` Success (Right 1) 19 | -------------------------------------------------------------------------------- /test/ParserCombinators/ChapterExercises/IPV4AddressesSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.IPV4AddressesSpec where 2 | 3 | import Control.Applicative 4 | import Data.Word 5 | import Text.Trifecta 6 | import Test.Hspec 7 | import Test.QuickCheck (property) 8 | import ParserCombinators.ChapterExercises.IPV4Addresses 9 | 10 | spec :: Spec 11 | spec = do 12 | describe "Test decimalToBin" $ do 13 | it "decimalToBin 0" $ do 14 | decimalToBin 0 `shouldBe` [0] 15 | it "decimalToBin 1" $ do 16 | decimalToBin 1 `shouldBe` [1] 17 | it "decimalToBin 2" $ do 18 | decimalToBin 2 `shouldBe` [1, 0] 19 | it "decimalToBin 3" $ do 20 | decimalToBin 3 `shouldBe` [1, 1] 21 | it "decimalToBin 4" $ do 22 | decimalToBin 4 `shouldBe` [1, 0, 0] 23 | it "decimalToBin 5" $ do 24 | decimalToBin 5 `shouldBe` [1, 0, 1] 25 | it "decimalToBin 6" $ do 26 | decimalToBin 6 `shouldBe` [1, 1, 0] 27 | it "decimalToBin 7" $ do 28 | decimalToBin 7 `shouldBe` [1, 1, 1] 29 | describe "Test dotDecimalToBin" $ do 30 | it "dotDecimalToBin [127, 0, 0, 1]" $ do 31 | dotDecimalToBin [127, 0, 0, 1] `shouldBe` map (\x -> read [x]) "01111111000000000000000000000001" 32 | describe "Test binToDecimal" $ do 33 | it "is inverse to decimalToBin" $ property $ 34 | \x -> (binToDecimal . decimalToBin) x == (x :: Integer) 35 | describe "Test ipAddress" $ do 36 | it "172.16.254.1" $ do 37 | parseString ipAddress mempty "172.16.254.1" `shouldBe` Success (IPAddress 2886794753) 38 | it "204.120.0.15" $ do 39 | parseString ipAddress mempty "204.120.0.15" `shouldBe` Success (IPAddress 3430416399) 40 | describe "Test Show instance" $ do 41 | it "is inverse to ipAddress" $ property $ 42 | \x -> (parseString ipAddress mempty . show) x == Success x 43 | -------------------------------------------------------------------------------- /test/ParserCombinators/ChapterExercises/IPV6AddressesSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.IPV6AddressesSpec where 2 | 3 | import Control.Applicative 4 | import Data.Word 5 | import Text.Trifecta 6 | import Test.Hspec 7 | import Test.QuickCheck (property) 8 | import ParserCombinators.ChapterExercises.IPV6Addresses 9 | 10 | spec :: Spec 11 | spec = do 12 | describe "Test uncollapse" $ do 13 | it "uncollapse [\"FE80\",\"\",\"0202\",\"B3FF\",\"FE1E\",\"8329\"]" $ do 14 | uncollapse ["FE80","","0202","B3FF","FE1E","8329"] `shouldBe` ["FE80","0", "0", "0", "0202","B3FF","FE1E","8329"] 15 | it "uncollapse [\"FE80\",\"0\",\"0\",\"0\",\"0202\",\"B3FF\",\"FE1E\",\"8329\"]" $ do 16 | uncollapse ["FE80","0", "0", "0", "0202","B3FF","FE1E","8329"] `shouldBe` ["FE80","0", "0", "0", "0202","B3FF","FE1E","8329"] 17 | describe "Test ipAddress6" $ do 18 | it "parseString ipAddress6 mempty \"0:0:0:0:0:ffff:ac10:fe01\"" $ do 19 | parseString ipAddress6 mempty "0:0:0:0:0:ffff:ac10:fe01" `shouldBe` Success (IPAddress6 0 281473568538113) 20 | it "parseString ipAddress6 mempty \"0:0:0:0:0:ffff:cc78:f\"" $ do 21 | parseString ipAddress6 mempty "0:0:0:0:0:ffff:cc78:f" `shouldBe` Success (IPAddress6 0 281474112159759) 22 | it "parseString ipAddress6 mempty \"FE80::0202:B3FF:FE1E:8329\"" $ do 23 | parseString ipAddress6 mempty "FE80::0202:B3FF:FE1E:8329" `shouldBe` Success (IPAddress6 18338657682652659712 144876050090722089) 24 | it "parseString ipAddress6 mempty \"2001:DB8::8:800:200C:417A\"" $ do 25 | parseString ipAddress6 mempty "2001:DB8::8:800:200C:417A" `shouldBe` Success (IPAddress6 2306139568115548160 2260596444381562) 26 | describe "Test decimalToHex" $ do 27 | it "decimalToHex 2260596444381562" $ do 28 | decimalToHex 2260596444381562 `shouldBe` "80800200C417A" 29 | describe "Test Show instance" $ do 30 | it "is inverse to ipAddress6" $ property $ 31 | \x -> (parseString ipAddress6 mempty . show) x == Success x 32 | -------------------------------------------------------------------------------- /test/ParserCombinators/ChapterExercises/ParseDigitAndIntegerSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.ParseDigitAndIntegerSpec where 2 | 3 | import Text.Trifecta 4 | import Test.Hspec 5 | import ParserCombinators.ChapterExercises.ParseDigitAndInteger 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test parseDigit" $ do 10 | it "parseString parseDigit mempty \"123\"" $ do 11 | parseString parseDigit mempty "123" `shouldBe` Success '1' 12 | it "parseString parseDigit mempty \"abc\"" $ do 13 | parseString parseDigit mempty "abc" `shouldBe` Failure undefined 14 | describe "Test base10Integer" $ do 15 | it "parseString base10Integer mempty \"123abc\"" $ do 16 | parseString base10Integer mempty "123abc" `shouldBe` Success 123 17 | it "parseString base10Integer mempty \"abc\"" $ do 18 | parseString base10Integer mempty "abc" `shouldBe` Failure undefined 19 | it "parseString base10Integer mempty \"-123\"" $ do 20 | parseString base10Integer mempty "-123" `shouldBe` Failure undefined 21 | describe "Test base10Integer'" $ do 22 | it "parseString base10Integer' mempty \"123\"" $ do 23 | parseString base10Integer' mempty "123" `shouldBe` Success 123 24 | it "parseString base10Integer' mempty \"+123abc\"" $ do 25 | parseString base10Integer' mempty "+123abc" `shouldBe` Success 123 26 | it "parseString base10Integer' mempty \"-123abc\"" $ do 27 | parseString base10Integer' mempty "-123abc" `shouldBe` Success (-123) 28 | it "parseString base10Integer' mempty \"abc\"" $ do 29 | parseString base10Integer' mempty "abc" `shouldBe` Failure undefined 30 | -------------------------------------------------------------------------------- /test/ParserCombinators/ChapterExercises/PhoneNumbersSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ChapterExercises.PhoneNumbersSpec where 2 | 3 | import Text.Trifecta 4 | import Test.Hspec 5 | import ParserCombinators.ChapterExercises.PhoneNumbers 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test parseNumberingPlanArea" $ do 10 | it "parseString parseNumberingPlanArea mempty \"123\"" $ do 11 | parseString parseNumberingPlanArea mempty "123" `shouldBe` Success 123 12 | it "parseString parseNumberingPlanArea mempty \"1-123-\"" $ do 13 | parseString parseNumberingPlanArea mempty "123" `shouldBe` Success 123 14 | it "parseString parseNumberingPlanArea mempty \"123-\"" $ do 15 | parseString parseNumberingPlanArea mempty "123-" `shouldBe` Success 123 16 | it "parseString parseNumberingPlanArea mempty \"(123) \"" $ do 17 | parseString parseNumberingPlanArea mempty "(123) " `shouldBe` Success 123 18 | describe "Test parsePhone" $ do 19 | it "parseString parsePhone mempty \"123-456-7890\"" $ do 20 | parseString parsePhone mempty "123-456-7890" `shouldBe` Success (PhoneNumber 123 456 7890) 21 | it "parseString parsePhone mempty \"1234567890\"" $ do 22 | parseString parsePhone mempty "1234567890" `shouldBe` Success (PhoneNumber 123 456 7890) 23 | it "parseString parsePhone mempty \"(123) 456-7890\"" $ do 24 | parseString parsePhone mempty "(123) 456-7890" `shouldBe` Success (PhoneNumber 123 456 7890) 25 | it "parseString parsePhone mempty \"1-123-456-7890\"" $ do 26 | parseString parsePhone mempty "123-456-7890" `shouldBe` Success (PhoneNumber 123 456 7890) 27 | -------------------------------------------------------------------------------- /test/ParserCombinators/ParsingFractions/IntermissionExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.ParsingFractions.IntermissionExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Text.Trifecta 5 | import ParserCombinators.ParsingFractions.IntermissionExercise 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test parseInteger" $ do 10 | it "parseString parseInteger mempty \"123\"" $ do 11 | parseString parseInteger mempty "123" `shouldBe` Success 123 12 | it "parseString parseInteger mempty \"123abc\"" $ do 13 | parseString parseInteger mempty "123abc" `shouldBe` Failure undefined 14 | -------------------------------------------------------------------------------- /test/ParserCombinators/UnderstandingTheParsingProcess/IntermissionExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module ParserCombinators.UnderstandingTheParsingProcess.IntermissionExercisesSpec where 2 | 3 | import Test.Hspec 4 | import Text.Trifecta 5 | import ParserCombinators.UnderstandingTheParsingProcess.IntermissionExercises 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test one" $ do 10 | it "parseString one mempty \"1\"" $ do 11 | parseString one mempty "1" `shouldBe` Success () 12 | it "parseString one mempty \"12\"" $ do 13 | parseString one mempty "12" `shouldBe` Failure undefined 14 | describe "Test oneTwo" $ do 15 | it "parseString oneTwo mempty \"1\"" $ do 16 | parseString oneTwo mempty "1" `shouldBe` Failure undefined 17 | it "parseString oneTwo mempty \"12\"" $ do 18 | parseString oneTwo mempty "12" `shouldBe` Success () 19 | it "parseString oneTwo mempty \"123\"" $ do 20 | parseString oneTwo mempty "123" `shouldBe` Failure undefined 21 | describe "Test oneTwoThree" $ do 22 | it "parseString oneTwoThree mempty \"1\"" $ do 23 | parseString oneTwoThree mempty "1" `shouldBe` Success "1" 24 | it "parseString oneTwoThree mempty \"12\"" $ do 25 | parseString oneTwoThree mempty "12" `shouldBe` Success "12" 26 | it "parseString oneTwoThree mempty \"123\"" $ do 27 | parseString oneTwoThree mempty "123" `shouldBe` Success "123" 28 | describe "Test string'" $ do 29 | let oneTwo'' = string' "12" 30 | it "Test oneTwo'' mempty \"1\"" $ do 31 | parseString oneTwo'' mempty "1" `shouldBe` Failure undefined 32 | it "Test oneTwo'' mempty \"12\"" $ do 33 | parseString oneTwo'' mempty "12" `shouldBe` Success "12" 34 | it "Test oneTwo'' mempty \"123\"" $ do 35 | parseString oneTwo'' mempty "123" `shouldBe` Success "12" 36 | -------------------------------------------------------------------------------- /test/Reader/ButUhReader/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Reader.ButUhReader.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Reader.ButUhReader.Exercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test the ask implementation" $ do 9 | it "runReader ask 1" $ do 10 | runReader ask 1 `shouldBe` 1 11 | it "runReader ask \"haha\"" $ do 12 | runReader ask "haha" `shouldBe` "haha" 13 | -------------------------------------------------------------------------------- /test/Reader/ChapterExercises/WarmUpStretchSpec.hs: -------------------------------------------------------------------------------- 1 | module Reader.ChapterExercises.WarmUpStretchSpec where 2 | 3 | import Test.Hspec 4 | import Reader.ChapterExercises.WarmUpStretch 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test lookup'" $ do 9 | it "xs should be Just 6" $ do 10 | xs `shouldBe` Just 6 11 | it "ys should be Just 9" $ do 12 | ys `shouldBe` Just 9 13 | it "zs should be Nothing" $ do 14 | zs `shouldBe` Nothing 15 | describe "Test Maybe Applicative" $ do 16 | it "x1 should be Just (6, 9)" $ do 17 | x1 `shouldBe` Just (6, 9) 18 | it "x2 shouldBe Nothing" $ do 19 | x2 `shouldBe` Nothing 20 | it "x3 3 shouldBe (Just 9, Just 9)" $ do 21 | x3 3 `shouldBe` (Just 9, Just 9) 22 | describe "Test helper functions" $ do 23 | it "fromMaybe' 0 xs shouldBe 6" $ do 24 | fromMaybe' 0 xs `shouldBe` 6 25 | it "fromMaybe' 0 zs shouldBe 0" $ do 26 | fromMaybe' 0 zs `shouldBe` 0 27 | describe "Test main" $ do 28 | it "sequenceA [Just 3, Just 2, Just 1]" $ do 29 | sequenceA [Just 3, Just 2, Just 1] `shouldBe` Just [3,2,1] 30 | it "sequenceA [x, y]" $ do 31 | sequenceA [x, y] `shouldBe` [[1,4],[1,5],[1,6],[2,4],[2,5],[2,6],[3,4],[3,5],[3,6]] 32 | it "sequenceA [xs, ys]" $ do 33 | sequenceA [xs, ys] `shouldBe` Just [6,9] 34 | it "summed <$> ((,) <$> xs <*> ys)" $ do 35 | summed <$> ((,) <$> xs <*> ys) `shouldBe` Just 15 36 | it "fmap summed ((,) <$> xs <*> zs)" $ do 37 | fmap summed ((,) <$> xs <*> zs) `shouldBe` Nothing 38 | it "bolt 7" $ do 39 | bolt 7 `shouldBe` True 40 | it "fmap bolt z" $ do 41 | fmap bolt z `shouldBe` [True,False,False] 42 | it "sequenceA [(>3), (<8), even] 7" $ do 43 | sequenceA [(>3), (<8), even] 7 `shouldBe` [True, True, False] 44 | describe "More tests" $ do 45 | it "fold (&&) (sequA 7)" $ do 46 | foldr (&&) True (sequA 7) `shouldBe` False 47 | it "(sequA . fromMaybe' 0) s'" $ do 48 | (sequA . fromMaybe' 0) s' `shouldBe` [True, False, False] 49 | it "(bolt . fromMaybe' 0) ys" $ do 50 | (bolt . fromMaybe' 0) ys `shouldBe` False 51 | -------------------------------------------------------------------------------- /test/Reader/FunctionsHaveAnApplicativeToo/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Reader.FunctionsHaveAnApplicativeToo.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Reader.FunctionsHaveAnApplicativeToo.Exercise 5 | 6 | pers :: Person 7 | pers = Person (HumanName "Big Bird") 8 | (DogName "Barkley") 9 | (Address "Sesame Street") 10 | 11 | chris :: Person 12 | chris = Person (HumanName "Chris Allen") 13 | (DogName "Papu") 14 | (Address "Austin") 15 | 16 | spec :: Spec 17 | spec = do 18 | describe "Test getDogR" $ do 19 | it "Test pers" $ do 20 | runReader getDogR pers `shouldBe` Dog (DogName "Barkley") (Address "Sesame Street") 21 | it "Test chris" $ do 22 | runReader getDogR chris `shouldBe` Dog (DogName "Papu") (Address "Austin") 23 | -------------------------------------------------------------------------------- /test/Reader/Reader/ShortExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Reader.Reader.ShortExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Reader.Reader.ShortExercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test composed and fmapped" $ do 9 | it "composed \"Julie\"" $ do 10 | composed "Julie" `shouldBe` "EILUJ" 11 | it "fmapped \"Chris\"" $ do 12 | fmapped "Chris" `shouldBe` "SIRHC" 13 | describe "Test tupled and tupled'" $ do 14 | it "tupled \"Julie\"" $ do 15 | tupled "Julie" `shouldBe` ("JULIE","eiluJ") 16 | it "tupled' \"Julie\"" $ do 17 | tupled' "Julie" `shouldBe` ("JULIE","eiluJ") 18 | -------------------------------------------------------------------------------- /test/Recursion/ChapterExercises/FixingDividedBySpec.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.FixingDividedBySpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Recursion.ChapterExercises.FixingDividedBy 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test div'" $ do 10 | it "should behave the same as div when y /= 0" $ property $ 11 | \x y -> y /= 0 ==> div' x y == Result (x `div` y) 12 | it "should give bottom when y == 0" $ property $ 13 | \x -> div' x 0 == DividedByZero 14 | -------------------------------------------------------------------------------- /test/Recursion/ChapterExercises/McCarthy91FunctionSpec.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.McCarthy91FunctionSpec where 2 | 3 | import Test.Hspec 4 | import Recursion.ChapterExercises.McCarthy91Function 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test mc91" $ do 9 | it "map mc91 [95..110]" $ do 10 | map mc91 [95..110] `shouldBe` [91,91,91,91,91,91,91,92,93,94,95,96,97,98,99,100] 11 | -------------------------------------------------------------------------------- /test/Recursion/ChapterExercises/NumbersIntoWordsSpec.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.NumbersIntoWordsSpec where 2 | 3 | import Test.Hspec 4 | import Recursion.ChapterExercises.NumbersIntoWords 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test wordNumber" $ do 9 | it "wordNumber 12324546" $ do 10 | wordNumber 12324546 `shouldBe` "one-two-three-two-four-five-four-six" 11 | -------------------------------------------------------------------------------- /test/Recursion/ChapterExercises/RecursionSpec.hs: -------------------------------------------------------------------------------- 1 | module Recursion.ChapterExercises.RecursionSpec where 2 | 3 | import Test.Hspec 4 | import Test.QuickCheck 5 | import Recursion.ChapterExercises.Recursion 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test sumToN" $ do 10 | it "should behave the same as sum [1..n]" $ property $ 11 | -- See https://stackoverflow.com/a/12884999 fot 12 | -- the use of `==>` 13 | \n -> n >= 1 ==> sumToN n == sum [1..(n :: Int)] 14 | describe "Test multiply" $ do 15 | it "should be the same as x * y" $ property $ 16 | \x y -> multiply x y == x * (y :: Int) 17 | -------------------------------------------------------------------------------- /test/SignalingAdversity/ChapterExercises/ItIsOnlyNaturalSpec.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.ItIsOnlyNaturalSpec where 2 | 3 | import Test.Hspec 4 | import SignalingAdversity.ChapterExercises.ItIsOnlyNatural 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test natToInteger" $ do 9 | it "natToInteger Zero" $ do 10 | natToInteger Zero `shouldBe` 0 11 | it "natToInteger (Succ Zero)" $ do 12 | natToInteger (Succ Zero) `shouldBe` 1 13 | it "natToInteger (Succ (Succ Zero))" $ do 14 | natToInteger (Succ (Succ Zero)) `shouldBe` 2 15 | describe "Test integerToNat" $ do 16 | it "integerToNat 0" $ do 17 | integerToNat 0 `shouldBe` Just Zero 18 | it "integerToNat 1" $ do 19 | integerToNat 1 `shouldBe` Just (Succ Zero) 20 | it "integerToNat 2" $ do 21 | integerToNat 2 `shouldBe` Just (Succ (Succ Zero)) 22 | it "integerToNat (-1)" $ do 23 | integerToNat (-1) `shouldBe` Nothing 24 | -------------------------------------------------------------------------------- /test/SignalingAdversity/ChapterExercises/IterateAndUnfoldrSpec.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.IterateAndUnfoldrSpec where 2 | 3 | import Test.Hspec 4 | import SignalingAdversity.ChapterExercises.IterateAndUnfoldr 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test betterIterate" $ do 9 | it "take 10 $ betterIterate (+1) 0" $ do 10 | (take 10 $ betterIterate (+1) 0) `shouldBe` [0,1,2,3,4,5,6,7,8,9] 11 | -------------------------------------------------------------------------------- /test/SignalingAdversity/ChapterExercises/SmallLibraryForMaybeSpec.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.SmallLibraryForMaybeSpec where 2 | 3 | import Test.Hspec 4 | import SignalingAdversity.ChapterExercises.SmallLibraryForMaybe 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test isJust" $ do 9 | it "isJust (Just 1)" $ do 10 | isJust (Just 1) `shouldBe` True 11 | it "isJust Nothing" $ do 12 | isJust Nothing `shouldBe` False 13 | describe "Test isNothing" $ do 14 | it "isNothing (Just 1)" $ do 15 | isNothing (Just 1) `shouldBe` False 16 | it "isNothing Nothing" $ do 17 | isNothing Nothing `shouldBe` True 18 | describe "Test maybee" $ do 19 | it "mayybee 0 (+1) Nothing" $ do 20 | mayybee 0 (+1) Nothing `shouldBe` 0 21 | it "mayybee 0 (+1) (Just 1)" $ do 22 | mayybee 0 (+1) (Just 1) `shouldBe` 2 23 | describe "Test fromMaybe" $ do 24 | it "fromMaybe 0 Nothing" $ do 25 | fromMaybe 0 Nothing `shouldBe` 0 26 | it "fromMaybe 0 (Just 1)" $ do 27 | fromMaybe 0 (Just 1) `shouldBe` 1 28 | describe "Test listToMaybe" $ do 29 | it "listToMaybe [1, 2, 3]" $ do 30 | listToMaybe [1, 2, 3] `shouldBe` Just 1 31 | it "listToMaybe []" $ do 32 | listToMaybe ([] :: [Int]) `shouldBe` (Nothing :: Maybe Int) 33 | describe "Test maybeToList" $ do 34 | it "maybeToList (Just 1)" $ do 35 | maybeToList (Just 1) `shouldBe` [1] 36 | it "maybeToList Nothing" $ do 37 | maybeToList (Nothing :: Maybe Int) `shouldBe` ([] :: [Int]) 38 | describe "Test catMaybes" $ do 39 | it "catMaybes [Just 1, Nothing, Just 2]" $ do 40 | catMaybes [Just 1, Nothing, Just 2] `shouldBe` [1, 2] 41 | it "catMaybes [Nothing, Nothing, Nothing]" $ do 42 | catMaybes ([Nothing, Nothing, Nothing] :: [Maybe Int]) `shouldBe` ([] :: [Int]) 43 | describe "Test flipMaybe" $ do 44 | it "flipMaybe [Just 1, Just 2, Just 3]" $ do 45 | flipMaybe [Just 1, Just 2, Just 3] `shouldBe` Just [1, 2, 3] 46 | it "flipMaybe [Just 1, Nothing, Just 3]" $ do 47 | flipMaybe [Just 1, Nothing, Just 3] `shouldBe` (Nothing :: Maybe [Int]) 48 | -------------------------------------------------------------------------------- /test/SignalingAdversity/ChapterExercises/SomethingOtherThanListSpec.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.SomethingOtherThanListSpec where 2 | 3 | import Test.Hspec 4 | import SignalingAdversity.ChapterExercises.SomethingOtherThanList 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test treeBuild" $ do 9 | it "treeBuild 0" $ do 10 | treeBuild 0 `shouldBe` Leaf 11 | it "treeBuild 1" $ do 12 | treeBuild 1 `shouldBe` Node Leaf 0 Leaf 13 | it "treeBuild 2" $ do 14 | treeBuild 2 `shouldBe` Node (Node Leaf 1 Leaf) 0 (Node Leaf 1 Leaf) 15 | it "treeBuild 3" $ do 16 | treeBuild 3 `shouldBe` Node (Node (Node Leaf 2 Leaf) 1 (Node Leaf 2 Leaf)) 0 (Node (Node Leaf 2 Leaf) 1 (Node Leaf 2 Leaf)) 17 | -------------------------------------------------------------------------------- /test/SignalingAdversity/ChapterExercises/StringProcessingSpec.hs: -------------------------------------------------------------------------------- 1 | module SignalingAdversity.ChapterExercises.StringProcessingSpec where 2 | 3 | import Test.Hspec 4 | import SignalingAdversity.ChapterExercises.StringProcessing 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test notThe" $ do 9 | it "notThe \"the\"" $ do 10 | notThe "the" `shouldBe` Nothing 11 | it "notThe \"blahtheblah\"" $ do 12 | notThe "blahtheblah" `shouldBe` Just "blahtheblah" 13 | it "notThe \"woot\"" $ do 14 | notThe "woot" `shouldBe` Just "woot" 15 | describe "Test replaceThe" $ do 16 | it "replaceThe \"the cow loves us\"" $ do 17 | replaceThe "the cow loves us" `shouldBe` "a cow loves us" 18 | describe "Test countTheBeforeVowel" $ do 19 | it "countTheBeforeVowel \"the cow\"" $ do 20 | countTheBeforeVowel "the cow" `shouldBe` 0 21 | it "countTheBeforeVowel \"the evil cow\"" $ do 22 | countTheBeforeVowel "the evil cow" `shouldBe` 1 23 | describe "Test countVowels" $ do 24 | it "countVowels \"the cow\"" $ do 25 | countVowels "the cow" `shouldBe` 2 26 | it "countVowels \"Mikolajczak\"" $ do 27 | countVowels "Mikolajczak" `shouldBe` 4 28 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /test/State/ChapterExercises/ExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module State.ChapterExercises.ExercisesSpec where 2 | 3 | import Test.Hspec 4 | import State.ChapterExercises.Exercises 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test get" $ do 9 | it "runState get \"curryIsAmaze\"" $ do 10 | runState get "curryIsAmaze" `shouldBe` ("curryIsAmaze","curryIsAmaze") 11 | describe "Test put" $ do 12 | it "runState (put \"blah\") \"woot\"" $ do 13 | runState (put "blah") "woot" `shouldBe` ((),"blah") 14 | describe "Test exec" $ do 15 | it "exec (put \"wilma\") \"daphne\"" $ do 16 | exec (put "wilma") "daphne" `shouldBe` "wilma" 17 | it "exec get \"scooby papu\"" $ do 18 | exec get "scooby papu" `shouldBe` "scooby papu" 19 | describe "Test eval" $ do 20 | it "eval get \"bunnicula\"" $ do 21 | eval get "bunnicula" `shouldBe` "bunnicula" 22 | it "eval get \"stake a bunny\"" $ do 23 | eval get "stake a bunny" `shouldBe` "stake a bunny" 24 | describe "Test modify" $ do 25 | it "runState (modify (+1)) 0" $ do 26 | runState (modify (+1)) 0 `shouldBe` ((),1) 27 | it "runState (modify (+1) >> modify (+1)) 0" $ do 28 | runState (modify (+1) >> modify (+1)) 0 `shouldBe` ((),2 :: Int) 29 | -------------------------------------------------------------------------------- /test/State/GetACodingJobWithOneWierdTrick/FizzbuzzDifferentlySpec.hs: -------------------------------------------------------------------------------- 1 | module State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferentlySpec where 2 | 3 | import Test.Hspec 4 | import State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferently 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test fizzbuzzFromTo" $ do 9 | it "fizzbuzzFromTo 1 15" $ do 10 | fizzbuzzFromTo 1 15 `shouldBe` ["1", "2", "Buzz", "4", "Fizz", "Buzz", "7", "8", "Buzz", "Fizz", "11", "Buzz", "13", "14", "FizzBuzz"] 11 | -------------------------------------------------------------------------------- /test/State/ThrowDown/ExercisesSpec.hs: -------------------------------------------------------------------------------- 1 | module State.ThrowDown.ExercisesSpec where 2 | 3 | import System.Random 4 | import Test.Hspec 5 | import State.ThrowDown.Exercises 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Test rollsToGetN" $ do 10 | it "roolsToGetN 20" $ do 11 | rollsToGetN 20 (mkStdGen 0) `shouldBe` 5 12 | describe "Test rollsCountLogged" $ do 13 | it "rollsCountLogged 20" $ do 14 | rollsCountLogged 20 (mkStdGen 0) `shouldBe` (5, [DieFive, DieOne, DieFour, DieSix, DieSix]) 15 | -------------------------------------------------------------------------------- /test/State/WriteStateForYourself/ExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module State.WriteStateForYourself.ExerciseSpec where 2 | 3 | import Test.Hspec 4 | import State.WriteStateForYourself.Exercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test Functor implementation" $ do 9 | it "runMoi ((+1) <$> (Moi $ \\s -> (0, s))) 0" $ do 10 | runMoi ((+1) <$> (Moi $ \s -> (0, s))) 0 `shouldBe` (1, 0) 11 | -------------------------------------------------------------------------------- /test/Testing/ChapterExercises/IdempotenceSpec.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.IdempotenceSpec where 2 | 3 | import Data.List 4 | import Test.Hspec 5 | import Test.QuickCheck 6 | import Testing.ChapterExercises.Idempotence 7 | 8 | f :: String -> Bool 9 | f x = (capitalizeWord x == twice capitalizeWord x) 10 | && (capitalizeWord x == fourTimes capitalizeWord x) 11 | 12 | testCapitalizeWord :: IO () 13 | testCapitalizeWord = quickCheck f 14 | 15 | f' :: [Int] -> Bool 16 | f' x = (sort x == twice sort x) && (sort x == fourTimes sort x) 17 | 18 | testSort :: IO () 19 | testSort = quickCheck f' 20 | 21 | spec :: Spec 22 | spec = do 23 | describe "Check Idempotence" $ do 24 | it "Check capitalizeWord" $ do 25 | property $ f 26 | it "Check sort" $ do 27 | property $ f' 28 | -------------------------------------------------------------------------------- /test/Testing/ChapterExercises/ValidatingNumbersIntoWordsSpec.hs: -------------------------------------------------------------------------------- 1 | module Testing.ChapterExercises.ValidatingNumbersIntoWordsSpec where 2 | 3 | import Test.Hspec 4 | import Testing.ChapterExercises.ValidatingNumbersIntoWords 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "digitToWord does what we want" $ do 9 | it "returns zero for 0" $ do 10 | digitToWord 0 `shouldBe` "zero" 11 | it "returns one for 1" $ do 12 | digitToWord 1 `shouldBe` "one" 13 | describe "digits does what we want" $ do 14 | it "returns [1] for 1" $ do 15 | digits 1 `shouldBe` [1] 16 | it "returns [1, 0, 0] for 100" $ do 17 | digits 100 `shouldBe` [1, 0, 0] 18 | describe "wordNumber does what we want" $ do 19 | it "returns one-zero-zero for 100" $ do 20 | wordNumber 100 `shouldBe` "one-zero-zero" 21 | it "returns nine-zero-zero-one for 9001" $ do 22 | wordNumber 9001 `shouldBe` "nine-zero-zero-one" 23 | -------------------------------------------------------------------------------- /test/Testing/ConventionalTesting/IntermissionExerciseSpec.hs: -------------------------------------------------------------------------------- 1 | module Testing.ConventionalTesting.IntermissionExerciseSpec where 2 | 3 | import Test.Hspec 4 | import Testing.ConventionalTesting.IntermissionExercise 5 | 6 | spec :: Spec 7 | spec = do 8 | describe "Test dividedBy and multiply" $ do 9 | it "15 divided by 3 is 5" $ do 10 | dividedBy 15 3 `shouldBe` (5, 0) 11 | it "22 divided by 5 is 4 remainder 2" $ do 12 | dividedBy 22 5 `shouldBe` (4, 2) 13 | it "1 times 2 should be 2" $ do 14 | multiply 1 2 `shouldBe` 2 15 | it "-1 times -2 should be 2" $ do 16 | multiply (-1) (-2) `shouldBe` 2 17 | it "1 times -2 should be -2" $ do 18 | multiply 1 (-2) `shouldBe` -2 19 | -------------------------------------------------------------------------------- /test/Traversable/ChapterExercises/InstancesForTreeSpec.hs: -------------------------------------------------------------------------------- 1 | module Traversable.ChapterExercises.InstancesForTreeSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Classes 7 | import Traversable.ChapterExercises.InstancesForTree 8 | 9 | spec :: Spec 10 | spec = do 11 | testBatch $ traversable (undefined :: Tree (Int, Int, [Int])) 12 | -------------------------------------------------------------------------------- /test/Traversable/ChapterExercises/TraversableInstancesSpec.hs: -------------------------------------------------------------------------------- 1 | module Traversable.ChapterExercises.TraversableInstancesSpec where 2 | 3 | import Test.Hspec 4 | import Test.Hspec.Checkers 5 | import Test.QuickCheck 6 | import Test.QuickCheck.Classes 7 | import Traversable.ChapterExercises.TraversableInstances 8 | 9 | spec :: Spec 10 | spec = do 11 | testBatch $ traversable (undefined :: Identity (Int, Int, [Int])) 12 | testBatch $ traversable (undefined :: Constant Int (Int, Int, [Int])) 13 | testBatch $ traversable (undefined :: Optional (Int, Int, [Int])) 14 | testBatch $ traversable (undefined :: List (Int, Int, [Int])) 15 | testBatch $ traversable (undefined :: Three Int Int (Int, Int, [Int])) 16 | testBatch $ traversable (undefined :: Three' Int (Int, Int, [Int])) 17 | testBatch $ traversable (undefined :: S [] (Int, Int, [Int])) 18 | --------------------------------------------------------------------------------