git.iko.soy/production-haskell
on master help sign in
Added seminar 1
commitab949af16b01f8e89273c391b16e6728d2a5820b authoriko <mail@iko.soy> dateSun 4 Feb 2024, 18:01 (3 years ago)
9 files changed+918
compare with master
unifiedsplit
.gitignore+28 LICENSE+24 seminars/1/README.md+17 seminars/1/package.yaml+18 seminars/1/src/Task.hs+332 seminars/1/stack.yaml+7 seminars/1/task.cabal+43 seminars/1/test/Main.hs+10 seminars/1/test/Tests.hs+439
.gitignorenew file+28
@@ -0,0 +1,28 @@
1+dist
2+dist-*
3+cabal-dev
4+*.o
5+*.hi
6+*.hie
7+*.chi
8+*.chs.h
9+*.dyn_o
10+*.dyn_hi
11+.hpc
12+.hsenv
13+.cabal-sandbox/
14+cabal.sandbox.config
15+*.prof
16+*.aux
17+*.hp
18+*.eventlog
19+.stack-work/
20+cabal.project.local
21+cabal.project.local~
22+.HTF/
23+.ghc.environment.*
24+.DS_Store
25+.idea/
26+*.dump-hi
27+*.lock
28+*.iml
LICENSEnew file+24
@@ -0,0 +1,24 @@
1+This is free and unencumbered software released into the public domain.
2+
3+Anyone is free to copy, modify, publish, use, compile, sell, or
4+distribute this software, either in source code form or as a compiled
5+binary, for any purpose, commercial or non-commercial, and by any
6+means.
7+
8+In jurisdictions that recognize copyright laws, the author or authors
9+of this software dedicate any and all copyright interest in the
10+software to the public domain. We make this dedication for the benefit
11+of the public at large and to the detriment of our heirs and
12+successors. We intend this dedication to be an overt act of
13+relinquishment in perpetuity of all present and future rights to this
14+software under copyright law.
15+
16+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
20+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
21+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
22+OTHER DEALINGS IN THE SOFTWARE.
23+
24+For more information, please refer to <https://unlicense.org>
seminars/1/README.mdnew file+17
@@ -0,0 +1,17 @@
1+# 🎒📓💻 Task 2
2+
3+**NOTE: If you just fork this repository it will not be graded. Ask your supervisor for a special GitHub classroom URL.**
4+
5+## How to do the task
6+
7+Your task is to write a valid definition for every function declared in `src/Task.hs`. All functions have a comment describing what the function needs to do with some examples.
8+
9+There are predefined tests for you to check your answer. You can look at the tests for some more usage examples in `test/Tests.hs`.
10+
11+After defining all functions you then need to commit **and push** your code to your repository. An automated script will then check your solution and give you feedback as a CI result in your GitHub repository.
12+
13+## FAQ
14+
15+> Can I add extra functions in the `Task.hs` file?
16+
17+Yes, you can, but you can not remove existing functions.
seminars/1/package.yamlnew file+18
@@ -0,0 +1,18 @@
1+name: task
2+version: 0.1.0.0
3+license: Unlicense
4+
5+dependencies:
6+ - base >= 4.7 && < 5
7+
8+library:
9+ source-dirs: src
10+
11+tests:
12+ task-tests:
13+ source-dirs: test
14+ main: Main.hs
15+ dependencies:
16+ - tasty
17+ - tasty-hunit
18+ - task
seminars/1/src/Task.hsnew file+332
@@ -0,0 +1,332 @@
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+ )
30+where
31+
32+-- _ _ _ __ __ _ _
33+-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
34+-- | | | / __| __| | |\/| |/ _ \| '_ \ / _ \| |/ _` / __|
35+-- | |___| \__ \ |_ | | | | (_) | | | | (_) | | (_| \__ \
36+-- |_____|_|___/\__| |_| |_|\___/|_| |_|\___/|_|\__,_|___/
37+
38+-- Write a datatype and a Monoid instance for it such that:
39+--
40+-- (destructFirstMonoid . fold . fmap constructFirstMonoid) == safeHead
41+--
42+-- (constructFirstMonoid and destructFirstMonoid would wrap and
43+-- unwrap the `FirstMonoid`)
44+--
45+-- In other words, it needs to have a monoid instance such that `fold`ing
46+-- a list of `FirstMonoid`s should return the first element
47+--
48+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) [1, 2, 3]
49+-- Just 1
50+--
51+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) []
52+-- Nothing
53+data FirstMonoid a
54+
55+instance Semigroup (FirstMonoid a)
56+
57+instance Monoid (FirstMonoid a)
58+
59+-- Warps an `a` in a `FirstMonoid`.
60+constructFirstMonoid :: a -> FirstMonoid a
61+constructFirstMonoid = error "TODO: constructFirstMonoid"
62+
63+-- Unwraps the `a` from a `FirstMonoid`, if there is one.
64+destructFirstMonoid :: FirstMonoid a -> Maybe a
65+destructFirstMonoid = error "TODO: destructFirstMonoid"
66+
67+-- Write a datatype and a Monoid instance for it such that:
68+--
69+-- (destructLastMonoid . fold . fmap constructLastMonoid) == safeLast
70+--
71+-- (constructLastMonoid and destructLastMonoid would wrap and
72+-- unwrap the `LastMonoid`)
73+--
74+-- In other words, it needs to have a monoid instance such that `fold`ing
75+-- a list of `LastMonoid`s should return the last element
76+--
77+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) [1, 2, 3]
78+-- Just 3
79+--
80+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) []
81+-- Nothing
82+data LastMonoid a
83+
84+instance Semigroup (LastMonoid a)
85+
86+instance Monoid (LastMonoid a)
87+
88+-- Warps an `a` in a `LastMonoid`.
89+constructLastMonoid :: a -> LastMonoid a
90+constructLastMonoid = error "TODO: constructLastMonoid"
91+
92+-- Unwraps the `a` from a `LastMonoid`, if there is one.
93+destructLastMonoid :: LastMonoid a -> Maybe a
94+destructLastMonoid = error "TODO: destructLastMonoid"
95+
96+-- _____ _ _ _ _
97+-- |_ _|__ __| | ___ | | (_)___| |_
98+-- | |/ _ \ / _` |/ _ \ | | | / __| __|
99+-- | | (_) | (_| | (_) | | |___| \__ \ |_
100+-- |_|\___/ \__,_|\___/ |_____|_|___/\__|
101+
102+-- Your task is to create a todo list backend, which supports adding tasks,
103+-- changing the priority of tasks, completing tasks, renaming tasks, and
104+-- displaying tasks as a list in order of descending priority.
105+
106+-- | The priority of a task.
107+data Priority = Low | Medium | High
108+ deriving (Show, Eq)
109+
110+-- | The completion status of a task.
111+data Completion = Completed | NotCompleted
112+ deriving (Show, Eq, Ord)
113+
114+class TaskManager t where
115+ -- | Returns an empty task manager backend (it should have no tasks).
116+ emptyTaskManager :: t
117+
118+ -- | Gets the list of all tasks, sorted by priority in the order:
119+ -- High, Medium, Low
120+ --
121+ -- Ordering of tasks with the same priority is not defined
122+ -- (You can do whatever you want)
123+ getPriorityList :: t -> [(Completion, Priority, String)]
124+
125+ -- | Creates a new task with the given name and priority.
126+ -- Tasks are uniquely identified by their name.
127+ -- When a task is newly created its status should be 'NotCompleted'.
128+ --
129+ -- If there is already a task with the given name, then the
130+ -- behavior is undefined. (You can do whatever you want)
131+ createTask :: String -> Priority -> t -> t
132+
133+ -- | Toggles a task with the given name.
134+ -- If the task has the status 'Completed', then it would become 'NotCompleted'.
135+ -- If the task has the status 'NotCompleted', then it would become 'Completed'.
136+ --
137+ -- Needless to say, toggling the same task twice should be
138+ -- equivalent to not doing anything.
139+ --
140+ -- If there is no tasks with the given name, then it does nothing.
141+ toggleTaskCompletion :: String -> t -> t
142+
143+ -- | Removes the task with the given name.
144+ -- If there isn't a task with the given name, then it does nothing.
145+ removeTask :: String -> t -> t
146+
147+ -- | Sets the priority of the task with the given name.
148+ -- If there isn't a task with the given name, then it does nothing.
149+ modifyPriority :: String -> Priority -> t -> t
150+
151+ -- | Renames the task with the given name to have a new name.
152+ -- The first argument is the old name, the second argument is the new name.
153+ -- If there isn't a task with the given name, then it does nothing.
154+ -- If the new name clashes with an existing task, then the
155+ -- behavior is undefined. (You can do whatever you want)
156+ renameTask :: String -> String -> t -> t
157+
158+-- The task manager you are creating.
159+data MyTaskManager
160+
161+-- TODO: You have to make your 'MyTaskManager' an instance of
162+-- the 'TaskManager' typeclass.
163+instance TaskManager MyTaskManager
164+
165+-- ____ __ __
166+-- / ___|___ / _|/ _| ___ ___
167+-- | | / _ \| |_| |_ / _ \/ _ \
168+-- | |__| (_) | _| _| __/ __/
169+-- \____\___/|_| |_| \___|\___|
170+--
171+-- /~~~~~~~~~~~~~~~~~~~/|
172+-- / /######/ / |
173+-- / /______/ / |
174+-- ========================= /||
175+-- |_______________________|/ ||
176+-- | \****/ \__,,__/ ||
177+-- |===\**/ __,,__ ||
178+-- |______________\====/%____||
179+-- | ___ /~~~~\ % / |
180+-- _| |===|=== / \%_/ |
181+-- | | |###| |########| | /
182+-- |____\###/______\######/__|/
183+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
184+
185+-- | Just a typealias to make types more readable.
186+type RUBAmount = Integer
187+
188+-- | Represents a cup of coffee with extra ingredients added.
189+data Coffee
190+ = Coffee
191+ { -- | The price of the coffee itself
192+ -- (without the cost of the extra ingredients.)
193+ cost :: RUBAmount,
194+ -- | The extra ingredients added to the coffee.
195+ extras :: [CoffeeExtra]
196+ }
197+ deriving (Eq, Show)
198+
199+-- Extra ingredients added to the coffee.
200+data CoffeeExtra
201+ = Cream
202+ | AlmondMilk
203+ | SoyMilk
204+ | OatMilk
205+ | Cinnamon
206+ | WhiteSugar
207+ | BrownSugar
208+ deriving (Eq, Show)
209+
210+-- | A typeclass representing objects, for which the price can be calculated.
211+class HasPrice x where
212+ -- | Calculated the price of the item.
213+ price :: x -> RUBAmount
214+
215+-- I have already made a 'CoffeeExtra' an instance of 'HasPrice' for you.
216+-- You should use this in price calculations.
217+instance HasPrice CoffeeExtra where
218+ price Cream = 50
219+ price AlmondMilk = 70
220+ price SoyMilk = 80
221+ price OatMilk = 65
222+ price Cinnamon = 20
223+ price WhiteSugar = 15
224+ price BrownSugar = 35
225+
226+-- TODO: You want to make 'Coffee' an instance of 'HasPrice'.
227+instance HasPrice Coffee
228+
229+-- | A debit card.
230+-- Note: the balance can be negative.
231+data DebitCard
232+ = DebitCard
233+ { balance :: RUBAmount,
234+ cardId :: Int
235+ }
236+ deriving (Eq, Show)
237+
238+-- | Given a coffee and a debit card, deduce the total price of the coffee from
239+-- the debit card. Return the given debit card with the reduced balance.
240+--
241+-- If the balance of the debit card after deducing the price of the coffee
242+-- would become negative, return 'Nothing' from the function.
243+chargeCoffee :: Coffee -> DebitCard -> Maybe DebitCard
244+chargeCoffee = error "TODO: chargeCoffee"
245+
246+-- | How was the coffee charged.
247+data PaymentMethod
248+ = -- | The coffee was charged using a debit card.
249+ Card
250+ { -- | The debit card with the balance deduced.
251+ chargedCard :: DebitCard
252+ }
253+ | -- | The coffee was charged with cash.
254+ Cash
255+ { -- | The leftover money from the payment.
256+ -- (We assume that the person pays with all of the cash he has.)
257+ change :: RUBAmount
258+ }
259+ deriving (Eq, Show)
260+
261+-- | Represents a coffee shop customer with all of the money he has on him.
262+data Customer
263+ = Customer
264+ { -- | All of the debit hards the person has on him.
265+ -- Sorted in order of descending preference.
266+ -- (He would prefer to use the first card in the list.)
267+ cards :: [DebitCard],
268+ -- | The amount of cash the customer has on him.
269+ cash :: RUBAmount
270+ }
271+ deriving (Eq, Show)
272+
273+-- You have some new privacy-invading piece of ... technology, which
274+-- automatically scans the customer, determines how he would prefer to pay and
275+-- charges him automatically.
276+
277+-- | This function determines how the given customer would prefer to pay for the
278+-- coffee he wants.
279+--
280+-- The customer would always prefer to pay with a debit card if it is possible.
281+-- The customer has a strict preference in the cards he carries with him:
282+-- he would always like to pay with the first card in his wallet (the list). If
283+-- the first card doesn't have enough money on it, then he would prefer to use
284+-- the second card, and so on.
285+--
286+-- If non of the cards have enough balance to cover the coffee, then the
287+-- customer will have to pay in cash.
288+--
289+-- NOTE: The customer can only buy a coffee with strictly one payment method.
290+-- (Only one card or cash)
291+payForCoffee :: Customer -> Coffee -> Maybe PaymentMethod
292+payForCoffee = error "TODO: payForCoffee"
293+
294+-- | This function should apply the chosen payment method to the customer.
295+-- In other words, it needs to apply the charge to the customer himself
296+-- (update the debit card or update the amount of cash he currently has)
297+--
298+-- If the specified card is not present in the 'Customer' structure, then
299+-- do nothing.
300+--
301+-- NOTE: You can not change the order of the cards.
302+applyPayment :: Customer -> PaymentMethod -> Customer
303+applyPayment = error "TODO: applyPayment"
304+
305+-- | Performs the full payment (as in 'payForCoffee') and
306+-- returns the modified customer (as in 'applyPayment').
307+buyCoffee :: Customer -> Coffee -> Maybe Customer
308+buyCoffee = error "TODO: buyCoffee"
309+
310+-- | You know that due to a medical condition the customer needs to watch his
311+-- sugar intake. The new privacy-invading piece of ... technology can now
312+-- automatically apply filters to coffee orders.
313+--
314+-- You have to make a filter, which removes any occurrences of sugar
315+-- (either WhiteSugar or BrownSugar) from the ordered cups of coffee and
316+-- return the filtered orders and the amount of money the customer saves by
317+-- being healthy (sugar costs money after all). So, you also have to count how
318+-- much the total sugar would have cost.
319+--
320+-- NOTE: You can not change the order of the coffee.
321+saveTheDiabetic :: [Coffee] -> (RUBAmount, [Coffee])
322+saveTheDiabetic = error "TODO: saveTheDiabetic"
323+
324+-- | And just to torment those who love sugar lets make a function which
325+-- calculates health hazard (sugar content) of the given orders.
326+--
327+-- The only ingredient that elevates the danger level is, of course, sugar:
328+--
329+-- WhiteSugar: 2 extra danger points
330+-- BrownSugar: 1 extra danger point
331+calculateSugarDanger :: [Coffee] -> Int
332+calculateSugarDanger = error "TODO: calculateSugarDanger"
seminars/1/stack.yamlnew file+7
@@ -0,0 +1,7 @@
1+resolver: lts-22.6
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/1/task.cabalnew file+43
@@ -0,0 +1,43 @@
1+cabal-version: 2.2
2+
3+-- This file has been generated from package.yaml by hpack version 0.36.0.
4+--
5+-- see: https://github.com/sol/hpack
6+--
7+-- hash: e7ce4d16c67bf724ae661c06d421b31bdf4a8955874528858483b7ed2f59e002
8+
9+name: task
10+version: 0.1.0.0
11+license: Unlicense
12+license-file: LICENSE
13+build-type: Simple
14+
15+library
16+ exposed-modules:
17+ Task
18+ other-modules:
19+ Paths_task
20+ autogen-modules:
21+ Paths_task
22+ hs-source-dirs:
23+ src
24+ build-depends:
25+ base >=4.7 && <5
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+ , task
41+ , tasty
42+ , tasty-hunit
43+ default-language: Haskell2010
seminars/1/test/Main.hsnew file+10
@@ -0,0 +1,10 @@
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/1/test/Tests.hsnew file+439
@@ -0,0 +1,439 @@
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+ ]