git.iko.soy/production-haskell
on dd85609 help sign in
db26395
swap
0 ahead, 12 behind
26 files changed+799−1725
since splitsnapshots
unifiedsplit
flake.nix−24 hw.md−25 seminars/1/package.yaml+2−6 seminars/1/shell.nix+11 seminars/1/src/Task.hs+344−362 seminars/1/stack.yaml+2−2 seminars/1/task.cabal+7−12 seminars/1/test/Main.hs+1−6 seminars/1/test/Tests.hs+432−85 seminars/2/package.yaml−19 seminars/2/src/Task.hs−398 seminars/2/stack.yaml−7 seminars/2/task.cabal−44 seminars/2/test/Main.hs−10 seminars/2/test/Tests.hs−439 seminars/calc/.gitignore−2 seminars/calc/CHANGELOG.md−11 seminars/calc/LICENSE−26 seminars/calc/README.md−1 seminars/calc/Setup.hs−2 seminars/calc/app/Main.hs−6 seminars/calc/calc.cabal−76 seminars/calc/package.yaml−62 seminars/calc/src/Lib.hs−27 seminars/calc/stack.yaml−71 seminars/calc/test/Spec.hs−2
flake.nixdeleted−24
@@ -1,24 +0,0 @@
1−{
2− inputs = {
3− nixpkgs.url = "github:NixOS/nixpkgs";
4− flake-utils.url = "github:numtide/flake-utils";
5− };
6−
7− outputs = { self, flake-utils, nixpkgs }:
8− let
9− supportedSystems =
10− [ "x86_64-linux" "x86_64-darwin" "aarch64-darwin" "aarch64-linux" ];
11− compilerVersion = "982";
12− in flake-utils.lib.eachSystem supportedSystems (system:
13− let pkgs = import nixpkgs { inherit system; };
14− in {
15− devShells.default = pkgs.mkShell {
16− buildInputs = with pkgs; [
17− haskell.compiler."ghc${compilerVersion}"
18− (pkgs.haskell-language-server.override {
19− supportedGhcVersions = [ compilerVersion ];
20− })
21− ];
22− };
23− });
24−}
hw.mddeleted−25
@@ -1,25 +0,0 @@
1−# Homework
2−
3−The task is to recreate a portion of the functionality of the unix utility [`wc`](https://linux.die.net/man/1/wc).
4−
5−## Functionality
6−
7−1. `-c, --bytes` (2 point)
8−2. `-m, --chars` (2 point)
9−3. `-l, --lines` (4 points)
10−
11−Properly parsing the CLI arguments into a separate data structure will give you 2 additional points for a total of 10.
12−
13−Please see the [`wc` docs](https://linux.die.net/man/1/wc) for what every option should do.
14−
15−The binary should accept one additional CLI argument -- a path to the file to read. You do not need to read from stdin.
16−
17−The program should run in constant memory.
18−
19−## Implementation
20−
21−You should use the [`nightly-2024-10-11`](https://www.stackage.org/nightly-2024-10-11) stack snapshot in your project.
22−
23−You should use the [streamly](https://hackage.haskell.org/package/streamly) family of packages for streaming functionality. Using a streaming package will help ensure constant memory.
24−
25−You should use the [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) package to parse CLI arguments.
seminars/1/package.yaml+2−6
@@ -4,10 +4,7 @@ license: Unlicense
44
55dependencies:
66 - base >= 4.7 && < 5
7− - QuickCheck
8−
9−default-extensions:
10− - EmptyDataDeriving
7+ - containers
118
129library:
1310 source-dirs: src
@@ -18,6 +15,5 @@ tests:
1815 main: Main.hs
1916 dependencies:
2017 - tasty
21− - tasty-hspec
22− - hspec
18+ - tasty-hunit
2319 - task
seminars/1/shell.nixnew file+11
@@ -0,0 +1,11 @@
1+{ pkgs ? import <nixpkgs> { } }:
2+
3+let compilerVersion = "963";
4+in pkgs.mkShell {
5+ buildInputs = with pkgs; [
6+ haskell.compiler."ghc${compilerVersion}"
7+ (pkgs.haskell-language-server.override {
8+ supportedGhcVersions = [ compilerVersion ];
9+ })
10+ ];
11+}
seminars/1/src/Task.hs+344−362
@@ -1,388 +1,370 @@
1+{-# LANGUAGE InstanceSigs #-}
12module Task
2− ( regroup,
3− safeHead,
4− safeLast,
5− withoutLast,
6− indexed,
7− alternating,
8− constructTree,
9− leftmost,
10− rightmost,
11− treeSum,
12− insert,
13− insertAll,
14− treeSize,
15− getInt, getString, twoAndHello
16− , StringList
17− )
18−where
19−
20−import Numeric.Natural
21−import Test.QuickCheck
3+ ( -- * List Monoids
4+ constructFirstMonoid,
5+ destructFirstMonoid,
6+ FirstMonoid,
7+ constructLastMonoid,
8+ destructLastMonoid,
9+ LastMonoid,
2210
23−data IntAndString = IntAndStringCons Int String
11+ -- * Todo List
12+ Priority (..),
13+ Completion (..),
14+ TaskManager (..),
15+ MyTaskManager,
2416
25−getInt :: IntAndString -> Int
26−getInt (IntAndStringCons int _) = int
17+ -- * Coffee
18+ DebitCard (..),
19+ Coffee (..),
20+ CoffeeExtra (..),
21+ HasPrice (..),
22+ chargeCoffee,
23+ PaymentMethod (..),
24+ Customer (..),
25+ payForCoffee,
26+ applyPayment,
27+ buyCoffee,
28+ saveTheDiabetic,
29+ calculateSugarDanger,
30+ )
31+where
2732
28−getString :: IntAndString -> String
29−getString (IntAndStringCons _ string) = string
33+import Data.Map (Map, empty, toList, insert, update, delete)
34+import Data.Monoid (Sum(..))
35+import qualified Data.Map
36+import Data.List (sortBy)
3037
31−twoAndHello :: IntAndString
32−twoAndHello = IntAndStringCons 2 "Hello"
38+-- _ _ _ __ __ _ _
39+-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
40+-- | | | / __| __| | |\/| |/ _ \| '_ \ / _ \| |/ _` / __|
41+-- | |___| \__ \ |_ | | | | (_) | | | | (_) | | (_| \__ \
42+-- |_____|_|___/\__| |_| |_|\___/|_| |_|\___/|_|\__,_|___/
3343
34−-- Implement a function which regroups a nested tuple as the types would suggest.
44+-- Write a datatype and a Monoid instance for it such that:
3545--
36−-- >>> regroup (8, ("Hello", True))
37−-- ("Hello", 8, True)
38−regroup :: (,) a ((,) b c) -> (,,) b a c
39−-- regroup :: (a, (b, c)) -> (b, a, c)
40−regroup (a, (b, c)) = (b, a, c)
41−
42−data StringList = Cons String StringList | Nil
43−data List a = ListCons a (List a) | Nil'
44−--data [] a = (:) a ([] a) | []
45−
46−oneTwoThree :: List Int
47−oneTwoThree = ListCons 1 (ListCons 2 (ListCons 3 Nil'))
48−-- oneTwoThree = (:) 1 ((:) 2 ((:) 3 []))
49−-- oneTwoThree = [1, 2, 3]
50−
51−helloWorldList :: StringList
52−helloWorldList = Cons "Hello" (Cons "World" Nil)
53−
54−-- data Maybe a = Just a | Nothing
55−
56−stringListHead :: StringList -> Maybe String
57−stringListHead x = case x of
58− Cons string string_list' -> Just string
59− Nil -> Nothing
60−-- _ _ _ _ __ __
61−-- | | (_)___| |_ ___| |_ _ _ / _|/ _|
62−-- | | | / __| __| / __| __| | | | |_| |_
63−-- | |___| \__ \ |_ \__ \ |_| |_| | _| _|
64−-- |_____|_|___/\__| |___/\__|\__,_|_| |_|
65−
66−-- Implement a function that returns the first element of a list, if there is one.
67−-- Hint: `Maybe a` is already defined as so:
46+-- (destructFirstMonoid . fold . fmap constructFirstMonoid) == safeHead
6847--
69−-- data Maybe a = Just a | Nothing
48+-- (constructFirstMonoid and destructFirstMonoid would wrap and
49+-- unwrap the `FirstMonoid`)
7050--
71−-- If the list has any elements return `Just` the first element, else return `Nothing`.
51+-- In other words, it needs to have a monoid instance such that `fold`ing
52+-- a list of `FirstMonoid`s should return the first element
7253--
73−-- >>> safeHead [1, 2, 3]
54+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) [1, 2, 3]
7455-- Just 1
7556--
76−-- >>> safeHead []
57+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) []
7758-- Nothing
78−safeHead :: [a] -> Maybe a
79−safeHead [] = Nothing
80−safeHead (x:_) = Just x
8159
82−-- Same as `safeHead`, but returns the last element.
83−--
84−-- >>> safeLast [1, 2, 3]
85−-- Just 3
86−--
87−-- >>> safeLast []
88−-- Nothing
89−safeLast :: [a] -> Maybe a
90−safeLast [] = Nothing
91−safeLast [x] = Just x
92−safeLast (_:xs) = safeLast xs
60+data FirstMonoid a = FM (Maybe a)
9361
94−-- Returns the same list without the last element.
95−--
96−-- >>> withoutLast [1, 2, 3, 4]
97−-- [1, 2, 3]
98−--
99−-- >>> withoutLast []
100−-- []
101−withoutLast :: [a] -> [a]
102−withoutLast [] = []
103−withoutLast [x] = []
104−withoutLast (x:xs) = x:(withoutLast xs)
105−
106−-- Returns the element at a given index if there is one.
107−-- Otherwise, return Nothing.
108−--
109−-- >>> indexed 2 [7, 6, 5, 4]
110−-- Just 5
111−--
112−-- >>> indexed 8 [6, 5, 4]
113−-- Nothing
114−indexed :: Natural -> [a] -> Maybe a
115−indexed 0 (x:_) = Just x
116−indexed number [] = Nothing
117−indexed number (_:xs) = indexed (number-1) xs
62+instance Semigroup (FirstMonoid a) where
63+ (FM Nothing) <> x = x
64+ x <> _ = x
11865
119−-- Is an infinite list, alternating the sign of every other element.
120−--
121−-- >>> alternating
122−-- [1, -2, 3, -4, 5, -6, ...
123−alternating :: [Integer]
124−alternating = cut rising
125− where
126− cut (x1:x2:xs) = x1:(-x2):cut xs
127− rising = 1 : map (+ 1) rising
128−-- ____ _ _
129−-- | __ )(_)_ __ __ _ _ __ _ _ | |_ _ __ ___ ___
130−-- | _ \| | '_ \ / _` | '__| | | | | __| '__/ _ \/ _ \
131−-- | |_) | | | | | (_| | | | |_| | | |_| | | __/ __/
132−-- |____/|_|_| |_|\__,_|_| \__, | \__|_| \___|\___|
133−-- |___/
134−
135−-- In this section you will implement what essentially is the Set from the
136−-- standard library. If you literally open the source code of the standard
137−-- library, it should look extremely similar to what you are doing here.
138−
139−-- Define a binary tree structure.
140−--
141−-- This is a wiki page, but you probably shouldn't open it:
142−-- https://en.wikipedia.org/wiki/Binary_tree
143−--
144−-- Hint: a tree is either:
145−-- 1. the end of the tree (an empty node with no elements)
146−-- (it should literally contain nothing)
147−-- 2. a node which contains an element and two branches (left and right).
148−-- (in this context a 'branch' and a 'tree' is the same thing)
149−--
150−-- In case you didn't get it, a tree should have two constructors.
151−data Tree a = Branch a (Tree a) (Tree a) | EmptyBranch
152− deriving (Show, Eq)
153−
154−instance Functor Tree where
155− fmap _ EmptyBranch = EmptyBranch
156− fmap f (Branch b leftb rightb) = Branch (f b) (fmap f leftb) (fmap f rightb)
157−
158−instance Arbitrary a => Arbitrary (Tree a) where
159− arbitrary = oneof [
160− pure EmptyBranch,
161− do
162− a <- arbitrary
163− lbr <- arbitrary
164− rbr <- arbitrary
165− return (Branch a lbr rbr)
166− ]
167−
168−
169−-- ^ Don't worry about this 'deriving' business. It is needed for tests
170−-- to compile. It will be explained later.
171−
172−-- This next function is contrived but we need this since you can define
173−-- constructors however you want.
174−-- If you have trouble with this one, don't hesitate to ask for help.
175−--
176−-- Constructs a tree from the given elements.
177−-- The first element is the root of the tree and the rest of the elements
178−-- are the alternating left and right children.
179−--
180−-- You are expected to partition pluck the first element from the list and
181−-- split the rest into two lists, which you recursively pass to the same
182−-- function to get the left and right branches of the tree.
183−--
184−-- >>> constructTree [1, 2, 3]
185−-- 1
186−-- / \
187−-- 2 3
188−--
189−-- >>> constructTree [1, 2, 3, 4, 5, 6]
190−-- 1
191−-- / \
192−-- 2 3
193−-- / \ /
194−-- 4 6 5
195−--
196−-- So every recursive step should look something like this:
197−-- [c, l, r, l, r, l, r, ...
198−-- c
199−-- / \
200−-- l r
201−-- / \ / \
202−-- l l r r
203−-- .............
204−constructTree :: [a] -> Tree a
205−constructTree [] = EmptyBranch
206−constructTree (x:xs) = Branch x (constructTree leftBranch) (constructTree rightBranch)
207− where
208− split (a:b:xs) = (a:aTail, b:bTail)
209− where
210− (aTail, bTail) = split xs
211− split [] = ([], [])
212− split [x] = ([x], [])
213− (leftBranch, rightBranch) = split xs
214−
215−-- Returns the leftmost element of the given tree.
216−--
217−-- For this tree the result should be 2:
218−-- 1
219−-- / \
220−-- 2 3
221−--
222−-- For this tree the result should be 4:
223−-- 1
224−-- / \
225−-- 2 3
226−-- / \ /
227−-- 4 6 5
228−leftmost :: Tree a -> Maybe a
229−leftmost EmptyBranch = Nothing
230−leftmost (Branch a EmptyBranch _) = Just a
231−leftmost (Branch _ br _) = leftmost br
232−
233−-- Returns the rightmost element of the given tree.
234−--
235−-- For this tree the result should be 3:
236−-- 1
237−-- / \
238−-- 2 3
239−--
240−-- For this tree the result should be 3:
241−-- 1
242−-- / \
243−-- 2 3
244−-- / \ /
245−-- 4 6 5
246−rightmost :: Tree a -> Maybe a
247−rightmost EmptyBranch = Nothing
248−rightmost (Branch a _ EmptyBranch) = Just a
249−rightmost (Branch _ _ br) = rightmost br
250−
251−-- Returns the sum of all elements in the tree
252−--
253−-- For this tree the result should be 6:
254−-- 1
255−-- / \
256−-- 2 3
257−--
258−-- For this tree the result should be 21:
259−-- 1
260−-- / \
261−-- 2 3
262−-- / \ /
263−-- 4 6 5
264−treeSum :: Tree Integer -> Integer
265−treeSum EmptyBranch = 0
266−treeSum (Branch a brl brr) = a + treeSum brl + treeSum brr
267−
268−
269−-- Returns the number of elements in the tree.
270−--
271−-- For this tree the result should be 3:
272−-- 1
273−-- / \
274−-- 2 3
275−--
276−-- For this tree the result should be 6:
277−-- 1
278−-- / \
279−-- 2 3
280−-- / \ /
281−-- 4 6 5
282−treeSize :: Tree a -> Integer
283−treeSize EmptyBranch = 0
284−treeSize (Branch _ brl brr) = 1 + treeSize brl + treeSize brr
285−
286−-- Insert the given integer into the tree, maintaining this property:
287−-- For every node in the tree all elements in the left subtree should be
288−-- smaller than the node element and all elements in the right subtree
289−-- should be greater or equal to the node element.
290−--
291−-- a forall e in b. e < a
292−-- / \
293−-- b c forall e in c. e > a
294−--
295−-- Assume that the input tree already satisfies the property.
66+
67+instance Monoid (FirstMonoid a) where
68+ mempty = FM Nothing
69+
70+-- Warps an `a` in a `FirstMonoid`.
71+constructFirstMonoid :: a -> FirstMonoid a
72+constructFirstMonoid = FM . Just
73+
74+-- Unwraps the `a` from a `FirstMonoid`, if there is one.
75+destructFirstMonoid :: FirstMonoid a -> Maybe a
76+destructFirstMonoid (FM x) = x
77+
78+-- Write a datatype and a Monoid instance for it such that:
29679--
297−-- If the elements is already in the tree, replace the old element with the
298−-- new element. Thus, this function should not produce duplicates in the tree.
80+-- (destructLastMonoid . fold . fmap constructLastMonoid) == safeLast
29981--
300−-- So, given the number 5 as input and this tree:
301−-- 2
302−-- / \
303−-- 1 3
304−-- the function should produce this tree:
305−-- 2
306−-- / \
307−-- 1 3
308−-- \
309−-- 5
82+-- (constructLastMonoid and destructLastMonoid would wrap and
83+-- unwrap the `LastMonoid`)
31084--
311−-- And given the number 2 as input and this tree:
312−-- 7
313−-- / \
314−-- 2 9
315−-- / \ /
316−-- 1 5 8
317−-- the function should produce this tree:
318−-- 7
319−-- / \
320−-- 2 9
321−-- / \ /
322−-- 1 5 8
85+-- In other words, it needs to have a monoid instance such that `fold`ing
86+-- a list of `LastMonoid`s should return the last element
32387--
324−-- And given the number 7 as input and this tree:
325−-- 6
326−-- / \
327−-- 2 9
328−-- / \ /
329−-- 1 5 8
330−-- the function should produce this tree:
331−-- 6
332−-- / \
333−-- 2 9
334−-- / \ /
335−-- 1 5 8
336−-- /
337−-- 7
88+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) [1, 2, 3]
89+-- Just 3
33890--
339−-- And given the number 3 as input and this tree:
340−-- 7
341−-- / \
342−-- 2 9
343−-- / \ /
344−-- 1 5 8
345−-- the function should produce this tree:
346−-- 7
347−-- / \
348−-- 2 9
349−-- / \ /
350−-- 1 5 8
351−-- /
352−-- 3
91+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) []
92+-- Nothing
93+data LastMonoid a = LM (Maybe a)
94+
95+instance Semigroup (LastMonoid a) where
96+ x <> (LM Nothing) = x
97+ _ <> x = x
98+
99+instance Monoid (LastMonoid a) where
100+ mempty = LM Nothing
101+
102+-- Warps an `a` in a `LastMonoid`.
103+constructLastMonoid :: a -> LastMonoid a
104+constructLastMonoid = LM . Just
105+
106+-- Unwraps the `a` from a `LastMonoid`, if there is one.
107+destructLastMonoid :: LastMonoid a -> Maybe a
108+destructLastMonoid (LM x) = x
109+
110+-- _____ _ _ _ _
111+-- |_ _|__ __| | ___ | | (_)___| |_
112+-- | |/ _ \ / _` |/ _ \ | | | / __| __|
113+-- | | (_) | (_| | (_) | | |___| \__ \ |_
114+-- |_|\___/ \__,_|\___/ |_____|_|___/\__|
115+
116+-- Your task is to create a todo list backend, which supports adding tasks,
117+-- changing the priority of tasks, completing tasks, renaming tasks, and
118+-- displaying tasks as a list in order of descending priority.
119+
120+-- | The priority of a task.
121+data Priority = Low | Medium | High
122+ deriving (Show, Eq, Ord)
123+
124+-- | The completion status of a task.
125+data Completion = Completed | NotCompleted
126+ deriving (Show, Eq, Ord)
127+
128+class TaskManager t where
129+ -- | Returns an empty task manager backend (it should have no tasks).
130+ emptyTaskManager :: t
131+
132+ -- | Gets the list of all tasks, sorted by priority in the order:
133+ -- High, Medium, Low
134+ --
135+ -- Ordering of tasks with the same priority is not defined
136+ -- (You can do whatever you want)
137+ getPriorityList :: t -> [(Completion, Priority, String)]
138+
139+ -- | Creates a new task with the given name and priority.
140+ -- Tasks are uniquely identified by their name.
141+ -- When a task is newly created its status should be 'NotCompleted'.
142+ --
143+ -- If there is already a task with the given name, then the
144+ -- behavior is undefined. (You can do whatever you want)
145+ createTask :: String -> Priority -> t -> t
146+
147+ -- | Toggles a task with the given name.
148+ -- If the task has the status 'Completed', then it would become 'NotCompleted'.
149+ -- If the task has the status 'NotCompleted', then it would become 'Completed'.
150+ --
151+ -- Needless to say, toggling the same task twice should be
152+ -- equivalent to not doing anything.
153+ --
154+ -- If there is no tasks with the given name, then it does nothing.
155+ toggleTaskCompletion :: String -> t -> t
156+
157+ -- | Removes the task with the given name.
158+ -- If there isn't a task with the given name, then it does nothing.
159+ removeTask :: String -> t -> t
160+
161+ -- | Sets the priority of the task with the given name.
162+ -- If there isn't a task with the given name, then it does nothing.
163+ modifyPriority :: String -> Priority -> t -> t
164+
165+ -- | Renames the task with the given name to have a new name.
166+ -- The first argument is the old name, the second argument is the new name.
167+ -- If there isn't a task with the given name, then it does nothing.
168+ -- If the new name clashes with an existing task, then the
169+ -- behavior is undefined. (You can do whatever you want)
170+ renameTask :: String -> String -> t -> t
171+
172+-- The task manager you are creating.
173+data MyTaskManager = MTM (Map String (Completion, Priority))
174+
175+-- TODO: You have to make your 'MyTaskManager' an instance of
176+-- the 'TaskManager' typeclass.
177+instance TaskManager MyTaskManager where
178+ emptyTaskManager = MTM empty
179+
180+ getPriorityList (MTM mp) = sortBy(\(_, lhs, _) (_, rhs, _) -> compare rhs lhs) $ (\(name, (comp, pri)) -> (comp, pri, name)) <$> toList mp
181+
182+ createTask :: String -> Priority -> MyTaskManager -> MyTaskManager
183+ createTask name pri (MTM mp) = MTM $ insert name (NotCompleted, pri) mp
184+
185+ toggleTaskCompletion name (MTM mp) = let
186+ toggleTask (Completed, pri) = (NotCompleted, pri)
187+ toggleTask (NotCompleted, pri) = (Completed, pri)
188+ in
189+ MTM $ update (Just . toggleTask) name mp
190+
191+ removeTask name (MTM mp) = MTM $ delete name mp
192+
193+ modifyPriority name newPri (MTM mp) = MTM $ update (\(comp, _) -> Just (comp, newPri)) name mp
194+
195+ renameTask oldName newName (MTM mp) = let
196+ mval = Data.Map.lookup oldName mp
197+ mp1 = delete oldName mp
198+ in
199+ case mval of
200+ Nothing -> MTM mp
201+ Just val -> MTM $ insert newName val mp1
202+-- ____ __ __
203+-- / ___|___ / _|/ _| ___ ___
204+-- | | / _ \| |_| |_ / _ \/ _ \
205+-- | |__| (_) | _| _| __/ __/
206+-- \____\___/|_| |_| \___|\___|
207+--
208+-- /~~~~~~~~~~~~~~~~~~~/|
209+-- / /######/ / |
210+-- / /______/ / |
211+-- ========================= /||
212+-- |_______________________|/ ||
213+-- | \****/ \__,,__/ ||
214+-- |===\**/ __,,__ ||
215+-- |______________\====/%____||
216+-- | ___ /~~~~\ % / |
217+-- _| |===|=== / \%_/ |
218+-- | | |###| |########| | /
219+-- |____\###/______\######/__|/
220+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
221+
222+-- | Just a typealias to make types more readable.
223+type RUBAmount = Integer
224+
225+-- | Represents a cup of coffee with extra ingredients added.
226+data Coffee
227+ = Coffee
228+ { -- | The price of the coffee itself
229+ -- (without the cost of the extra ingredients.)
230+ cost :: RUBAmount,
231+ -- | The extra ingredients added to the coffee.
232+ extras :: [CoffeeExtra]
233+ }
234+ deriving (Eq, Show)
235+
236+-- Extra ingredients added to the coffee.
237+data CoffeeExtra
238+ = Cream
239+ | AlmondMilk
240+ | SoyMilk
241+ | OatMilk
242+ | Cinnamon
243+ | WhiteSugar
244+ | BrownSugar
245+ deriving (Eq, Show)
246+
247+-- | A typeclass representing objects, for which the price can be calculated.
248+class HasPrice x where
249+ -- | Calculated the price of the item.
250+ price :: x -> RUBAmount
251+
252+-- I have already made a 'CoffeeExtra' an instance of 'HasPrice' for you.
253+-- You should use this in price calculations.
254+instance HasPrice CoffeeExtra where
255+ price Cream = 50
256+ price AlmondMilk = 70
257+ price SoyMilk = 80
258+ price OatMilk = 65
259+ price Cinnamon = 20
260+ price WhiteSugar = 15
261+ price BrownSugar = 35
262+
263+-- TODO: You want to make 'Coffee' an instance of 'HasPrice'.
264+instance HasPrice Coffee where
265+ price x = (cost x) + getSum (foldMap (Sum . price) (extras x))
266+
267+-- | A debit card.
268+-- Note: the balance can be negative.
269+data DebitCard
270+ = DebitCard
271+ { balance :: RUBAmount,
272+ cardId :: Int
273+ }
274+ deriving (Eq, Show)
275+
276+-- | Given a coffee and a debit card, deduce the total price of the coffee from
277+-- the debit card. Return the given debit card with the reduced balance.
353278--
354−-- Also, see comments for function insertAll for more examples of how this
355−-- function should behave.
356−insert :: Integer -> Tree Integer -> Tree Integer
357−insert a EmptyBranch = Branch a EmptyBranch EmptyBranch
358−insert a (Branch n brl brr) = if a < n then (Branch n (insert a brl) brr) else if a > n then (Branch n brl (insert a brr)) else Branch n brl brr
359−
360−-- Insert all integers from the list into the given tree using the insert
361−-- function defined above.
279+-- If the balance of the debit card after deducing the price of the coffee
280+-- would become negative, return 'Nothing' from the function.
281+chargeCoffee :: Coffee -> DebitCard -> Maybe DebitCard
282+chargeCoffee = error "TODO: chargeCoffee"
283+
284+-- | How was the coffee charged.
285+data PaymentMethod
286+ = -- | The coffee was charged using a debit card.
287+ Card
288+ { -- | The debit card with the balance deduced.
289+ chargedCard :: DebitCard
290+ }
291+ | -- | The coffee was charged with cash.
292+ Cash
293+ { -- | The leftover money from the payment.
294+ -- (We assume that the person pays with all of the cash he has.)
295+ change :: RUBAmount
296+ }
297+ deriving (Eq, Show)
298+
299+-- | Represents a coffee shop customer with all of the money he has on him.
300+data Customer
301+ = Customer
302+ { -- | All of the debit hards the person has on him.
303+ -- Sorted in order of descending preference.
304+ -- (He would prefer to use the first card in the list.)
305+ cards :: [DebitCard],
306+ -- | The amount of cash the customer has on him.
307+ cash :: RUBAmount
308+ }
309+ deriving (Eq, Show)
310+
311+-- You have some new privacy-invading piece of ... technology, which
312+-- automatically scans the customer, determines how he would prefer to pay and
313+-- charges him automatically.
314+
315+-- | This function determines how the given customer would prefer to pay for the
316+-- coffee he wants.
317+--
318+-- The customer would always prefer to pay with a debit card if it is possible.
319+-- The customer has a strict preference in the cards he carries with him:
320+-- he would always like to pay with the first card in his wallet (the list). If
321+-- the first card doesn't have enough money on it, then he would prefer to use
322+-- the second card, and so on.
323+--
324+-- If non of the cards have enough balance to cover the coffee, then the
325+-- customer will have to pay in cash.
326+--
327+-- NOTE: The customer can only buy a coffee with strictly one payment method.
328+-- (Only one card or cash)
329+payForCoffee :: Customer -> Coffee -> Maybe PaymentMethod
330+payForCoffee = error "TODO: payForCoffee"
331+
332+-- | This function should apply the chosen payment method to the customer.
333+-- In other words, it needs to apply the charge to the customer himself
334+-- (update the debit card or update the amount of cash he currently has)
362335--
363−-- >>> insertAll [1, 2, 3] <empty tree>
364−-- 1
365−-- \
366−-- 2
367−-- \
368−-- 3
336+-- If the specified card is not present in the 'Customer' structure, then
337+-- do nothing.
369338--
370−-- >>> insertAll [2, 3, 1] <empty tree>
371−-- 2
372−-- / \
373−-- 1 3
339+-- NOTE: You can not change the order of the cards.
340+applyPayment :: Customer -> PaymentMethod -> Customer
341+applyPayment = error "TODO: applyPayment"
342+
343+-- | Performs the full payment (as in 'payForCoffee') and
344+-- returns the modified customer (as in 'applyPayment').
345+buyCoffee :: Customer -> Coffee -> Maybe Customer
346+buyCoffee = error "TODO: buyCoffee"
347+
348+-- | You know that due to a medical condition the customer needs to watch his
349+-- sugar intake. The new privacy-invading piece of ... technology can now
350+-- automatically apply filters to coffee orders.
351+--
352+-- You have to make a filter, which removes any occurrences of sugar
353+-- (either WhiteSugar or BrownSugar) from the ordered cups of coffee and
354+-- return the filtered orders and the amount of money the customer saves by
355+-- being healthy (sugar costs money after all). So, you also have to count how
356+-- much the total sugar would have cost.
357+--
358+-- NOTE: You can not change the order of the coffee.
359+saveTheDiabetic :: [Coffee] -> (RUBAmount, [Coffee])
360+saveTheDiabetic = error "TODO: saveTheDiabetic"
361+
362+-- | And just to torment those who love sugar lets make a function which
363+-- calculates health hazard (sugar content) of the given orders.
374364--
375−-- >>> insertAll [3, 2, 1] <empty tree>
376−-- 3
377−-- /
378−-- 2
379−-- /
380−-- 1
365+-- The only ingredient that elevates the danger level is, of course, sugar:
381366--
382−-- >>> insertAll [8, 8, 10, 8] <empty tree>
383−-- 8
384−-- \
385−-- 10
386−insertAll :: [Integer] -> Tree Integer -> Tree Integer
387−insertAll (x:xs) tr = insertAll xs (insert x tr)
388−insertAll [] tr = tr
367+-- WhiteSugar: 2 extra danger points
368+-- BrownSugar: 1 extra danger point
369+calculateSugarDanger :: [Coffee] -> Int
370+calculateSugarDanger = error "TODO: calculateSugarDanger"
seminars/1/stack.yaml+2−2
@@ -1,7 +1,7 @@
1−resolver: nightly-2024-10-11
1+resolver: lts-22.6
22
33packages:
44- .
55
66ghc-options:
7− "$locals": -ddump-to-file -ddump-hi -fwarn-unused-binds -fwarn-unused-imports -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -Werror=missing-home-modules -Wmissing-home-modules -Widentities -Wredundant-constraints -Wmissing-export-lists
7+ "$locals": -ddump-to-file -ddump-hi -fwarn-unused-binds -fwarn-unused-imports -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror=missing-home-modules -Wmissing-home-modules -Widentities -Wredundant-constraints -Wmissing-export-lists
seminars/1/task.cabal+7−12
@@ -1,10 +1,10 @@
11cabal-version: 2.2
22
3−-- This file has been generated from package.yaml by hpack version 0.37.0.
3+-- This file has been generated from package.yaml by hpack version 0.36.0.
44--
55-- see: https://github.com/sol/hpack
66--
7−-- hash: 1b0c813b975b6ea7c4b067f19ac27bf2fff67bb285ba03838c6f210bd92d4acc
7+-- hash: 781190f5d43564d9d73aa8b8a85a99c3d859a931a6ca644dadf871a105221b10
88
99name: task
1010version: 0.1.0.0
@@ -20,11 +20,9 @@ library
2020 Paths_task
2121 hs-source-dirs:
2222 src
23− default-extensions:
24− EmptyDataDeriving
2523 build-depends:
26− QuickCheck
27− , base >=4.7 && <5
24+ base >=4.7 && <5
25+ , containers
2826 default-language: Haskell2010
2927
3028test-suite task-tests
@@ -37,13 +35,10 @@ test-suite task-tests
3735 Paths_task
3836 hs-source-dirs:
3937 test
40− default-extensions:
41− EmptyDataDeriving
4238 build-depends:
43− QuickCheck
44− , base >=4.7 && <5
45− , hspec
39+ base >=4.7 && <5
40+ , containers
4641 , task
4742 , tasty
48− , tasty-hspec
43+ , tasty-hunit
4944 default-language: Haskell2010
seminars/1/test/Main.hs+1−6
@@ -4,12 +4,7 @@ module Main
44where
55
66import Test.Tasty
7−import Test.Tasty.Hspec
87import Tests
98
109main :: IO ()
11−main = do
12− tests' <- testSpecs tests
13− defaultMain
14− ( testGroup "tests" tests'
15− )
10+main = defaultMain tests
seminars/1/test/Tests.hs+432−85
@@ -3,90 +3,437 @@ module Tests
33 )
44where
55
6+import Data.Foldable
7+import Data.Function
8+import Data.List
69import Task
7−import Test.Hspec
10+import Test.Tasty
11+import Test.Tasty.HUnit
812
9−tests :: Spec
10−tests = do
11− it "regroup" $ do
12− regroup (1 :: Int, (2 :: Int, 3 :: Int)) `shouldBe` (2, 1, 3)
13− regroup ("1", ("2", "3")) `shouldBe` ("2", "1", "3")
14− regroup (True, (False, True)) `shouldBe` (False, True, True)
15− it "safeHead" $ do
16− safeHead [1 :: Int, 2, 3] `shouldBe` Just 1
17− safeHead [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 1294
18− safeHead [] `shouldBe` (Nothing :: Maybe ())
19− it "safeLast" $ do
20− safeLast [1 :: Int, 2, 3] `shouldBe` Just 3
21− safeLast [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 9
22− safeLast [] `shouldBe` (Nothing :: Maybe ())
23− it "withoutLast" $ do
24− withoutLast [1 :: Int, 2, 3] `shouldBe` [1, 2]
25− withoutLast [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` [1294, 2, 3, 4, 5, 6, 7, 7]
26− withoutLast [] `shouldBe` ([] :: [()])
27− it "indexed" $ do
28− indexed 2 [1 :: Int, 2, 3] `shouldBe` Just 3
29− indexed 0 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 1294
30− indexed 1080 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Nothing
31− indexed 4 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 5
32− indexed 0 [] `shouldBe` (Nothing :: Maybe ())
33− indexed 297 [] `shouldBe` (Nothing :: Maybe ())
34− it "alternating" $ do
35− take 10 alternating `shouldBe` [1, -2, 3, -4, 5, -6, 7, -8, 9, -10]
36− alternating !! 42 `shouldBe` 43
37− alternating !! 69 `shouldBe` -70
38− alternating !! 420 `shouldBe` 421
39− it "leftmost" $ do
40− (leftmost . constructTree) [1 :: Int, 2, 3, 4, 5] `shouldBe` Just 4
41− (leftmost . constructTree) [1 :: Int, 2, 3, 4] `shouldBe` Just 4
42− (leftmost . constructTree) [1 :: Int, 2, 3, 99, 5] `shouldBe` Just 99
43− (leftmost . constructTree) [8 :: Int, 7, 6, 5, 4, 1, 2, 3, 4, 5] `shouldBe` Just 3
44− it "rightmost" $ do
45− (rightmost . constructTree) [1 :: Int, 2, 3, 4, 5] `shouldBe` Just 3
46− (rightmost . constructTree) [1 :: Int, 2, 3, 4] `shouldBe` Just 3
47− (rightmost . constructTree) [1 :: Int, 2, 99, 5, 5] `shouldBe` Just 99
48− (rightmost . constructTree) [8 :: Int, 7, 6, 5, 4, 1, 2, 3, 4, 5] `shouldBe` Just 2
49− it "treeSum" $ do
50− (treeSum . constructTree) [1, 2, 3, 4, 5] `shouldBe` sum [1, 2, 3, 4, 5]
51− (treeSum . constructTree) [1, 2, 3, 4] `shouldBe` sum [1, 2, 3, 4]
52− (treeSum . constructTree) [1, 2, 3, 5, 99] `shouldBe` sum [1, 2, 3, 5, 99]
53− (treeSum . constructTree) [8, 7, 6, 5, 4, 1, 2, 3, 4, 5] `shouldBe` sum [8, 7, 6, 5, 4, 1, 2, 3, 4, 5]
54− (treeSum . constructTree . take 100) [5 ..] `shouldBe` (sum . take 100) [5 ..]
55− (treeSum . constructTree . take 100) [2 ..] `shouldBe` (sum . take 100) [2 ..]
56− it "treeSize" $ do
57− let test list = treeSize (constructTree list) `shouldBe` fromIntegral (length list)
58− test $ replicate 11 ()
59− test $ replicate 16 (8 :: Int)
60− test [5, 2, 5, 7, 7, 3, 2, 7, 7 :: Int]
61− it "insert" $ do
62− constructTree [1 :: Int] `shouldNotBe` constructTree [1, 2]
63− constructTree [1 :: Int] `shouldNotBe` constructTree []
64− (insert 3 . insert 1 . insert 2 . constructTree) [] `shouldBe` constructTree [2, 1, 3]
65− (insert 71 . insert 65 . insert 56 . insert 54 . insert 45 . insert 35 . insert 15 . insert 5 . constructTree) [50, 30, 60, 10, 55, 40, 70]
66− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
67− (insert 71 . insert 54 . insert 45 . insert 35 . insert 15 . insert 65 . insert 56 . insert 5 . constructTree) [50, 30, 60, 10, 55, 40, 70]
68− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
69− (insert 35 . insert 15 . insert 65 . insert 71 . insert 54 . insert 45 . insert 56 . insert 5 . constructTree) [50, 30, 60, 10, 55, 40, 70]
70− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
71− (insert 35 . insert 54 . insert 45 . insert 56 . insert 5 . insert 15 . insert 65 . insert 71 . constructTree) [50, 30, 60, 10, 55, 40, 70]
72− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
73− (insert 56 . insert 5 . insert 15 . insert 65 . insert 35 . insert 54 . insert 45 . insert 71 . constructTree) [50, 30, 60, 10, 55, 40, 70]
74− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
75− (insert 56 . insert 56 . insert 5 . insert 5 . insert 15 . insert 65 . insert 35 . insert 54 . insert 45 . insert 71 . constructTree) [50, 30, 60, 10, 55, 40, 70]
76− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
77− it "insertAll" $ do
78− constructTree [1 :: Int] `shouldNotBe` constructTree [1, 2]
79− constructTree [1 :: Int] `shouldNotBe` constructTree []
80− (insertAll [2, 3, 1] . constructTree) [] `shouldBe` constructTree [2, 1, 3]
81− (insertAll [71, 65, 56, 54, 45, 35, 15, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
82− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
83− (insertAll [71, 54, 45, 35, 15, 65, 56, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
84− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
85− (insertAll [35, 15, 65, 71, 54, 45, 56, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
86− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
87− (insertAll [35, 54, 45, 56, 5, 15, 65, 71] . constructTree) [50, 30, 60, 10, 55, 40, 70]
88− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
89− (insertAll [56, 5, 15, 65, 35, 54, 45, 71] . constructTree) [50, 30, 60, 10, 55, 40, 70]
90− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
91− (insertAll [56, 5, 15, 65, 35, 54, 45, 71, 5, 56, 35] . constructTree) [50, 30, 60, 10, 55, 40, 70]
92− `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
13+tests :: TestTree
14+tests = testGroup "Tests"
15+ [ testGroup "List Monoids"
16+ [ testCase "FirstMonoid" $ do
17+ let getFirst = destructFirstMonoid . fold . fmap constructFirstMonoid
18+ getFirst [1 :: Int, 2, 3] @=? Just 1
19+ getFirst [] @=? (Nothing :: Maybe ())
20+ getFirst [True, False] @=? Just True
21+ getFirst [True, True, False] @=? Just True
22+ getFirst [1 .. 1000] @=? Just (1 :: Int)
23+ getFirst [100 .. 1000] @=? Just (100 :: Int)
24+ getFirst [6, 2, 7, 398, 1984, 383, -1020] @=? Just (6 :: Int)
25+ , testCase "LastMonoid" $ do
26+ let getLast = destructLastMonoid . fold . fmap constructLastMonoid
27+ getLast [1 :: Int, 2, 3] @=? Just 3
28+ getLast [] @=? (Nothing :: Maybe ())
29+ getLast [1 .. 1000] @=? Just (1000 :: Int)
30+ getLast [100 .. 10000] @=? Just (10000 :: Int)
31+ getLast [6, 2, 7, 398, 1984, 383, -1020, 498] @=? Just (498 :: Int)
32+ getLast [True, False] @=? Just False
33+ getLast [True, True, False] @=? Just False
34+ getLast [True, True, False, True] @=? Just True
35+ ]
36+ , testGroup "Todo List" $
37+ let createTasks :: [(String, Priority)] -> MyTaskManager
38+ createTasks = foldl (\t (a, b) -> createTask a b t) emptyTaskManager
39+ getPrioritySets :: MyTaskManager -> [[(Completion, String)]]
40+ getPrioritySets =
41+ fmap (sort . fmap (\(a, _, b) -> (a, b)))
42+ . groupBy ((==) `on` (\(_, p, _) -> p))
43+ . getPriorityList
44+ in
45+ [ testCase "emptyTaskManager" $
46+ getPriorityList (emptyTaskManager :: MyTaskManager) @=? []
47+ , testCase "createTask" $ do
48+ getPrioritySets
49+ ( createTasks
50+ [ ("a", Low),
51+ ("aaa", Medium),
52+ ("AAAAAAAAAA", High)
53+ ]
54+ )
55+ @=? [ [(NotCompleted, "AAAAAAAAAA")],
56+ [(NotCompleted, "aaa")],
57+ [(NotCompleted, "a")]
58+ ]
59+ getPrioritySets
60+ ( createTasks
61+ [ ("a", Low),
62+ ("AAAAAAAAAA", High)
63+ ]
64+ )
65+ @=? [ [(NotCompleted, "AAAAAAAAAA")],
66+ [(NotCompleted, "a")]
67+ ]
68+ getPrioritySets
69+ ( createTasks
70+ [ ("a", Low),
71+ ("AAAAAAAAAA", High),
72+ ("aaa", Medium),
73+ ("oh HaiMark", Medium)
74+ ]
75+ )
76+ @=? [ [(NotCompleted, "AAAAAAAAAA")],
77+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
78+ [(NotCompleted, "a")]
79+ ]
80+ getPrioritySets
81+ ( createTasks
82+ [ ("a", Low),
83+ ("AAAAAAAAAA", High),
84+ ("aaa", Medium),
85+ ("oh HaiMark", Medium),
86+ ("OH NO", High)
87+ ]
88+ )
89+ @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
90+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
91+ [(NotCompleted, "a")]
92+ ]
93+ , testCase "toggleTaskCompletion" $ do
94+ getPrioritySets
95+ ( toggleTaskCompletion "AAAAAAAAAA" . createTasks $
96+ [ ("a", Low),
97+ ("AAAAAAAAAA", High),
98+ ("aaa", Medium),
99+ ("oh HaiMark", Medium),
100+ ("OH NO", High)
101+ ]
102+ )
103+ @=? [ [(Completed, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
104+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
105+ [(NotCompleted, "a")]
106+ ]
107+ getPrioritySets
108+ ( toggleTaskCompletion "AAAAAAAAAA" . toggleTaskCompletion "AAAAAAAAAA" . createTasks $
109+ [ ("a", Low),
110+ ("AAAAAAAAAA", High),
111+ ("aaa", Medium),
112+ ("oh HaiMark", Medium),
113+ ("OH NO", High)
114+ ]
115+ )
116+ @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
117+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
118+ [(NotCompleted, "a")]
119+ ]
120+ getPrioritySets
121+ ( toggleTaskCompletion "a"
122+ . toggleTaskCompletion "not here"
123+ . toggleTaskCompletion "AAAAAAAAAA"
124+ . createTasks
125+ $ [ ("a", Low),
126+ ("AAAAAAAAAA", High),
127+ ("aaa", Medium),
128+ ("oh HaiMark", Medium),
129+ ("OH NO", High)
130+ ]
131+ )
132+ @=? [ [(Completed, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
133+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
134+ [(Completed, "a")]
135+ ]
136+ , testCase "removeTask" $ do
137+ getPrioritySets
138+ ( removeTask "AAAAAAAAAA"
139+ . createTasks
140+ $ [ ("a", Low),
141+ ("AAAAAAAAAA", High),
142+ ("aaa", Medium),
143+ ("oh HaiMark", Medium),
144+ ("OH NO", High)
145+ ]
146+ )
147+ @=? [ [(NotCompleted, "OH NO")],
148+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
149+ [(NotCompleted, "a")]
150+ ]
151+ getPrioritySets
152+ ( removeTask "AAAAAAAAAA" . removeTask "AAAAAAAAAA"
153+ . createTasks
154+ $ [ ("a", Low),
155+ ("AAAAAAAAAA", High),
156+ ("aaa", Medium),
157+ ("oh HaiMark", Medium),
158+ ("OH NO", High)
159+ ]
160+ )
161+ @=? [ [(NotCompleted, "OH NO")],
162+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
163+ [(NotCompleted, "a")]
164+ ]
165+ getPrioritySets
166+ ( removeTask "aaa" . removeTask "oh HaiMark"
167+ . removeTask "AAAAAAAAAA"
168+ . removeTask "AAAAAAAAAA"
169+ . createTasks
170+ $ [ ("a", Low),
171+ ("AAAAAAAAAA", High),
172+ ("aaa", Medium),
173+ ("oh HaiMark", Medium),
174+ ("OH NO", High)
175+ ]
176+ )
177+ @=? [ [(NotCompleted, "OH NO")],
178+ [(NotCompleted, "a")]
179+ ]
180+ , testCase "modifyPriority" $ do
181+ getPrioritySets
182+ ( modifyPriority "aaa" High . createTasks $
183+ [ ("a", Low),
184+ ("AAAAAAAAAA", High),
185+ ("aaa", Medium),
186+ ("oh HaiMark", Medium),
187+ ("OH NO", High)
188+ ]
189+ )
190+ @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO"), (NotCompleted, "aaa")],
191+ [(NotCompleted, "oh HaiMark")],
192+ [(NotCompleted, "a")]
193+ ]
194+ getPrioritySets
195+ ( modifyPriority "aaa" High
196+ . toggleTaskCompletion "a"
197+ . modifyPriority "a" High
198+ . createTasks
199+ $ [ ("a", Low),
200+ ("AAAAAAAAAA", High),
201+ ("aaa", Medium),
202+ ("oh HaiMark", Medium),
203+ ("OH NO", High)
204+ ]
205+ )
206+ @=? [ [ (Completed, "a"),
207+ (NotCompleted, "AAAAAAAAAA"),
208+ (NotCompleted, "OH NO"),
209+ (NotCompleted, "aaa")
210+ ],
211+ [(NotCompleted, "oh HaiMark")]
212+ ]
213+ getPrioritySets
214+ ( modifyPriority "aaa" High
215+ . modifyPriority "a" High
216+ . modifyPriority "a" High
217+ . modifyPriority "oh HaiMark" High
218+ . createTasks
219+ $ [ ("a", Low),
220+ ("AAAAAAAAAA", High),
221+ ("aaa", Medium),
222+ ("oh HaiMark", Medium),
223+ ("OH NO", High)
224+ ]
225+ )
226+ @=? [ [ (NotCompleted, "AAAAAAAAAA"),
227+ (NotCompleted, "OH NO"),
228+ (NotCompleted, "a"),
229+ (NotCompleted, "aaa"),
230+ (NotCompleted, "oh HaiMark")
231+ ]
232+ ]
233+ getPrioritySets
234+ ( modifyPriority "aaa" High
235+ . modifyPriority "a" High
236+ . modifyPriority "ntestCase here sihji" High
237+ . modifyPriority "oh HaiMark" Low
238+ . modifyPriority "a" High
239+ . modifyPriority "oh HaiMark" High
240+ . createTasks
241+ $ [ ("a", Low),
242+ ("AAAAAAAAAA", High),
243+ ("aaa", Medium),
244+ ("oh HaiMark", Medium),
245+ ("OH NO", High)
246+ ]
247+ )
248+ @=? [ [ (NotCompleted, "AAAAAAAAAA"),
249+ (NotCompleted, "OH NO"),
250+ (NotCompleted, "a"),
251+ (NotCompleted, "aaa")
252+ ],
253+ [(NotCompleted, "oh HaiMark")]
254+ ]
255+ , testCase "renameTask" $ do
256+ getPrioritySets
257+ ( renameTask "AAAAAAAAAA" "henlo"
258+ . createTasks
259+ $ [ ("a", Low),
260+ ("AAAAAAAAAA", High),
261+ ("aaa", Medium),
262+ ("oh HaiMark", Medium),
263+ ("OH NO", High)
264+ ]
265+ )
266+ @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
267+ [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
268+ [(NotCompleted, "a")]
269+ ]
270+ getPrioritySets
271+ ( renameTask "AAAAAAAAAA" "henlo"
272+ . toggleTaskCompletion "a"
273+ . renameTask "oh HaiMark" "iz task"
274+ . createTasks
275+ $ [ ("a", Low),
276+ ("AAAAAAAAAA", High),
277+ ("aaa", Medium),
278+ ("oh HaiMark", Medium),
279+ ("OH NO", High)
280+ ]
281+ )
282+ @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
283+ [(NotCompleted, "aaa"), (NotCompleted, "iz task")],
284+ [(Completed, "a")]
285+ ]
286+ getPrioritySets
287+ ( renameTask "AAAAAAAAAA" "henlo"
288+ . toggleTaskCompletion "iz task"
289+ . renameTask "oh HaiMark" "iz task"
290+ . renameTask "iz not here" "ajajaj"
291+ . createTasks
292+ $ [ ("a", Low),
293+ ("AAAAAAAAAA", High),
294+ ("aaa", Medium),
295+ ("oh HaiMark", Medium),
296+ ("OH NO", High)
297+ ]
298+ )
299+ @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
300+ [(Completed, "iz task"), (NotCompleted, "aaa")],
301+ [(NotCompleted, "a")]
302+ ]
303+ ]
304+ , testGroup "Coffee"
305+ [ testCase "HasPrice Coffee" $ do
306+ price (Coffee 2 [OatMilk, Cinnamon]) @=? 2 + price OatMilk + price Cinnamon
307+ price (Coffee 2 [Cinnamon, Cinnamon]) @=? 2 + price Cinnamon + price Cinnamon
308+ price (Coffee 2 []) @=? 2
309+ price (Coffee 2 [Cinnamon, Cream, Cinnamon])
310+ @=? 2
311+ + price Cinnamon
312+ + price Cinnamon
313+ + price Cream
314+ , testCase "chargeCoffee" $ do
315+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 199 69)
316+ @=? Just (DebitCard 112 69)
317+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 87 69)
318+ @=? Just (DebitCard 0 69)
319+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 86 69)
320+ @=? Nothing
321+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 0 69)
322+ @=? Nothing
323+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard (-2189) 69)
324+ @=? Nothing
325+ chargeCoffee (Coffee 2 [OatMilk, Cinnamon, WhiteSugar]) (DebitCard 199 69)
326+ @=? Just (DebitCard 97 69)
327+ chargeCoffee (Coffee 2 [WhiteSugar, OatMilk, Cinnamon, WhiteSugar]) (DebitCard 199 69)
328+ @=? Just (DebitCard 82 69)
329+ , let coffee = Coffee 2 [OatMilk, Cinnamon]
330+ in testCase "payForCoffee" $ do
331+ payForCoffee (Customer [DebitCard 199 69] 0) coffee
332+ @=? Just (Card (DebitCard 112 69))
333+ payForCoffee (Customer [DebitCard 86 12, DebitCard 199 69] 2) coffee
334+ @=? Just (Card (DebitCard 112 69))
335+ payForCoffee (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
336+ @=? Just (Card (DebitCard 112 69))
337+ payForCoffee (Customer [DebitCard 87 8, DebitCard 111 12, DebitCard 199 69] 0) coffee
338+ @=? Just (Card (DebitCard 0 8))
339+ payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 0) coffee
340+ @=? Nothing
341+ payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 87) coffee
342+ @=? Just (Cash 0)
343+ payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 81 69] 86) coffee
344+ @=? Nothing
345+ , testCase "applyPayment" $ do
346+ applyPayment (Customer [DebitCard 199 69] 0) (Card (DebitCard 112 69))
347+ @=? Customer [DebitCard 112 69] 0
348+ applyPayment (Customer [DebitCard 111 12, DebitCard 199 69] 2) (Card (DebitCard 112 69))
349+ @=? Customer [DebitCard 111 12, DebitCard 112 69] 2
350+ applyPayment (Customer [DebitCard (-12) 8, DebitCard 111 12, DebitCard 199 69] 0) (Card (DebitCard 112 69))
351+ @=? Customer [DebitCard (-12) 8, DebitCard 111 12, DebitCard 112 69] 0
352+ applyPayment (Customer [DebitCard 112 8, DebitCard 111 12, DebitCard 199 69] 0) (Card (DebitCard 0 8))
353+ @=? Customer [DebitCard 0 8, DebitCard 111 12, DebitCard 199 69] 0
354+ applyPayment (Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112) (Cash 0)
355+ @=? Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 0
356+ applyPayment (Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112) (Card (DebitCard 0 13))
357+ @=? Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112
358+ , let coffee = Coffee 2 [OatMilk, Cinnamon]
359+ in testCase "buyCoffee" $ do
360+ buyCoffee (Customer [DebitCard 199 69] 0) coffee
361+ @=? Just (Customer [DebitCard 112 69] 0)
362+ buyCoffee (Customer [DebitCard 86 12, DebitCard 199 69] 2) coffee
363+ @=? Just (Customer [DebitCard 86 12, DebitCard 112 69] 2)
364+ buyCoffee (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
365+ @=? Just (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 112 69] 0)
366+ buyCoffee (Customer [DebitCard 87 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
367+ @=? Just (Customer [DebitCard 0 8, DebitCard 86 12, DebitCard 199 69] 0)
368+ buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 84 69] 0) coffee
369+ @=? Nothing
370+ buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 87) coffee
371+ @=? Just (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 0)
372+ buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 81 69] 86) coffee
373+ @=? Nothing
374+ , testCase "saveTheDiabetic" $ do
375+ saveTheDiabetic
376+ [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
377+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
378+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
379+ ]
380+ @=? ( 150,
381+ [ Coffee 0 [Cinnamon],
382+ Coffee 0 [Cinnamon],
383+ Coffee 0 [Cinnamon]
384+ ]
385+ )
386+ saveTheDiabetic
387+ [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon, BrownSugar, SoyMilk],
388+ Coffee 0 [WhiteSugar, BrownSugar, WhiteSugar, WhiteSugar, Cinnamon],
389+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
390+ ]
391+ @=? ( 215,
392+ [ Coffee 0 [Cinnamon, SoyMilk],
393+ Coffee 0 [Cinnamon],
394+ Coffee 0 [Cinnamon]
395+ ]
396+ )
397+ saveTheDiabetic
398+ [ Coffee 0 [Cinnamon, SoyMilk],
399+ Coffee 0 [Cinnamon],
400+ Coffee 0 [Cinnamon],
401+ Coffee 69 []
402+ ]
403+ @=? ( 0,
404+ [ Coffee 0 [Cinnamon, SoyMilk],
405+ Coffee 0 [Cinnamon],
406+ Coffee 0 [Cinnamon],
407+ Coffee 69 []
408+ ]
409+ )
410+ saveTheDiabetic
411+ []
412+ @=? ( 0,
413+ []
414+ )
415+ , testCase "calculateSugarDanger" $ do
416+ calculateSugarDanger
417+ [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
418+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
419+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
420+ ]
421+ @=? 9
422+ calculateSugarDanger
423+ [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon, BrownSugar, SoyMilk],
424+ Coffee 0 [WhiteSugar, BrownSugar, WhiteSugar, WhiteSugar, Cinnamon],
425+ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
426+ Coffee 0 []
427+ ]
428+ @=? 14
429+ calculateSugarDanger
430+ [ Coffee 0 [Cinnamon, SoyMilk],
431+ Coffee 0 [Cinnamon],
432+ Coffee 0 [Cinnamon]
433+ ]
434+ @=? 0
435+ calculateSugarDanger
436+ []
437+ @=? 0
438+ ]
439+ ]
seminars/2/package.yamldeleted−19
@@ -1,19 +0,0 @@
1−name: task
2−version: 0.1.0.0
3−license: Unlicense
4−
5−dependencies:
6− - base >= 4.7 && < 5
7− - random
8−
9−library:
10− source-dirs: src
11−
12−tests:
13− task-tests:
14− source-dirs: test
15− main: Main.hs
16− dependencies:
17− - tasty
18− - tasty-hunit
19− - task
seminars/2/src/Task.hsdeleted−398
@@ -1,398 +0,0 @@
1−module Task
2− ( -- * List Monoids
3− constructFirstMonoid,
4− destructFirstMonoid,
5− FirstMonoid,
6− constructLastMonoid,
7− destructLastMonoid,
8− LastMonoid,
9−
10− -- * Todo List
11− Priority (..),
12− Completion (..),
13− TaskManager (..),
14− MyTaskManager,
15−
16− -- * Coffee
17− DebitCard (..),
18− Coffee (..),
19− CoffeeExtra (..),
20− HasPrice (..),
21− chargeCoffee,
22− PaymentMethod (..),
23− Customer (..),
24− payForCoffee,
25− applyPayment,
26− buyCoffee,
27− saveTheDiabetic,
28− calculateSugarDanger,
29− runStRandom, genStIntDouble
30− , foo
31− )
32−where
33−
34−import System.Random
35−import Control.Monad
36−
37−newtype State m s a = State { runState :: s -> (s, m a) }
38−newtype Reader m s a = Reader { runReader :: s -> m a }
39−type Foo s s' a = State (Reader Identity s') s a
40−
41−instance Functor (State s) where
42− -- fmap :: (a -> b) -> functor a -> functor b
43− fmap f (State g) = State (\s -> let (s', a) = g s in (s', f a))
44− -- fmap f (State g) = State (fmap (fmap f) g)
45−
46−instance Applicative (State s) where
47− pure a = State (\s -> (s, a))
48− (<*>) = ap
49−
50−instance Monad (State s) where
51− -- (>>=) :: State s a -> (a -> State s b) -> State s b
52− State g >>= f = State $ \s -> let (s', a) = g s in
53− let State h = f a in
54− h s'
55−
56−get :: State s s
57−get = State (\s -> (s, s))
58−
59−put :: s -> State s ()
60−put s = State (\_ -> (s, ()))
61−
62−stRandom :: Random a => State StdGen a
63−stRandom = do
64− s <- get
65− let (r, s') = random s
66− put s'
67− return r
68−
69−runStRandom :: State StdGen a -> a
70−runStRandom (State g) = snd (g (mkStdGen 8))
71−
72−genStIntDouble :: State StdGen (Int, Double)
73−genStIntDouble = do
74− int <- stRandom
75− double <- stRandom
76− return (int, double)
77−
78−foo :: State StdGen [(Int, Double)]
79−foo = sequenceA [genStIntDouble, genStIntDouble]
80−
81−-- fold [] = mempty
82−-- fold (x: xs) = x <> fold xs
83−
84−-- _ _ _ __ __ _ _
85−-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
86−-- | | | / __| __| | |\/| |/ _ \| '_ \ / _ \| |/ _` / __|
87−-- | |___| \__ \ |_ | | | | (_) | | | | (_) | | (_| \__ \
88−-- |_____|_|___/\__| |_| |_|\___/|_| |_|\___/|_|\__,_|___/
89−
90−-- Write a datatype and a Monoid instance for it such that:
91−--
92−-- (destructFirstMonoid . fold . fmap constructFirstMonoid) == safeHead
93−--
94−-- (constructFirstMonoid and destructFirstMonoid would wrap and
95−-- unwrap the `FirstMonoid`)
96−--
97−-- In other words, it needs to have a monoid instance such that `fold`ing
98−-- a list of `FirstMonoid`s should return the first element
99−--
100−-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) [1, 2, 3]
101−-- Just 1
102−--
103−-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) []
104−-- Nothing
105−data FirstMonoid a = FirstMonoid (Maybe a)
106−
107−-- class Semigroup a where
108−-- (<>) :: a -> a -> a
109−
110−-- instance Semigroup [a] where
111−-- [] <> xs = xs
112−-- (x : xs) <> ys = x (xs <> ys)
113−
114−instance Semigroup (FirstMonoid a) where
115− FirstMonoid Nothing <> a = a
116− FirstMonoid (Just a) <> _ = FirstMonoid (Just a)
117−
118−instance Monoid (FirstMonoid a) where
119− mempty = FirstMonoid Nothing
120−
121−-- Warps an `a` in a `FirstMonoid`.
122−constructFirstMonoid :: a -> FirstMonoid a
123−constructFirstMonoid a = FirstMonoid (Just a)
124−
125−-- Unwraps the `a` from a `FirstMonoid`, if there is one.
126−destructFirstMonoid :: FirstMonoid a -> Maybe a
127−destructFirstMonoid (FirstMonoid a) = a
128−
129−-- Write a datatype and a Monoid instance for it such that:
130−--
131−-- (destructLastMonoid . fold . fmap constructLastMonoid) == safeLast
132−--
133−-- (constructLastMonoid and destructLastMonoid would wrap and
134−-- unwrap the `LastMonoid`)
135−--
136−-- In other words, it needs to have a monoid instance such that `fold`ing
137−-- a list of `LastMonoid`s should return the last element
138−--
139−-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) [1, 2, 3]
140−-- Just 3
141−--
142−-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) []
143−-- Nothing
144−data LastMonoid a = LastMonoid (Maybe a)
145−
146−instance Semigroup (LastMonoid a) where
147− a <> LastMonoid Nothing = a
148− _ <> LastMonoid (Just a) = LastMonoid (Just a)
149−
150−
151−instance Monoid (LastMonoid a) where
152− mempty = LastMonoid Nothing
153−
154−-- Warps an `a` in a `LastMonoid`.
155−constructLastMonoid :: a -> LastMonoid a
156−constructLastMonoid a = LastMonoid (Just a)
157−
158−-- Unwraps the `a` from a `LastMonoid`, if there is one.
159−destructLastMonoid :: LastMonoid a -> Maybe a
160−destructLastMonoid (LastMonoid a) = a
161−
162−-- _____ _ _ _ _
163−-- |_ _|__ __| | ___ | | (_)___| |_
164−-- | |/ _ \ / _` |/ _ \ | | | / __| __|
165−-- | | (_) | (_| | (_) | | |___| \__ \ |_
166−-- |_|\___/ \__,_|\___/ |_____|_|___/\__|
167−
168−-- Your task is to create a todo list backend, which supports adding tasks,
169−-- changing the priority of tasks, completing tasks, renaming tasks, and
170−-- displaying tasks as a list in order of descending priority.
171−
172−-- | The priority of a task.
173−data Priority = Low | Medium | High
174− deriving (Show, Eq)
175−
176−-- | The completion status of a task.
177−data Completion = Completed | NotCompleted
178− deriving (Show, Eq, Ord)
179−
180−class TaskManager t where
181− -- | Returns an empty task manager backend (it should have no tasks).
182− emptyTaskManager :: t
183−
184− -- | Gets the list of all tasks, sorted by priority in the order:
185− -- High, Medium, Low
186− --
187− -- Ordering of tasks with the same priority is not defined
188− -- (You can do whatever you want)
189− getPriorityList :: t -> [(Completion, Priority, String)]
190−
191− -- | Creates a new task with the given name and priority.
192− -- Tasks are uniquely identified by their name.
193− -- When a task is newly created its status should be 'NotCompleted'.
194− --
195− -- If there is already a task with the given name, then the
196− -- behavior is undefined. (You can do whatever you want)
197− createTask :: String -> Priority -> t -> t
198−
199− -- | Toggles a task with the given name.
200− -- If the task has the status 'Completed', then it would become 'NotCompleted'.
201− -- If the task has the status 'NotCompleted', then it would become 'Completed'.
202− --
203− -- Needless to say, toggling the same task twice should be
204− -- equivalent to not doing anything.
205− --
206− -- If there is no tasks with the given name, then it does nothing.
207− toggleTaskCompletion :: String -> t -> t
208−
209− -- | Removes the task with the given name.
210− -- If there isn't a task with the given name, then it does nothing.
211− removeTask :: String -> t -> t
212−
213− -- | Sets the priority of the task with the given name.
214− -- If there isn't a task with the given name, then it does nothing.
215− modifyPriority :: String -> Priority -> t -> t
216−
217− -- | Renames the task with the given name to have a new name.
218− -- The first argument is the old name, the second argument is the new name.
219− -- If there isn't a task with the given name, then it does nothing.
220− -- If the new name clashes with an existing task, then the
221− -- behavior is undefined. (You can do whatever you want)
222− renameTask :: String -> String -> t -> t
223−
224−-- The task manager you are creating.
225−data MyTaskManager
226−
227−-- TODO: You have to make your 'MyTaskManager' an instance of
228−-- the 'TaskManager' typeclass.
229−instance TaskManager MyTaskManager
230−
231−-- ____ __ __
232−-- / ___|___ / _|/ _| ___ ___
233−-- | | / _ \| |_| |_ / _ \/ _ \
234−-- | |__| (_) | _| _| __/ __/
235−-- \____\___/|_| |_| \___|\___|
236−--
237−-- /~~~~~~~~~~~~~~~~~~~/|
238−-- / /######/ / |
239−-- / /______/ / |
240−-- ========================= /||
241−-- |_______________________|/ ||
242−-- | \****/ \__,,__/ ||
243−-- |===\**/ __,,__ ||
244−-- |______________\====/%____||
245−-- | ___ /~~~~\ % / |
246−-- _| |===|=== / \%_/ |
247−-- | | |###| |########| | /
248−-- |____\###/______\######/__|/
249−-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
250−
251−-- | Just a typealias to make types more readable.
252−type RUBAmount = Integer
253−
254−-- | Represents a cup of coffee with extra ingredients added.
255−data Coffee
256− = Coffee
257− { -- | The price of the coffee itself
258− -- (without the cost of the extra ingredients.)
259− cost :: RUBAmount,
260− -- | The extra ingredients added to the coffee.
261− extras :: [CoffeeExtra]
262− }
263− deriving (Eq, Show)
264−
265−-- Extra ingredients added to the coffee.
266−data CoffeeExtra
267− = Cream
268− | AlmondMilk
269− | SoyMilk
270− | OatMilk
271− | Cinnamon
272− | WhiteSugar
273− | BrownSugar
274− deriving (Eq, Show)
275−
276−-- | A typeclass representing objects, for which the price can be calculated.
277−class HasPrice x where
278− -- | Calculated the price of the item.
279− price :: x -> RUBAmount
280−
281−-- I have already made a 'CoffeeExtra' an instance of 'HasPrice' for you.
282−-- You should use this in price calculations.
283−instance HasPrice CoffeeExtra where
284− price Cream = 50
285− price AlmondMilk = 70
286− price SoyMilk = 80
287− price OatMilk = 65
288− price Cinnamon = 20
289− price WhiteSugar = 15
290− price BrownSugar = 35
291−
292−-- TODO: You want to make 'Coffee' an instance of 'HasPrice'.
293−instance HasPrice Coffee
294−
295−-- | A debit card.
296−-- Note: the balance can be negative.
297−data DebitCard
298− = DebitCard
299− { balance :: RUBAmount,
300− cardId :: Int
301− }
302− deriving (Eq, Show)
303−
304−-- | Given a coffee and a debit card, deduce the total price of the coffee from
305−-- the debit card. Return the given debit card with the reduced balance.
306−--
307−-- If the balance of the debit card after deducing the price of the coffee
308−-- would become negative, return 'Nothing' from the function.
309−chargeCoffee :: Coffee -> DebitCard -> Maybe DebitCard
310−chargeCoffee = error "TODO: chargeCoffee"
311−
312−-- | How was the coffee charged.
313−data PaymentMethod
314− = -- | The coffee was charged using a debit card.
315− Card
316− { -- | The debit card with the balance deduced.
317− chargedCard :: DebitCard
318− }
319− | -- | The coffee was charged with cash.
320− Cash
321− { -- | The leftover money from the payment.
322− -- (We assume that the person pays with all of the cash he has.)
323− change :: RUBAmount
324− }
325− deriving (Eq, Show)
326−
327−-- | Represents a coffee shop customer with all of the money he has on him.
328−data Customer
329− = Customer
330− { -- | All of the debit hards the person has on him.
331− -- Sorted in order of descending preference.
332− -- (He would prefer to use the first card in the list.)
333− cards :: [DebitCard],
334− -- | The amount of cash the customer has on him.
335− cash :: RUBAmount
336− }
337− deriving (Eq, Show)
338−
339−-- You have some new privacy-invading piece of ... technology, which
340−-- automatically scans the customer, determines how he would prefer to pay and
341−-- charges him automatically.
342−
343−-- | This function determines how the given customer would prefer to pay for the
344−-- coffee he wants.
345−--
346−-- The customer would always prefer to pay with a debit card if it is possible.
347−-- The customer has a strict preference in the cards he carries with him:
348−-- he would always like to pay with the first card in his wallet (the list). If
349−-- the first card doesn't have enough money on it, then he would prefer to use
350−-- the second card, and so on.
351−--
352−-- If non of the cards have enough balance to cover the coffee, then the
353−-- customer will have to pay in cash.
354−--
355−-- NOTE: The customer can only buy a coffee with strictly one payment method.
356−-- (Only one card or cash)
357−payForCoffee :: Customer -> Coffee -> Maybe PaymentMethod
358−payForCoffee = error "TODO: payForCoffee"
359−
360−-- | This function should apply the chosen payment method to the customer.
361−-- In other words, it needs to apply the charge to the customer himself
362−-- (update the debit card or update the amount of cash he currently has)
363−--
364−-- If the specified card is not present in the 'Customer' structure, then
365−-- do nothing.
366−--
367−-- NOTE: You can not change the order of the cards.
368−applyPayment :: Customer -> PaymentMethod -> Customer
369−applyPayment = error "TODO: applyPayment"
370−
371−-- | Performs the full payment (as in 'payForCoffee') and
372−-- returns the modified customer (as in 'applyPayment').
373−buyCoffee :: Customer -> Coffee -> Maybe Customer
374−buyCoffee = error "TODO: buyCoffee"
375−
376−-- | You know that due to a medical condition the customer needs to watch his
377−-- sugar intake. The new privacy-invading piece of ... technology can now
378−-- automatically apply filters to coffee orders.
379−--
380−-- You have to make a filter, which removes any occurrences of sugar
381−-- (either WhiteSugar or BrownSugar) from the ordered cups of coffee and
382−-- return the filtered orders and the amount of money the customer saves by
383−-- being healthy (sugar costs money after all). So, you also have to count how
384−-- much the total sugar would have cost.
385−--
386−-- NOTE: You can not change the order of the coffee.
387−saveTheDiabetic :: [Coffee] -> (RUBAmount, [Coffee])
388−saveTheDiabetic = error "TODO: saveTheDiabetic"
389−
390−-- | And just to torment those who love sugar lets make a function which
391−-- calculates health hazard (sugar content) of the given orders.
392−--
393−-- The only ingredient that elevates the danger level is, of course, sugar:
394−--
395−-- WhiteSugar: 2 extra danger points
396−-- BrownSugar: 1 extra danger point
397−calculateSugarDanger :: [Coffee] -> Int
398−calculateSugarDanger = error "TODO: calculateSugarDanger"
seminars/2/stack.yamldeleted−7
@@ -1,7 +0,0 @@
1−resolver: nightly-2024-10-11
2−
3−packages:
4−- .
5−
6−ghc-options:
7− "$locals": -ddump-to-file -ddump-hi -fwarn-unused-binds -fwarn-unused-imports -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Werror=missing-home-modules -Wmissing-home-modules -Widentities -Wredundant-constraints -Wmissing-export-lists
seminars/2/task.cabaldeleted−44
@@ -1,44 +0,0 @@
1−cabal-version: 2.2
2−
3−-- This file has been generated from package.yaml by hpack version 0.37.0.
4−--
5−-- see: https://github.com/sol/hpack
6−--
7−-- hash: 15a870ebff263dd9493d8624136d4468bfa3ade7fad4a0cb1b9a047b79b109d8
8−
9−name: task
10−version: 0.1.0.0
11−license: Unlicense
12−build-type: Simple
13−
14−library
15− exposed-modules:
16− Task
17− other-modules:
18− Paths_task
19− autogen-modules:
20− Paths_task
21− hs-source-dirs:
22− src
23− build-depends:
24− base >=4.7 && <5
25− , random
26− default-language: Haskell2010
27−
28−test-suite task-tests
29− type: exitcode-stdio-1.0
30− main-is: Main.hs
31− other-modules:
32− Tests
33− Paths_task
34− autogen-modules:
35− Paths_task
36− hs-source-dirs:
37− test
38− build-depends:
39− base >=4.7 && <5
40− , random
41− , task
42− , tasty
43− , tasty-hunit
44− default-language: Haskell2010
seminars/2/test/Main.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Main
2− ( main,
3− )
4−where
5−
6−import Test.Tasty
7−import Tests
8−
9−main :: IO ()
10−main = defaultMain tests
seminars/2/test/Tests.hsdeleted−439
@@ -1,439 +0,0 @@
1−module Tests
2− ( tests,
3− )
4−where
5−
6−import Data.Foldable
7−import Data.Function
8−import Data.List
9−import Task
10−import Test.Tasty
11−import Test.Tasty.HUnit
12−
13−tests :: TestTree
14−tests = testGroup "Tests"
15− [ testGroup "List Monoids"
16− [ testCase "FirstMonoid" $ do
17− let getFirst = destructFirstMonoid . fold . fmap constructFirstMonoid
18− getFirst [1 :: Int, 2, 3] @=? Just 1
19− getFirst [] @=? (Nothing :: Maybe ())
20− getFirst [True, False] @=? Just True
21− getFirst [True, True, False] @=? Just True
22− getFirst [1 .. 1000] @=? Just (1 :: Int)
23− getFirst [100 .. 1000] @=? Just (100 :: Int)
24− getFirst [6, 2, 7, 398, 1984, 383, -1020] @=? Just (6 :: Int)
25− , testCase "LastMonoid" $ do
26− let getLast = destructLastMonoid . fold . fmap constructLastMonoid
27− getLast [1 :: Int, 2, 3] @=? Just 3
28− getLast [] @=? (Nothing :: Maybe ())
29− getLast [1 .. 1000] @=? Just (1000 :: Int)
30− getLast [100 .. 10000] @=? Just (10000 :: Int)
31− getLast [6, 2, 7, 398, 1984, 383, -1020, 498] @=? Just (498 :: Int)
32− getLast [True, False] @=? Just False
33− getLast [True, True, False] @=? Just False
34− getLast [True, True, False, True] @=? Just True
35− ]
36− , testGroup "Todo List" $
37− let createTasks :: [(String, Priority)] -> MyTaskManager
38− createTasks = foldl (\t (a, b) -> createTask a b t) emptyTaskManager
39− getPrioritySets :: MyTaskManager -> [[(Completion, String)]]
40− getPrioritySets =
41− fmap (sort . fmap (\(a, _, b) -> (a, b)))
42− . groupBy ((==) `on` (\(_, p, _) -> p))
43− . getPriorityList
44− in
45− [ testCase "emptyTaskManager" $
46− getPriorityList (emptyTaskManager :: MyTaskManager) @=? []
47− , testCase "createTask" $ do
48− getPrioritySets
49− ( createTasks
50− [ ("a", Low),
51− ("aaa", Medium),
52− ("AAAAAAAAAA", High)
53− ]
54− )
55− @=? [ [(NotCompleted, "AAAAAAAAAA")],
56− [(NotCompleted, "aaa")],
57− [(NotCompleted, "a")]
58− ]
59− getPrioritySets
60− ( createTasks
61− [ ("a", Low),
62− ("AAAAAAAAAA", High)
63− ]
64− )
65− @=? [ [(NotCompleted, "AAAAAAAAAA")],
66− [(NotCompleted, "a")]
67− ]
68− getPrioritySets
69− ( createTasks
70− [ ("a", Low),
71− ("AAAAAAAAAA", High),
72− ("aaa", Medium),
73− ("oh HaiMark", Medium)
74− ]
75− )
76− @=? [ [(NotCompleted, "AAAAAAAAAA")],
77− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
78− [(NotCompleted, "a")]
79− ]
80− getPrioritySets
81− ( createTasks
82− [ ("a", Low),
83− ("AAAAAAAAAA", High),
84− ("aaa", Medium),
85− ("oh HaiMark", Medium),
86− ("OH NO", High)
87− ]
88− )
89− @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
90− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
91− [(NotCompleted, "a")]
92− ]
93− , testCase "toggleTaskCompletion" $ do
94− getPrioritySets
95− ( toggleTaskCompletion "AAAAAAAAAA" . createTasks $
96− [ ("a", Low),
97− ("AAAAAAAAAA", High),
98− ("aaa", Medium),
99− ("oh HaiMark", Medium),
100− ("OH NO", High)
101− ]
102− )
103− @=? [ [(Completed, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
104− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
105− [(NotCompleted, "a")]
106− ]
107− getPrioritySets
108− ( toggleTaskCompletion "AAAAAAAAAA" . toggleTaskCompletion "AAAAAAAAAA" . createTasks $
109− [ ("a", Low),
110− ("AAAAAAAAAA", High),
111− ("aaa", Medium),
112− ("oh HaiMark", Medium),
113− ("OH NO", High)
114− ]
115− )
116− @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
117− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
118− [(NotCompleted, "a")]
119− ]
120− getPrioritySets
121− ( toggleTaskCompletion "a"
122− . toggleTaskCompletion "not here"
123− . toggleTaskCompletion "AAAAAAAAAA"
124− . createTasks
125− $ [ ("a", Low),
126− ("AAAAAAAAAA", High),
127− ("aaa", Medium),
128− ("oh HaiMark", Medium),
129− ("OH NO", High)
130− ]
131− )
132− @=? [ [(Completed, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
133− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
134− [(Completed, "a")]
135− ]
136− , testCase "removeTask" $ do
137− getPrioritySets
138− ( removeTask "AAAAAAAAAA"
139− . createTasks
140− $ [ ("a", Low),
141− ("AAAAAAAAAA", High),
142− ("aaa", Medium),
143− ("oh HaiMark", Medium),
144− ("OH NO", High)
145− ]
146− )
147− @=? [ [(NotCompleted, "OH NO")],
148− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
149− [(NotCompleted, "a")]
150− ]
151− getPrioritySets
152− ( removeTask "AAAAAAAAAA" . removeTask "AAAAAAAAAA"
153− . createTasks
154− $ [ ("a", Low),
155− ("AAAAAAAAAA", High),
156− ("aaa", Medium),
157− ("oh HaiMark", Medium),
158− ("OH NO", High)
159− ]
160− )
161− @=? [ [(NotCompleted, "OH NO")],
162− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
163− [(NotCompleted, "a")]
164− ]
165− getPrioritySets
166− ( removeTask "aaa" . removeTask "oh HaiMark"
167− . removeTask "AAAAAAAAAA"
168− . removeTask "AAAAAAAAAA"
169− . createTasks
170− $ [ ("a", Low),
171− ("AAAAAAAAAA", High),
172− ("aaa", Medium),
173− ("oh HaiMark", Medium),
174− ("OH NO", High)
175− ]
176− )
177− @=? [ [(NotCompleted, "OH NO")],
178− [(NotCompleted, "a")]
179− ]
180− , testCase "modifyPriority" $ do
181− getPrioritySets
182− ( modifyPriority "aaa" High . createTasks $
183− [ ("a", Low),
184− ("AAAAAAAAAA", High),
185− ("aaa", Medium),
186− ("oh HaiMark", Medium),
187− ("OH NO", High)
188− ]
189− )
190− @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO"), (NotCompleted, "aaa")],
191− [(NotCompleted, "oh HaiMark")],
192− [(NotCompleted, "a")]
193− ]
194− getPrioritySets
195− ( modifyPriority "aaa" High
196− . toggleTaskCompletion "a"
197− . modifyPriority "a" High
198− . createTasks
199− $ [ ("a", Low),
200− ("AAAAAAAAAA", High),
201− ("aaa", Medium),
202− ("oh HaiMark", Medium),
203− ("OH NO", High)
204− ]
205− )
206− @=? [ [ (Completed, "a"),
207− (NotCompleted, "AAAAAAAAAA"),
208− (NotCompleted, "OH NO"),
209− (NotCompleted, "aaa")
210− ],
211− [(NotCompleted, "oh HaiMark")]
212− ]
213− getPrioritySets
214− ( modifyPriority "aaa" High
215− . modifyPriority "a" High
216− . modifyPriority "a" High
217− . modifyPriority "oh HaiMark" High
218− . createTasks
219− $ [ ("a", Low),
220− ("AAAAAAAAAA", High),
221− ("aaa", Medium),
222− ("oh HaiMark", Medium),
223− ("OH NO", High)
224− ]
225− )
226− @=? [ [ (NotCompleted, "AAAAAAAAAA"),
227− (NotCompleted, "OH NO"),
228− (NotCompleted, "a"),
229− (NotCompleted, "aaa"),
230− (NotCompleted, "oh HaiMark")
231− ]
232− ]
233− getPrioritySets
234− ( modifyPriority "aaa" High
235− . modifyPriority "a" High
236− . modifyPriority "ntestCase here sihji" High
237− . modifyPriority "oh HaiMark" Low
238− . modifyPriority "a" High
239− . modifyPriority "oh HaiMark" High
240− . createTasks
241− $ [ ("a", Low),
242− ("AAAAAAAAAA", High),
243− ("aaa", Medium),
244− ("oh HaiMark", Medium),
245− ("OH NO", High)
246− ]
247− )
248− @=? [ [ (NotCompleted, "AAAAAAAAAA"),
249− (NotCompleted, "OH NO"),
250− (NotCompleted, "a"),
251− (NotCompleted, "aaa")
252− ],
253− [(NotCompleted, "oh HaiMark")]
254− ]
255− , testCase "renameTask" $ do
256− getPrioritySets
257− ( renameTask "AAAAAAAAAA" "henlo"
258− . createTasks
259− $ [ ("a", Low),
260− ("AAAAAAAAAA", High),
261− ("aaa", Medium),
262− ("oh HaiMark", Medium),
263− ("OH NO", High)
264− ]
265− )
266− @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
267− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
268− [(NotCompleted, "a")]
269− ]
270− getPrioritySets
271− ( renameTask "AAAAAAAAAA" "henlo"
272− . toggleTaskCompletion "a"
273− . renameTask "oh HaiMark" "iz task"
274− . createTasks
275− $ [ ("a", Low),
276− ("AAAAAAAAAA", High),
277− ("aaa", Medium),
278− ("oh HaiMark", Medium),
279− ("OH NO", High)
280− ]
281− )
282− @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
283− [(NotCompleted, "aaa"), (NotCompleted, "iz task")],
284− [(Completed, "a")]
285− ]
286− getPrioritySets
287− ( renameTask "AAAAAAAAAA" "henlo"
288− . toggleTaskCompletion "iz task"
289− . renameTask "oh HaiMark" "iz task"
290− . renameTask "iz not here" "ajajaj"
291− . createTasks
292− $ [ ("a", Low),
293− ("AAAAAAAAAA", High),
294− ("aaa", Medium),
295− ("oh HaiMark", Medium),
296− ("OH NO", High)
297− ]
298− )
299− @=? [ [(NotCompleted, "OH NO"), (NotCompleted, "henlo")],
300− [(Completed, "iz task"), (NotCompleted, "aaa")],
301− [(NotCompleted, "a")]
302− ]
303− ]
304− , testGroup "Coffee"
305− [ testCase "HasPrice Coffee" $ do
306− price (Coffee 2 [OatMilk, Cinnamon]) @=? 2 + price OatMilk + price Cinnamon
307− price (Coffee 2 [Cinnamon, Cinnamon]) @=? 2 + price Cinnamon + price Cinnamon
308− price (Coffee 2 []) @=? 2
309− price (Coffee 2 [Cinnamon, Cream, Cinnamon])
310− @=? 2
311− + price Cinnamon
312− + price Cinnamon
313− + price Cream
314− , testCase "chargeCoffee" $ do
315− chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 199 69)
316− @=? Just (DebitCard 112 69)
317− chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 87 69)
318− @=? Just (DebitCard 0 69)
319− chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 86 69)
320− @=? Nothing
321− chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard 0 69)
322− @=? Nothing
323− chargeCoffee (Coffee 2 [OatMilk, Cinnamon]) (DebitCard (-2189) 69)
324− @=? Nothing
325− chargeCoffee (Coffee 2 [OatMilk, Cinnamon, WhiteSugar]) (DebitCard 199 69)
326− @=? Just (DebitCard 97 69)
327− chargeCoffee (Coffee 2 [WhiteSugar, OatMilk, Cinnamon, WhiteSugar]) (DebitCard 199 69)
328− @=? Just (DebitCard 82 69)
329− , let coffee = Coffee 2 [OatMilk, Cinnamon]
330− in testCase "payForCoffee" $ do
331− payForCoffee (Customer [DebitCard 199 69] 0) coffee
332− @=? Just (Card (DebitCard 112 69))
333− payForCoffee (Customer [DebitCard 86 12, DebitCard 199 69] 2) coffee
334− @=? Just (Card (DebitCard 112 69))
335− payForCoffee (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
336− @=? Just (Card (DebitCard 112 69))
337− payForCoffee (Customer [DebitCard 87 8, DebitCard 111 12, DebitCard 199 69] 0) coffee
338− @=? Just (Card (DebitCard 0 8))
339− payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 0) coffee
340− @=? Nothing
341− payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 87) coffee
342− @=? Just (Cash 0)
343− payForCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 81 69] 86) coffee
344− @=? Nothing
345− , testCase "applyPayment" $ do
346− applyPayment (Customer [DebitCard 199 69] 0) (Card (DebitCard 112 69))
347− @=? Customer [DebitCard 112 69] 0
348− applyPayment (Customer [DebitCard 111 12, DebitCard 199 69] 2) (Card (DebitCard 112 69))
349− @=? Customer [DebitCard 111 12, DebitCard 112 69] 2
350− applyPayment (Customer [DebitCard (-12) 8, DebitCard 111 12, DebitCard 199 69] 0) (Card (DebitCard 112 69))
351− @=? Customer [DebitCard (-12) 8, DebitCard 111 12, DebitCard 112 69] 0
352− applyPayment (Customer [DebitCard 112 8, DebitCard 111 12, DebitCard 199 69] 0) (Card (DebitCard 0 8))
353− @=? Customer [DebitCard 0 8, DebitCard 111 12, DebitCard 199 69] 0
354− applyPayment (Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112) (Cash 0)
355− @=? Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 0
356− applyPayment (Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112) (Card (DebitCard 0 13))
357− @=? Customer [DebitCard 111 8, DebitCard 111 12, DebitCard 110 69] 112
358− , let coffee = Coffee 2 [OatMilk, Cinnamon]
359− in testCase "buyCoffee" $ do
360− buyCoffee (Customer [DebitCard 199 69] 0) coffee
361− @=? Just (Customer [DebitCard 112 69] 0)
362− buyCoffee (Customer [DebitCard 86 12, DebitCard 199 69] 2) coffee
363− @=? Just (Customer [DebitCard 86 12, DebitCard 112 69] 2)
364− buyCoffee (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
365− @=? Just (Customer [DebitCard (-12) 8, DebitCard 86 12, DebitCard 112 69] 0)
366− buyCoffee (Customer [DebitCard 87 8, DebitCard 86 12, DebitCard 199 69] 0) coffee
367− @=? Just (Customer [DebitCard 0 8, DebitCard 86 12, DebitCard 199 69] 0)
368− buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 84 69] 0) coffee
369− @=? Nothing
370− buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 87) coffee
371− @=? Just (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 82 69] 0)
372− buyCoffee (Customer [DebitCard 86 8, DebitCard 86 12, DebitCard 81 69] 86) coffee
373− @=? Nothing
374− , testCase "saveTheDiabetic" $ do
375− saveTheDiabetic
376− [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
377− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
378− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
379− ]
380− @=? ( 150,
381− [ Coffee 0 [Cinnamon],
382− Coffee 0 [Cinnamon],
383− Coffee 0 [Cinnamon]
384− ]
385− )
386− saveTheDiabetic
387− [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon, BrownSugar, SoyMilk],
388− Coffee 0 [WhiteSugar, BrownSugar, WhiteSugar, WhiteSugar, Cinnamon],
389− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
390− ]
391− @=? ( 215,
392− [ Coffee 0 [Cinnamon, SoyMilk],
393− Coffee 0 [Cinnamon],
394− Coffee 0 [Cinnamon]
395− ]
396− )
397− saveTheDiabetic
398− [ Coffee 0 [Cinnamon, SoyMilk],
399− Coffee 0 [Cinnamon],
400− Coffee 0 [Cinnamon],
401− Coffee 69 []
402− ]
403− @=? ( 0,
404− [ Coffee 0 [Cinnamon, SoyMilk],
405− Coffee 0 [Cinnamon],
406− Coffee 0 [Cinnamon],
407− Coffee 69 []
408− ]
409− )
410− saveTheDiabetic
411− []
412− @=? ( 0,
413− []
414− )
415− , testCase "calculateSugarDanger" $ do
416− calculateSugarDanger
417− [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
418− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
419− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon]
420− ]
421− @=? 9
422− calculateSugarDanger
423− [ Coffee 0 [WhiteSugar, BrownSugar, Cinnamon, BrownSugar, SoyMilk],
424− Coffee 0 [WhiteSugar, BrownSugar, WhiteSugar, WhiteSugar, Cinnamon],
425− Coffee 0 [WhiteSugar, BrownSugar, Cinnamon],
426− Coffee 0 []
427− ]
428− @=? 14
429− calculateSugarDanger
430− [ Coffee 0 [Cinnamon, SoyMilk],
431− Coffee 0 [Cinnamon],
432− Coffee 0 [Cinnamon]
433− ]
434− @=? 0
435− calculateSugarDanger
436− []
437− @=? 0
438− ]
439− ]
seminars/calc/.gitignoredeleted−2
@@ -1,2 +0,0 @@
1−.stack-work/
2−*~
seminars/calc/CHANGELOG.mddeleted−11
@@ -1,11 +0,0 @@
1−# Changelog for `calc`
2−
3−All notable changes to this project will be documented in this file.
4−
5−The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
6−and this project adheres to the
7−[Haskell Package Versioning Policy](https://pvp.haskell.org/).
8−
9−## Unreleased
10−
11−## 0.1.0.0 - YYYY-MM-DD
seminars/calc/LICENSEdeleted−26
@@ -1,26 +0,0 @@
1−Copyright 2025 Author name here
2−
3−Redistribution and use in source and binary forms, with or without
4−modification, are permitted provided that the following conditions are met:
5−
6−1. Redistributions of source code must retain the above copyright notice, this
7− list of conditions and the following disclaimer.
8−
9−2. Redistributions in binary form must reproduce the above copyright notice,
10− this list of conditions and the following disclaimer in the documentation
11− and/or other materials provided with the distribution.
12−
13−3. Neither the name of the copyright holder nor the names of its contributors
14− may be used to endorse or promote products derived from this software
15− without specific prior written permission.
16−
17−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
18−ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19−WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
20−DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
21−ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
22−(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
23−LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
24−ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26−SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
seminars/calc/README.mddeleted−1
@@ -1 +0,0 @@
1−# calc
seminars/calc/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
seminars/calc/app/Main.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Lib
4−
5−main :: IO ()
6−main = server
seminars/calc/calc.cabaldeleted−76
@@ -1,76 +0,0 @@
1−cabal-version: 2.2
2−
3−-- This file has been generated from package.yaml by hpack version 0.37.0.
4−--
5−-- see: https://github.com/sol/hpack
6−
7−name: calc
8−version: 0.1.0.0
9−description: Please see the README on GitHub at <https://github.com/githubuser/calc#readme>
10−homepage: https://github.com/githubuser/calc#readme
11−bug-reports: https://github.com/githubuser/calc/issues
12−author: Author name here
13−maintainer: example@example.com
14−copyright: 2025 Author name here
15−license: BSD-3-Clause
16−license-file: LICENSE
17−build-type: Simple
18−extra-source-files:
19− README.md
20− CHANGELOG.md
21−
22−source-repository head
23− type: git
24− location: https://github.com/githubuser/calc
25−
26−library
27− exposed-modules:
28− Lib
29− other-modules:
30− Paths_calc
31− autogen-modules:
32− Paths_calc
33− hs-source-dirs:
34− src
35− ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
36− build-depends:
37− base >=4.7 && <5
38− , mtl
39− , scotty
40− , text
41− default-language: Haskell2010
42−
43−executable calc-exe
44− main-is: Main.hs
45− other-modules:
46− Paths_calc
47− autogen-modules:
48− Paths_calc
49− hs-source-dirs:
50− app
51− ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
52− build-depends:
53− base >=4.7 && <5
54− , calc
55− , mtl
56− , scotty
57− , text
58− default-language: Haskell2010
59−
60−test-suite calc-test
61− type: exitcode-stdio-1.0
62− main-is: Spec.hs
63− other-modules:
64− Paths_calc
65− autogen-modules:
66− Paths_calc
67− hs-source-dirs:
68− test
69− ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
70− build-depends:
71− base >=4.7 && <5
72− , calc
73− , mtl
74− , scotty
75− , text
76− default-language: Haskell2010
seminars/calc/package.yamldeleted−62
@@ -1,62 +0,0 @@
1−name: calc
2−version: 0.1.0.0
3−github: "githubuser/calc"
4−license: BSD-3-Clause
5−author: "Author name here"
6−maintainer: "example@example.com"
7−copyright: "2025 Author name here"
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: Web
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 <https://github.com/githubuser/calc#readme>
21−
22−dependencies:
23−- base >= 4.7 && < 5
24−- scotty
25−- text
26−- mtl
27−
28−ghc-options:
29−- -Wall
30−- -Wcompat
31−- -Widentities
32−- -Wincomplete-record-updates
33−- -Wincomplete-uni-patterns
34−- -Wmissing-export-lists
35−- -Wmissing-home-modules
36−- -Wpartial-fields
37−- -Wredundant-constraints
38−
39−library:
40− source-dirs: src
41−
42−executables:
43− calc-exe:
44− main: Main.hs
45− source-dirs: app
46− ghc-options:
47− - -threaded
48− - -rtsopts
49− - -with-rtsopts=-N
50− dependencies:
51− - calc
52−
53−tests:
54− calc-test:
55− main: Spec.hs
56− source-dirs: test
57− ghc-options:
58− - -threaded
59− - -rtsopts
60− - -with-rtsopts=-N
61− dependencies:
62− - calc
seminars/calc/src/Lib.hsdeleted−27
@@ -1,27 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−module Lib
5− ( server
6− ) where
7−
8−import Web.Scotty
9−import Data.IORef
10−import qualified Data.Text.Lazy
11−import Control.Monad.Trans
12−
13−server :: IO ()
14−server = do
15− result <- newIORef 0
16− scotty 3000 $ do
17− get "/:word" $ do
18− beam <- pathParam "word"
19− html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"]
20− post "/add/:number" $ do
21− number :: Int <- pathParam "number"
22− result <- lift $ atomicModifyIORef result (\x -> (x + number, x + number))
23− -- modifyIORef :: IORef a -> (a -> a) -> IO ()
24− -- atomicModifyIORef :: IORef a -> (a -> (a, b)) -> IO b
25− text $ Data.Text.Lazy.pack $ show result
26−
27−-- pure :: a -> ActionT IO a
seminars/calc/stack.yamldeleted−71
@@ -1,71 +0,0 @@
1−# This file was automatically generated by 'stack init'
2−#
3−# Some commonly used options have been documented as comments in this file.
4−# For advanced use and comprehensive documentation of the format, please see:
5−# https://docs.haskellstack.org/en/stable/yaml_configuration/
6−
7−# A 'specific' Stackage snapshot or a compiler version.
8−# A snapshot resolver dictates the compiler version and the set of packages
9−# to be used for project dependencies. For example:
10−#
11−# snapshot: lts-22.28
12−# snapshot: nightly-2024-07-05
13−# snapshot: ghc-9.6.6
14−#
15−# The location of a snapshot can be provided as a file or url. Stack assumes
16−# a snapshot provided as a file might change, whereas a url resource does not.
17−#
18−# snapshot: ./custom-snapshot.yaml
19−# snapshot: https://example.com/snapshots/2024-01-01.yaml
20−snapshot: nightly-2024-10-11
21−
22−nix:
23− enable: true
24− packages:
25− - zlib
26−
27−# User packages to be built.
28−# Various formats can be used as shown in the example below.
29−#
30−# packages:
31−# - some-directory
32−# - https://example.com/foo/bar/baz-0.0.2.tar.gz
33−# subdirs:
34−# - auto-update
35−# - wai
36−packages:
37−- .
38−# Dependency packages to be pulled from upstream that are not in the snapshot.
39−# These entries can reference officially published versions as well as
40−# forks / in-progress versions pinned to a git hash. For example:
41−#
42−# extra-deps:
43−# - acme-missiles-0.3
44−# - git: https://github.com/commercialhaskell/stack.git
45−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
46−#
47−# extra-deps: []
48−
49−# Override default flag values for project packages and extra-deps
50−# flags: {}
51−
52−# Extra package databases containing global packages
53−# extra-package-dbs: []
54−
55−# Control whether we use the GHC we find on the path
56−# system-ghc: true
57−#
58−# Require a specific version of Stack, using version ranges
59−# require-stack-version: -any # Default
60−# require-stack-version: ">=3.1"
61−#
62−# Override the architecture used by Stack, especially useful on Windows
63−# arch: i386
64−# arch: x86_64
65−#
66−# Extra directories used by Stack for building
67−# extra-include-dirs: [/path/to/dir]
68−# extra-lib-dirs: [/path/to/dir]
69−#
70−# Allow a newer minor version of GHC than the snapshot specifies
71−# compiler-check: newer-minor
seminars/calc/test/Spec.hsdeleted−2
@@ -1,2 +0,0 @@
1−main :: IO ()
2−main = putStrLn "Test suite not yet implemented"