diff options
| author | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
| commit | 98329e0a3dd4f78b5d815ac3896272ec70904901 (patch) | |
| tree | 80f9c56cfe2ac20232358f236d32e84bd683be1b /Haskell-book/26/Exercises | |
| parent | 3624c712d72d246f21d4e710cec7c11e052e0326 (diff) | |
| download | book-exercises-98329e0a3dd4f78b5d815ac3896272ec70904901.tar.gz | |
Add remaining haskell book exercises
Diffstat (limited to 'Haskell-book/26/Exercises')
| -rw-r--r-- | Haskell-book/26/Exercises/.gitignore | 3 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/Setup.hs | 2 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/app/Main.hs | 61 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/package.yaml | 37 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/src/Exercises.hs | 75 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/src/Fix.hs | 24 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/stack.yaml | 65 | ||||
| -rw-r--r-- | Haskell-book/26/Exercises/test/Spec.hs | 19 |
8 files changed, 286 insertions, 0 deletions
diff --git a/Haskell-book/26/Exercises/.gitignore b/Haskell-book/26/Exercises/.gitignore new file mode 100644 index 0000000..3834f98 --- /dev/null +++ b/Haskell-book/26/Exercises/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +Exercises.cabal +*~
\ No newline at end of file diff --git a/Haskell-book/26/Exercises/Setup.hs b/Haskell-book/26/Exercises/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Haskell-book/26/Exercises/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Haskell-book/26/Exercises/app/Main.hs b/Haskell-book/26/Exercises/app/Main.hs new file mode 100644 index 0000000..6bfe6bb --- /dev/null +++ b/Haskell-book/26/Exercises/app/Main.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader +import Data.IORef +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy as TL +import System.Environment (getArgs) +import Web.Scotty.Trans ( ScottyT(..) + , ActionT(..) + , scottyT + , get + , html + , param ) + +data Config = + Config { + -- that's one, one click! + -- two...two clicks! + -- Three BEAUTIFUL clicks! ah ah ahhhh + counts :: IORef (M.Map Text Integer) + , prefix :: Text + } + +type Scotty = ScottyT Text (ReaderT Config IO) + +bumpBoomp :: Text + -> M.Map Text Integer + -> (M.Map Text Integer, Integer) +bumpBoomp k m = + let (maybeCount, newMap) = M.insertLookupWithKey (\_ _ oldCount -> oldCount + 1) k 1 m + in case maybeCount of + Nothing -> (newMap, 1) + Just oldCount -> (newMap, oldCount + 1) + +app :: Scotty () +app = + get "/:key" $ do + unprefixed <- param "key" + prefix <- lift $ asks prefix + let key' = mappend prefix unprefixed + counts <- lift $ asks counts + (newMap, newInteger) <- liftIO $ bumpBoomp key' <$> readIORef counts + liftIO $ writeIORef counts newMap + html $ mconcat [ "<h1>Success! Count was: " + , TL.pack $ show (newInteger :: Integer) + , "</h1>" + ] + +main :: IO () +main = do + [prefixArg] <- getArgs + counter <- newIORef M.empty + let config = Config {counts = counter, prefix = TL.pack prefixArg} + runR = flip runReaderT config + scottyT 3000 runR app diff --git a/Haskell-book/26/Exercises/package.yaml b/Haskell-book/26/Exercises/package.yaml new file mode 100644 index 0000000..a757233 --- /dev/null +++ b/Haskell-book/26/Exercises/package.yaml @@ -0,0 +1,37 @@ +name: Exercises +version: 0.1.0.0 +license: BSD3 +author: "Eugen Wissner" +maintainer: "belka@caraus.de" +copyright: "2018 Eugen Wissner" + +dependencies: +- base >= 4.7 && < 5 +- containers +- scotty +- transformers +- text + +library: + source-dirs: src + +executables: + HitCounter: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + +tests: + Exercises-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - Exercises + - hspec diff --git a/Haskell-book/26/Exercises/src/Exercises.hs b/Haskell-book/26/Exercises/src/Exercises.hs new file mode 100644 index 0000000..d3a8370 --- /dev/null +++ b/Haskell-book/26/Exercises/src/Exercises.hs @@ -0,0 +1,75 @@ +module Exercises where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Reader (Reader(..), ReaderT(..), runReader, runReaderT) +import Control.Monad.Trans.State (StateT(..)) +import Data.Functor.Identity (Identity(..)) + +-- 1. rDec is a function that should get its argument in the context of +-- Reader and return a value decremented by one. +-- +-- Note that “Reader” from transformers is ReaderT of Identity and +-- that runReader is a convenience function throwing away the +-- meaningless structure for you. Play with runReaderT if you like. +rDec :: Num a => Reader a a +rDec = ReaderT $ dec + where dec :: Num a => a -> Identity a + dec = return . (flip (-) 1) + +-- 2. Once you have an rDec that works, make it and any inner lamb- +-- das pointfree if that’s not already the case. + + +-- 3. rShow is show, but in Reader. +rShow :: Show a => Reader a String +rShow = ReaderT $ toString + where toString = return . show + +-- 4. Once you have an rShow that works, make it pointfree. + + +-- 5. rPrintAndInc will first print the input with a greeting, then return +-- the input incremented by one. +rPrintAndInc :: (Num a, Show a) => ReaderT a IO a +rPrintAndInc = ReaderT print + where print x = do + liftIO $ putStrLn $ "Hi: " ++ show x + return $ x + 1 + +-- Prelude> runReaderT rPrintAndInc 1 +-- Hi: 1 +-- 2 +-- Prelude> traverse (runReaderT rPrintAndInc) [1..10] +-- Hi: 1 +-- Hi: 2 +-- Hi: 3 +-- Hi: 4 +-- Hi: 5 +-- Hi: 6 +-- Hi: 7 +-- Hi: 8 +-- Hi: 9 +-- Hi: 10 +-- [2,3,4,5,6,7,8,9,10,11] + + +-- 6. sPrintIncAccum first prints the input with a greeting, then puts +-- the incremented input as the new state, and returns the original +-- input as a String. +sPrintIncAccum :: (Num a, Show a) => StateT a IO String +sPrintIncAccum = StateT print + where print x = do + liftIO $ putStrLn $ "Hi: " ++ show x + return $ (show x, x + 1) + +-- Prelude> runStateT sPrintIncAccum 10 +-- Hi: 10 +-- ("10",11) +-- Prelude> mapM (runStateT sPrintIncAccum) [1..5] +-- Hi: 1 +-- Hi: 2 +-- Hi: 3 +-- Hi: 4 +-- Hi: 5 +-- [("1",2),("2",3),("3",4),("4",5),("5",6)] diff --git a/Haskell-book/26/Exercises/src/Fix.hs b/Haskell-book/26/Exercises/src/Fix.hs new file mode 100644 index 0000000..bd43f7f --- /dev/null +++ b/Haskell-book/26/Exercises/src/Fix.hs @@ -0,0 +1,24 @@ +module Fix where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Maybe +import Control.Monad + +isValid :: String -> Bool +isValid v = '!' `elem` v + +maybeExcite :: MaybeT IO String +maybeExcite = do + v <- liftIO getLine + guard $ isValid v + return v + +doExcite :: IO () +doExcite = do + putStrLn "say something excite!" + excite <- runMaybeT maybeExcite + case excite of + Nothing -> putStrLn "MOAR EXCITE" + Just e -> + putStrLn + ("Good, was very excite: " ++ e) diff --git a/Haskell-book/26/Exercises/stack.yaml b/Haskell-book/26/Exercises/stack.yaml new file mode 100644 index 0000000..1962baa --- /dev/null +++ b/Haskell-book/26/Exercises/stack.yaml @@ -0,0 +1,65 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-11.8 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor
\ No newline at end of file diff --git a/Haskell-book/26/Exercises/test/Spec.hs b/Haskell-book/26/Exercises/test/Spec.hs new file mode 100644 index 0000000..92db8e6 --- /dev/null +++ b/Haskell-book/26/Exercises/test/Spec.hs @@ -0,0 +1,19 @@ +import Control.Monad.Trans.Reader +import Exercises +import Test.Hspec + +main :: IO () +main = hspec $ do + describe "rDec" $ do + it "returns a value decremented by one" $ do + runReader rDec 1 `shouldBe` 0 + + it "decrements all elements of a list" $ do + (fmap (runReader rDec) [1..10]) `shouldBe` [0,1,2,3,4,5,6,7,8,9] + + describe "rShow" $ do + it "shows a number" $ do + runReader rShow 1 `shouldBe` "1" + + it "shows a list" $ do + (fmap (runReader rShow) [1..10]) `shouldBe` ["1","2","3","4","5","6","7","8","9","10"] |
