git.iko.soy/production-haskell
on master help sign in
swap
db2639510 ahead, 0 behind
flake.nixnew file+24
since splitsnapshots
unifiedsplit
@@ -0,0 +1,24 @@
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.mdnew file+25
@@ -0,0 +1,25 @@
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+6−2
@@ -4,7 +4,10 @@ license: Unlicense
4
4
5dependencies:
5dependencies:
6 - base >= 4.7 && < 5
6 - base >= 4.7 && < 5
7− - containers
7+ - QuickCheck
8+
9+default-extensions:
10+ - EmptyDataDeriving
8
11
9library:
12library:
10 source-dirs: src
13 source-dirs: src
@@ -15,5 +18,6 @@ tests:
15 main: Main.hs
18 main: Main.hs
16 dependencies:
19 dependencies:
17 - tasty
20 - tasty
18− - tasty-hunit
21+ - tasty-hspec
22+ - hspec
19 - task
23 - task
seminars/1/src/Task.hs+367−384
@@ -1,405 +1,388 @@
1−{-# LANGUAGE InstanceSigs #-}
2module Task
1module Task
3− ( -- * List Monoids
2+ ( regroup,
4− constructFirstMonoid,
3+ safeHead,
5− destructFirstMonoid,
4+ safeLast,
6− FirstMonoid,
5+ withoutLast,
7− constructLastMonoid,
6+ indexed,
8− destructLastMonoid,
7+ alternating,
9− LastMonoid,
8+ constructTree,
9+ leftmost,
10+ rightmost,
11+ treeSum,
12+ insert,
13+ insertAll,
14+ treeSize,
15+ getInt, getString, twoAndHello
16+ , StringList
17+ )
18+where
10
19
11− -- * Todo List
20+import Numeric.Natural
12− Priority (..),
21+import Test.QuickCheck
13− Completion (..),
14− TaskManager (..),
15− MyTaskManager,
16
22
17− -- * Coffee
23+data IntAndString = IntAndStringCons Int String
18− DebitCard (..),
24+
19− Coffee (..),
25+getInt :: IntAndString -> Int
20− CoffeeExtra (..),
26+getInt (IntAndStringCons int _) = int
21− HasPrice (..),
22− chargeCoffee,
23− PaymentMethod (..),
24− Customer (..),
25− payForCoffee,
26− applyPayment,
27− buyCoffee,
28− saveTheDiabetic,
29− calculateSugarDanger,
30− )
31−where
32
27
33−import Data.Map (Map, empty, toList, insert, update, delete)
28+getString :: IntAndString -> String
34−import Data.Monoid (Sum(..))
29+getString (IntAndStringCons _ string) = string
35−import qualified Data.Map
36−import Data.List (sortBy)
37−import Data.Maybe (catMaybes, listToMaybe, mapMaybe)
38−import Control.Applicative hiding (empty)
39
30
40−-- _ _ _ __ __ _ _
31+twoAndHello :: IntAndString
41−-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
32+twoAndHello = IntAndStringCons 2 "Hello"
42−-- | | | / __| __| | |\/| |/ _ \| '_ \ / _ \| |/ _` / __|
43−-- | |___| \__ \ |_ | | | | (_) | | | | (_) | | (_| \__ \
44−-- |_____|_|___/\__| |_| |_|\___/|_| |_|\___/|_|\__,_|___/
45
33
46−-- Write a datatype and a Monoid instance for it such that:
34+-- Implement a function which regroups a nested tuple as the types would suggest.
47--
35--
48−-- (destructFirstMonoid . fold . fmap constructFirstMonoid) == safeHead
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:
49--
68--
50−-- (constructFirstMonoid and destructFirstMonoid would wrap and
69+-- data Maybe a = Just a | Nothing
51−-- unwrap the `FirstMonoid`)
52--
70--
53−-- In other words, it needs to have a monoid instance such that `fold`ing
54−-- a list of `FirstMonoid`s should return the first element
71+-- If the list has any elements return `Just` the first element, else return `Nothing`.
55--
72--
56−-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) [1, 2, 3]
73+-- >>> safeHead [1, 2, 3]
57-- Just 1
74-- Just 1
58--
75--
59−-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) []
76+-- >>> safeHead []
60-- Nothing
77-- Nothing
78+safeHead :: [a] -> Maybe a
79+safeHead [] = Nothing
80+safeHead (x:_) = Just x
61
81
62−data FirstMonoid a = FM (Maybe a)
82+-- Same as `safeHead`, but returns the last element.
63−
64−instance Semigroup (FirstMonoid a) where
65− (FM Nothing) <> x = x
66− x <> _ = x
67−
68−
69−instance Monoid (FirstMonoid a) where
70− mempty = FM Nothing
71−
72−-- Warps an `a` in a `FirstMonoid`.
73−constructFirstMonoid :: a -> FirstMonoid a
74−constructFirstMonoid = FM . Just
75−
76−-- Unwraps the `a` from a `FirstMonoid`, if there is one.
77−destructFirstMonoid :: FirstMonoid a -> Maybe a
78−destructFirstMonoid (FM x) = x
79−
80−-- Write a datatype and a Monoid instance for it such that:
81--
83--
82−-- (destructLastMonoid . fold . fmap constructLastMonoid) == safeLast
84+-- >>> safeLast [1, 2, 3]
85+-- Just 3
83--
86--
84−-- (constructLastMonoid and destructLastMonoid would wrap and
87+-- >>> safeLast []
85−-- unwrap the `LastMonoid`)
88+-- Nothing
89+safeLast :: [a] -> Maybe a
90+safeLast [] = Nothing
91+safeLast [x] = Just x
92+safeLast (_:xs) = safeLast xs
93+
94+-- Returns the same list without the last element.
86--
95--
87−-- In other words, it needs to have a monoid instance such that `fold`ing
96+-- >>> withoutLast [1, 2, 3, 4]
88−-- a list of `LastMonoid`s should return the last element
97+-- [1, 2, 3]
89--
98--
90−-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) [1, 2, 3]
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]
91−-- Just 3
110+-- Just 5
92--
111--
93−-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) []
112+-- >>> indexed 8 [6, 5, 4]
94-- Nothing
113-- Nothing
95−data LastMonoid a = LM (Maybe a)
114+indexed :: Natural -> [a] -> Maybe a
96−
115+indexed 0 (x:_) = Just x
97−instance Semigroup (LastMonoid a) where
116+indexed number [] = Nothing
98− x <> (LM Nothing) = x
117+indexed number (_:xs) = indexed (number-1) xs
99− _ <> x = x
100−
101−instance Monoid (LastMonoid a) where
102− mempty = LM Nothing
103−
104−-- Warps an `a` in a `LastMonoid`.
105−constructLastMonoid :: a -> LastMonoid a
106−constructLastMonoid = LM . Just
107−
108−-- Unwraps the `a` from a `LastMonoid`, if there is one.
109−destructLastMonoid :: LastMonoid a -> Maybe a
110−destructLastMonoid (LM x) = x
111−
112−-- _____ _ _ _ _
113−-- |_ _|__ __| | ___ | | (_)___| |_
114−-- | |/ _ \ / _` |/ _ \ | | | / __| __|
115−-- | | (_) | (_| | (_) | | |___| \__ \ |_
116−-- |_|\___/ \__,_|\___/ |_____|_|___/\__|
117−
118−-- Your task is to create a todo list backend, which supports adding tasks,
119−-- changing the priority of tasks, completing tasks, renaming tasks, and
120−-- displaying tasks as a list in order of descending priority.
121−
122−-- | The priority of a task.
123−data Priority = Low | Medium | High
124− deriving (Show, Eq, Ord)
125−
126−-- | The completion status of a task.
127−data Completion = Completed | NotCompleted
128− deriving (Show, Eq, Ord)
129−
130−class TaskManager t where
131− -- | Returns an empty task manager backend (it should have no tasks).
132− emptyTaskManager :: t
133−
134− -- | Gets the list of all tasks, sorted by priority in the order:
135− -- High, Medium, Low
136− --
137− -- Ordering of tasks with the same priority is not defined
138− -- (You can do whatever you want)
139− getPriorityList :: t -> [(Completion, Priority, String)]
140−
141− -- | Creates a new task with the given name and priority.
142− -- Tasks are uniquely identified by their name.
143− -- When a task is newly created its status should be 'NotCompleted'.
144− --
145− -- If there is already a task with the given name, then the
146− -- behavior is undefined. (You can do whatever you want)
147− createTask :: String -> Priority -> t -> t
148−
149− -- | Toggles a task with the given name.
150− -- If the task has the status 'Completed', then it would become 'NotCompleted'.
151− -- If the task has the status 'NotCompleted', then it would become 'Completed'.
152− --
153− -- Needless to say, toggling the same task twice should be
154− -- equivalent to not doing anything.
155− --
156− -- If there is no tasks with the given name, then it does nothing.
157− toggleTaskCompletion :: String -> t -> t
158−
159− -- | Removes the task with the given name.
160− -- If there isn't a task with the given name, then it does nothing.
161− removeTask :: String -> t -> t
162−
163− -- | Sets the priority of the task with the given name.
164− -- If there isn't a task with the given name, then it does nothing.
165− modifyPriority :: String -> Priority -> t -> t
166−
167− -- | Renames the task with the given name to have a new name.
168− -- The first argument is the old name, the second argument is the new name.
169− -- If there isn't a task with the given name, then it does nothing.
170− -- If the new name clashes with an existing task, then the
171− -- behavior is undefined. (You can do whatever you want)
172− renameTask :: String -> String -> t -> t
173−
174−-- The task manager you are creating.
175−data MyTaskManager = MTM (Map String (Completion, Priority))
176−
177−-- TODO: You have to make your 'MyTaskManager' an instance of
178−-- the 'TaskManager' typeclass.
179−instance TaskManager MyTaskManager where
180− emptyTaskManager = MTM empty
181−
182− getPriorityList (MTM mp) = sortBy(\(_, lhs, _) (_, rhs, _) -> compare rhs lhs) $ (\(name, (comp, pri)) -> (comp, pri, name)) <$> toList mp
183−
184− createTask :: String -> Priority -> MyTaskManager -> MyTaskManager
185− createTask name pri (MTM mp) = MTM $ insert name (NotCompleted, pri) mp
186−
187− toggleTaskCompletion name (MTM mp) = let
188− toggleTask (Completed, pri) = (NotCompleted, pri)
189− toggleTask (NotCompleted, pri) = (Completed, pri)
190− in
191− MTM $ update (Just . toggleTask) name mp
192−
193− removeTask name (MTM mp) = MTM $ delete name mp
194−
195− modifyPriority name newPri (MTM mp) = MTM $ update (\(comp, _) -> Just (comp, newPri)) name mp
196−
197− renameTask oldName newName (MTM mp) = let
198− mval = Data.Map.lookup oldName mp
199− mp1 = delete oldName mp
200− in
201− case mval of
202− Nothing -> MTM mp
203− Just val -> MTM $ insert newName val mp1
204−-- ____ __ __
205−-- / ___|___ / _|/ _| ___ ___
206−-- | | / _ \| |_| |_ / _ \/ _ \
207−-- | |__| (_) | _| _| __/ __/
208−-- \____\___/|_| |_| \___|\___|
209−--
210−-- /~~~~~~~~~~~~~~~~~~~/|
211−-- / /######/ / |
212−-- / /______/ / |
213−-- ========================= /||
214−-- |_______________________|/ ||
215−-- | \****/ \__,,__/ ||
216−-- |===\**/ __,,__ ||
217−-- |______________\====/%____||
218−-- | ___ /~~~~\ % / |
219−-- _| |===|=== / \%_/ |
220−-- | | |###| |########| | /
221−-- |____\###/______\######/__|/
222−-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
223−
224−-- | Just a typealias to make types more readable.
225−type RUBAmount = Integer
226−
227−-- | Represents a cup of coffee with extra ingredients added.
228−data Coffee
229− = Coffee
230− { -- | The price of the coffee itself
231− -- (without the cost of the extra ingredients.)
232− cost :: RUBAmount,
233− -- | The extra ingredients added to the coffee.
234− extras :: [CoffeeExtra]
235− }
236− deriving (Eq, Show)
237−
238−-- Extra ingredients added to the coffee.
239−data CoffeeExtra
240− = Cream
241− | AlmondMilk
242− | SoyMilk
243− | OatMilk
244− | Cinnamon
245− | WhiteSugar
246− | BrownSugar
247− deriving (Eq, Show)
248−
249−-- | A typeclass representing objects, for which the price can be calculated.
250−class HasPrice x where
251− -- | Calculated the price of the item.
252− price :: x -> RUBAmount
253−
254−-- I have already made a 'CoffeeExtra' an instance of 'HasPrice' for you.
255−-- You should use this in price calculations.
256−instance HasPrice CoffeeExtra where
257− price Cream = 50
258− price AlmondMilk = 70
259− price SoyMilk = 80
260− price OatMilk = 65
261− price Cinnamon = 20
262− price WhiteSugar = 15
263− price BrownSugar = 35
264
118
265−-- TODO: You want to make 'Coffee' an instance of 'HasPrice'.
119+-- Is an infinite list, alternating the sign of every other element.
266−instance HasPrice Coffee where
120+--
267− price x = (cost x) + getSum (foldMap (Sum . price) (extras x))
121+-- >>> alternating
268−
122+-- [1, -2, 3, -4, 5, -6, ...
269−-- | A debit card.
123+alternating :: [Integer]
270−-- Note: the balance can be negative.
124+alternating = cut rising
271−data DebitCard
125+ where
272− = DebitCard
126+ cut (x1:x2:xs) = x1:(-x2):cut xs
273− { balance :: RUBAmount,
127+ rising = 1 : map (+ 1) rising
274− cardId :: Int
128+-- ____ _ _
275− }
129+-- | __ )(_)_ __ __ _ _ __ _ _ | |_ _ __ ___ ___
276− deriving (Eq, Show)
130+-- | _ \| | '_ \ / _` | '__| | | | | __| '__/ _ \/ _ \
277−
131+-- | |_) | | | | | (_| | | | |_| | | |_| | | __/ __/
278−-- | Given a coffee and a debit card, deduce the total price of the coffee from
132+-- |____/|_|_| |_|\__,_|_| \__, | \__|_| \___|\___|
279−-- the debit card. Return the given debit card with the reduced balance.
133+-- |___/
280−--
134+
281−-- If the balance of the debit card after deducing the price of the coffee
135+-- In this section you will implement what essentially is the Set from the
282−-- would become negative, return 'Nothing' from the function.
136+-- standard library. If you literally open the source code of the standard
283−chargeCoffee :: Coffee -> DebitCard -> Maybe DebitCard
137+-- library, it should look extremely similar to what you are doing here.
284−chargeCoffee coffee card
138+
285− | price coffee <= balance card = Just card {balance=balance card - price coffee}
139+-- Define a binary tree structure.
286− | otherwise = Nothing
287−
288−-- | How was the coffee charged.
289−data PaymentMethod
290− = -- | The coffee was charged using a debit card.
291− Card
292− { -- | The debit card with the balance deduced.
293− chargedCard :: DebitCard
294− }
295− | -- | The coffee was charged with cash.
296− Cash
297− { -- | The leftover money from the payment.
298− -- (We assume that the person pays with all of the cash he has.)
299− change :: RUBAmount
300− }
301− deriving (Eq, Show)
302−
303−-- | Represents a coffee shop customer with all of the money he has on him.
304−data Customer
305− = Customer
306− { -- | All of the debit hards the person has on him.
307− -- Sorted in order of descending preference.
308− -- (He would prefer to use the first card in the list.)
309− cards :: [DebitCard],
310− -- | The amount of cash the customer has on him.
311− cash :: RUBAmount
312− }
313− deriving (Eq, Show)
314−
315−-- You have some new privacy-invading piece of ... technology, which
316−-- automatically scans the customer, determines how he would prefer to pay and
317−-- charges him automatically.
318−
319−-- | This function determines how the given customer would prefer to pay for the
320−-- coffee he wants.
321−--
322−-- The customer would always prefer to pay with a debit card if it is possible.
323−-- The customer has a strict preference in the cards he carries with him:
324−-- he would always like to pay with the first card in his wallet (the list). If
325−-- the first card doesn't have enough money on it, then he would prefer to use
326−-- the second card, and so on.
327−--
328−-- If non of the cards have enough balance to cover the coffee, then the
329−-- customer will have to pay in cash.
330−--
331−-- NOTE: The customer can only buy a coffee with strictly one payment method.
332−-- (Only one card or cash)
333−payForCoffee :: Customer -> Coffee -> Maybe PaymentMethod
334−payForCoffee customer coffee =
335− let checkCard = chargeCoffee coffee
336− goodCards :: Maybe PaymentMethod
337− goodCards = fmap Card $ listToMaybe $ mapMaybe checkCard (cards customer)
338− cashOption = if cash customer >= price coffee then
339− Just $ Cash (cash customer - price coffee)
340− else
341− Nothing
342− in goodCards <|> cashOption
343−
344−-- | This function should apply the chosen payment method to the customer.
345−-- In other words, it needs to apply the charge to the customer himself
346−-- (update the debit card or update the amount of cash he currently has)
347−--
348−-- If the specified card is not present in the 'Customer' structure, then
349−-- do nothing.
350−--
140+--
351−-- NOTE: You can not change the order of the cards.
141+-- This is a wiki page, but you probably shouldn't open it:
352−applyPayment :: Customer -> PaymentMethod -> Customer
142+-- https://en.wikipedia.org/wiki/Binary_tree
353−applyPayment customer paymentMethod =
354− case paymentMethod of
355− Cash change -> customer {cash = change }
356− Card chargedCard ->
357− let newCards = fmap (\card -> if cardId card == cardId chargedCard then chargedCard else card ) $ cards customer
358− in customer {cards = newCards}
359−
360−
361−-- | Performs the full payment (as in 'payForCoffee') and
362−-- returns the modified customer (as in 'applyPayment').
363−buyCoffee :: Customer -> Coffee -> Maybe Customer
364−buyCoffee customer coffe =
365− let maybePaymentMethod = payForCoffee customer coffe in
366− fmap (applyPayment customer) maybePaymentMethod
367−
368−
369−-- | You know that due to a medical condition the customer needs to watch his
370−-- sugar intake. The new privacy-invading piece of ... technology can now
371−-- automatically apply filters to coffee orders.
372−--
143+--
373−-- You have to make a filter, which removes any occurrences of sugar
144+-- Hint: a tree is either:
374−-- (either WhiteSugar or BrownSugar) from the ordered cups of coffee and
145+-- 1. the end of the tree (an empty node with no elements)
375−-- return the filtered orders and the amount of money the customer saves by
146+-- (it should literally contain nothing)
376−-- being healthy (sugar costs money after all). So, you also have to count how
147+-- 2. a node which contains an element and two branches (left and right).
377−-- much the total sugar would have cost.
148+-- (in this context a 'branch' and a 'tree' is the same thing)
378−--
149+--
379−-- NOTE: You can not change the order of the coffee.
150+-- In case you didn't get it, a tree should have two constructors.
380−saveTheDiabetic :: [Coffee] -> (RUBAmount, [Coffee])
151+data Tree a = Branch a (Tree a) (Tree a) | EmptyBranch
381−saveTheDiabetic coffeeList =
152+ deriving (Show, Eq)
382− let isSugar = (`elem` [WhiteSugar, BrownSugar])
153+
383− sugarPrice extra = if isSugar extra then price extra else 0
154+instance Functor Tree where
384− savedMonney = foldl (\savedMonney coffee -> savedMonney + (sum $ fmap sugarPrice $ extras coffee))
155+ fmap _ EmptyBranch = EmptyBranch
385− 0 coffeeList
156+ fmap f (Branch b leftb rightb) = Branch (f b) (fmap f leftb) (fmap f rightb)
386− coffeesWithoutSugar = fmap (\coffee -> coffee {extras = filter (not . isSugar) $ extras coffee} ) coffeeList
157+
387− in (savedMonney, coffeesWithoutSugar)
158+instance Arbitrary a => Arbitrary (Tree a) where
388−
159+ arbitrary = oneof [
389−
160+ pure EmptyBranch,
390−-- | And just to torment those who love sugar lets make a function which
161+ do
391−-- calculates health hazard (sugar content) of the given orders.
162+ a <- arbitrary
392−--
163+ lbr <- arbitrary
393−-- The only ingredient that elevates the danger level is, of course, sugar:
164+ rbr <- arbitrary
394−--
165+ return (Branch a lbr rbr)
395−-- WhiteSugar: 2 extra danger points
166+ ]
396−-- BrownSugar: 1 extra danger point
167+
397−calculateSugarDanger :: [Coffee] -> Int
168+
398−calculateSugarDanger coffeeList = sum $ fmap (
169+-- ^ Don't worry about this 'deriving' business. It is needed for tests
399− \extra -> case extra of
170+-- to compile. It will be explained later.
400− WhiteSugar -> 2
171+
401− BrownSugar -> 1
172+-- This next function is contrived but we need this since you can define
402− _ -> 0) (coffeeList >>= extras)
173+-- constructors however you want.
403−
174+-- If you have trouble with this one, don't hesitate to ask for help.
404−-- (>>=) :: m a -> (a -> m b) -> m b
175+--
405−-- (>>=) :: [a] -> (a -> [b]) -> [b]
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.
296+--
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.
299+--
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
310+--
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
323+--
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
338+--
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
353+--
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.
362+--
363+-- >>> insertAll [1, 2, 3] <empty tree>
364+-- 1
365+-- \
366+-- 2
367+-- \
368+-- 3
369+--
370+-- >>> insertAll [2, 3, 1] <empty tree>
371+-- 2
372+-- / \
373+-- 1 3
374+--
375+-- >>> insertAll [3, 2, 1] <empty tree>
376+-- 3
377+-- /
378+-- 2
379+-- /
380+-- 1
381+--
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
seminars/1/stack.yaml+2−2
@@ -1,7 +1,7 @@
1−resolver: lts-22.6
1+resolver: nightly-2024-10-11
2
2
3packages:
3packages:
4- .
4- .
5
5
6ghc-options:
6ghc-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
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
seminars/1/task.cabal+12−7
@@ -1,10 +1,10 @@
1cabal-version: 2.2
1cabal-version: 2.2
2
2
3−-- This file has been generated from package.yaml by hpack version 0.36.0.
3+-- This file has been generated from package.yaml by hpack version 0.37.0.
4--
4--
5-- see: https://github.com/sol/hpack
5-- see: https://github.com/sol/hpack
6--
6--
7−-- hash: 781190f5d43564d9d73aa8b8a85a99c3d859a931a6ca644dadf871a105221b10
7+-- hash: 1b0c813b975b6ea7c4b067f19ac27bf2fff67bb285ba03838c6f210bd92d4acc
8
8
9name: task
9name: task
10version: 0.1.0.0
10version: 0.1.0.0
@@ -20,9 +20,11 @@ library
20 Paths_task
20 Paths_task
21 hs-source-dirs:
21 hs-source-dirs:
22 src
22 src
23+ default-extensions:
24+ EmptyDataDeriving
23 build-depends:
25 build-depends:
26+ QuickCheck
24− base >=4.7 && <5
27+ , base >=4.7 && <5
25− , containers
26 default-language: Haskell2010
28 default-language: Haskell2010
27
29
28test-suite task-tests
30test-suite task-tests
@@ -35,10 +37,13 @@ test-suite task-tests
35 Paths_task
37 Paths_task
36 hs-source-dirs:
38 hs-source-dirs:
37 test
39 test
40+ default-extensions:
41+ EmptyDataDeriving
38 build-depends:
42 build-depends:
43+ QuickCheck
39− base >=4.7 && <5
44+ , base >=4.7 && <5
40− , containers
45+ , hspec
41 , task
46 , task
42 , tasty
47 , tasty
43− , tasty-hunit
48+ , tasty-hspec
44 default-language: Haskell2010
49 default-language: Haskell2010
seminars/1/test/Main.hs+6−1
@@ -4,7 +4,12 @@ module Main
4where
4where
5
5
6import Test.Tasty
6import Test.Tasty
7+import Test.Tasty.Hspec
7import Tests
8import Tests
8
9
9main :: IO ()
10main :: IO ()
11+main = do
12+ tests' <- testSpecs tests
10−main = defaultMain tests
13+ defaultMain
14+ ( testGroup "tests" tests'
15+ )
seminars/1/test/Tests.hs+85−432
@@ -3,437 +3,90 @@ module Tests
3 )
3 )
4where
4where
5
5
6−import Data.Foldable
7−import Data.Function
8−import Data.List
9import Task
6import Task
10−import Test.Tasty
7+import Test.Hspec
11−import Test.Tasty.HUnit
12
8
13−tests :: TestTree
9+tests :: Spec
14−tests = testGroup "Tests"
10+tests = do
15− [ testGroup "List Monoids"
11+ it "regroup" $ do
16− [ testCase "FirstMonoid" $ do
12+ regroup (1 :: Int, (2 :: Int, 3 :: Int)) `shouldBe` (2, 1, 3)
17− let getFirst = destructFirstMonoid . fold . fmap constructFirstMonoid
13+ regroup ("1", ("2", "3")) `shouldBe` ("2", "1", "3")
18− getFirst [1 :: Int, 2, 3] @=? Just 1
14+ regroup (True, (False, True)) `shouldBe` (False, True, True)
19− getFirst [] @=? (Nothing :: Maybe ())
15+ it "safeHead" $ do
20− getFirst [True, False] @=? Just True
16+ safeHead [1 :: Int, 2, 3] `shouldBe` Just 1
21− getFirst [True, True, False] @=? Just True
17+ safeHead [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 1294
22− getFirst [1 .. 1000] @=? Just (1 :: Int)
18+ safeHead [] `shouldBe` (Nothing :: Maybe ())
23− getFirst [100 .. 1000] @=? Just (100 :: Int)
19+ it "safeLast" $ do
24− getFirst [6, 2, 7, 398, 1984, 383, -1020] @=? Just (6 :: Int)
20+ safeLast [1 :: Int, 2, 3] `shouldBe` Just 3
25− , testCase "LastMonoid" $ do
21+ safeLast [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 9
26− let getLast = destructLastMonoid . fold . fmap constructLastMonoid
22+ safeLast [] `shouldBe` (Nothing :: Maybe ())
27− getLast [1 :: Int, 2, 3] @=? Just 3
23+ it "withoutLast" $ do
28− getLast [] @=? (Nothing :: Maybe ())
24+ withoutLast [1 :: Int, 2, 3] `shouldBe` [1, 2]
29− getLast [1 .. 1000] @=? Just (1000 :: Int)
25+ withoutLast [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` [1294, 2, 3, 4, 5, 6, 7, 7]
30− getLast [100 .. 10000] @=? Just (10000 :: Int)
26+ withoutLast [] `shouldBe` ([] :: [()])
31− getLast [6, 2, 7, 398, 1984, 383, -1020, 498] @=? Just (498 :: Int)
27+ it "indexed" $ do
32− getLast [True, False] @=? Just False
28+ indexed 2 [1 :: Int, 2, 3] `shouldBe` Just 3
33− getLast [True, True, False] @=? Just False
29+ indexed 0 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 1294
34− getLast [True, True, False, True] @=? Just True
30+ indexed 1080 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Nothing
35− ]
31+ indexed 4 [1294 :: Int, 2, 3, 4, 5, 6, 7, 7, 9] `shouldBe` Just 5
36− , testGroup "Todo List" $
32+ indexed 0 [] `shouldBe` (Nothing :: Maybe ())
37− let createTasks :: [(String, Priority)] -> MyTaskManager
33+ indexed 297 [] `shouldBe` (Nothing :: Maybe ())
38− createTasks = foldl (\t (a, b) -> createTask a b t) emptyTaskManager
34+ it "alternating" $ do
39− getPrioritySets :: MyTaskManager -> [[(Completion, String)]]
35+ take 10 alternating `shouldBe` [1, -2, 3, -4, 5, -6, 7, -8, 9, -10]
40− getPrioritySets =
36+ alternating !! 42 `shouldBe` 43
41− fmap (sort . fmap (\(a, _, b) -> (a, b)))
37+ alternating !! 69 `shouldBe` -70
42− . groupBy ((==) `on` (\(_, p, _) -> p))
38+ alternating !! 420 `shouldBe` 421
43− . getPriorityList
39+ it "leftmost" $ do
44− in
40+ (leftmost . constructTree) [1 :: Int, 2, 3, 4, 5] `shouldBe` Just 4
45− [ testCase "emptyTaskManager" $
41+ (leftmost . constructTree) [1 :: Int, 2, 3, 4] `shouldBe` Just 4
46− getPriorityList (emptyTaskManager :: MyTaskManager) @=? []
42+ (leftmost . constructTree) [1 :: Int, 2, 3, 99, 5] `shouldBe` Just 99
47− , testCase "createTask" $ do
43+ (leftmost . constructTree) [8 :: Int, 7, 6, 5, 4, 1, 2, 3, 4, 5] `shouldBe` Just 3
48− getPrioritySets
44+ it "rightmost" $ do
49− ( createTasks
45+ (rightmost . constructTree) [1 :: Int, 2, 3, 4, 5] `shouldBe` Just 3
50− [ ("a", Low),
46+ (rightmost . constructTree) [1 :: Int, 2, 3, 4] `shouldBe` Just 3
51− ("aaa", Medium),
47+ (rightmost . constructTree) [1 :: Int, 2, 99, 5, 5] `shouldBe` Just 99
52− ("AAAAAAAAAA", High)
48+ (rightmost . constructTree) [8 :: Int, 7, 6, 5, 4, 1, 2, 3, 4, 5] `shouldBe` Just 2
53− ]
49+ it "treeSum" $ do
54− )
50+ (treeSum . constructTree) [1, 2, 3, 4, 5] `shouldBe` sum [1, 2, 3, 4, 5]
55− @=? [ [(NotCompleted, "AAAAAAAAAA")],
51+ (treeSum . constructTree) [1, 2, 3, 4] `shouldBe` sum [1, 2, 3, 4]
56− [(NotCompleted, "aaa")],
52+ (treeSum . constructTree) [1, 2, 3, 5, 99] `shouldBe` sum [1, 2, 3, 5, 99]
57− [(NotCompleted, "a")]
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]
58− ]
54+ (treeSum . constructTree . take 100) [5 ..] `shouldBe` (sum . take 100) [5 ..]
59− getPrioritySets
55+ (treeSum . constructTree . take 100) [2 ..] `shouldBe` (sum . take 100) [2 ..]
60− ( createTasks
56+ it "treeSize" $ do
61− [ ("a", Low),
57+ let test list = treeSize (constructTree list) `shouldBe` fromIntegral (length list)
62− ("AAAAAAAAAA", High)
58+ test $ replicate 11 ()
63− ]
59+ test $ replicate 16 (8 :: Int)
64− )
60+ test [5, 2, 5, 7, 7, 3, 2, 7, 7 :: Int]
65− @=? [ [(NotCompleted, "AAAAAAAAAA")],
61+ it "insert" $ do
66− [(NotCompleted, "a")]
62+ constructTree [1 :: Int] `shouldNotBe` constructTree [1, 2]
67− ]
63+ constructTree [1 :: Int] `shouldNotBe` constructTree []
68− getPrioritySets
64+ (insert 3 . insert 1 . insert 2 . constructTree) [] `shouldBe` constructTree [2, 1, 3]
69− ( createTasks
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]
70− [ ("a", Low),
66+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
71− ("AAAAAAAAAA", High),
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]
72− ("aaa", Medium),
68+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
73− ("oh HaiMark", Medium)
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]
74− ]
70+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
75− )
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]
76− @=? [ [(NotCompleted, "AAAAAAAAAA")],
72+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
77− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
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]
78− [(NotCompleted, "a")]
74+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
79− ]
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]
80− getPrioritySets
76+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
81− ( createTasks
77+ it "insertAll" $ do
82− [ ("a", Low),
78+ constructTree [1 :: Int] `shouldNotBe` constructTree [1, 2]
83− ("AAAAAAAAAA", High),
79+ constructTree [1 :: Int] `shouldNotBe` constructTree []
84− ("aaa", Medium),
80+ (insertAll [2, 3, 1] . constructTree) [] `shouldBe` constructTree [2, 1, 3]
85− ("oh HaiMark", Medium),
81+ (insertAll [71, 65, 56, 54, 45, 35, 15, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
86− ("OH NO", High)
82+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
87− ]
83+ (insertAll [71, 54, 45, 35, 15, 65, 56, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
88− )
84+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
89− @=? [ [(NotCompleted, "AAAAAAAAAA"), (NotCompleted, "OH NO")],
85+ (insertAll [35, 15, 65, 71, 54, 45, 56, 5] . constructTree) [50, 30, 60, 10, 55, 40, 70]
90− [(NotCompleted, "aaa"), (NotCompleted, "oh HaiMark")],
86+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
91− [(NotCompleted, "a")]
87+ (insertAll [35, 54, 45, 56, 5, 15, 65, 71] . constructTree) [50, 30, 60, 10, 55, 40, 70]
92− ]
88+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
93− , testCase "toggleTaskCompletion" $ do
89+ (insertAll [56, 5, 15, 65, 35, 54, 45, 71] . constructTree) [50, 30, 60, 10, 55, 40, 70]
94− getPrioritySets
90+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
95− ( toggleTaskCompletion "AAAAAAAAAA" . createTasks $
91+ (insertAll [56, 5, 15, 65, 35, 54, 45, 71, 5, 56, 35] . constructTree) [50, 30, 60, 10, 55, 40, 70]
96− [ ("a", Low),
92+ `shouldBe` constructTree [50, 30, 60, 10, 55, 40, 70, 5, 54, 35, 65, 15, 56, 45, 71]
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/.gitignoredeleted−28
@@ -1,28 +0,0 @@
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
seminars/2/README.mddeleted−138
@@ -1,138 +0,0 @@
1−# Mathematical expression interpreter
2−
3−Your task is to:
4−1. Write monadic parsing combinators
5−2. Define a structure to represent a parsed mathematical expression in Haskell
6−3. Write a parser, which parses a string into the structure
7−4. Write an interpreter for the structure, which performs the calculation and returns the result.
8−
9−**NOTE: the parser and interpreter should be independent.**
10−
11−You will have to handle division by zero errors.
12−
13−## The basic expression
14−
15−### Formal Definition
16−
17−Note that the expressions can be nested arbitrarily deeply.
18−
19−Also note, that a number can only be an integer.
20−
21−The `/` operator is integer division truncated towards negative infinity (`div` in Haskell).
22−
23−```bnf
24−<expression> ::= <number> | <operation>
25−
26−<number> ::= "-" <digits> | <digits>
27−
28−<digits> ::= <digit> | <digit> <digits>
29−<digit> ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
30−
31−<operation> ::= "(" <spaces> <expression> <spaces> <operator> <spaces> <expression> <spaces> ")"
32−
33−<operator> ::= "+" | "-" | "*" | "/"
34−
35−<spaces> ::= "" | " " <spaces>
36−```
37−
38−### Examples
39−
40−These all represent valid expressions:
41−
42−- `((1 + 2) * 3)`
43−- `1`
44−- `(((1 + 2) *3) +(1 + 1) )`
45−
46−### Minimal required combinators
47−
48−This combinator should read and return exactly one character from the input.
49−If there are no characters to read from the input, then it should fail.
50−
51−```haskell
52−anyToken :: Parser Char
53−```
54−
55−This combinator should read and return exactly one character from the input.
56−If the character does not match the given character, then it should fail.
57−
58−```haskell
59−token :: Char -> Parser ()
60−```
61−
62−This combinator should read a string of charracters. If the string does not match the given string then fail.
63−
64−```haskell
65−tokens :: String -> Parser ()
66−```
67−
68−This character reads any number of consecutive characters, which stisfy the predicate. So this can never fail.
69−
70−```haskell
71−tokensWhile :: (Char -> Bool) -> Parser String
72−```
73−
74−This character reads any number (but at least one) of consecutive characters, which stisfy the predicate. This can only fail if the first character does not satisfy the predicate.
75−
76−```haskell
77−tokensWhile1 :: (Char -> Bool) -> Parser String
78−```
79−
80−### Simple example
81−
82−A sample parser might look something like this
83−
84−```haskell
85−number :: Parser Int
86−number = do
87− sign <- signParser
88− digits <- digitsParser
89− return (read (sign <> digits))
90−```
91−
92−### Control
93−
94−The proposed approach of handling control is using the `Alternative` typeclass.
95−
96−The instance for `[]` already provides the following behavior:
97−
98−`empty` represents a failure (no values).
99−
100−`<|>` represents parsing alternative. For example an expression can be either an operation or a number.
101−
102−## Complex expressions
103−
104−This is a slightly more complex version of expressions -- it includes conditional expressions
105−
106−This represents the new parts:
107−
108−```bnf
109−<expression> ::= <number> | <operation> | <conditional>
110−
111−<conditional> ::= "if " <spaces> <bool_expression> <spaces> " then " <spaces> <expression> <spaces> " else " <spaces> <expression>
112−
113−<bool_expression> ::= "(" <spaces> <expression> <spaces> <bool_operator> <spaces> <expression> <spaces> ")"
114−
115−<bool_operator> = "=" | "<" | ">" | "<=" | ">="
116−```
117−
118−### Examples
119−
120−These all represent valid expressions:
121−
122−- `if ( 1 = 2 ) then (2 + 4) else 2`
123−- `(((1 + 2) *3) +( if ( 1 = 2 ) then (2 + 4) else 2 + 1))`
124−
125−## Artifacts
126−
127−You should export the `calculate` function, which should parse the given string and return the computed result. If any of the steps involved fail (couldn't parse the string or there was a divide by zero error), you should return `Nothing`.
128−
129−```haskell
130−calculate :: String -> Maybe Int
131−```
132−
133−## Libraries you can use
134−
135−You can use these two libraries:
136−- `base`
137−- `mtl`
138−
seminars/2/package.yaml+2−3
@@ -4,8 +4,7 @@ license: Unlicense
4
4
5dependencies:
5dependencies:
6 - base >= 4.7 && < 5
6 - base >= 4.7 && < 5
7− - mtl
7+ - random
8− - QuickCheck
9
8
10library:
9library:
11 source-dirs: src
10 source-dirs: src
@@ -16,5 +15,5 @@ tests:
16 main: Main.hs
15 main: Main.hs
17 dependencies:
16 dependencies:
18 - tasty
17 - tasty
19− - task
20 - tasty-hunit
18 - tasty-hunit
19+ - task
seminars/2/src/Task.hs+391−183
@@ -1,190 +1,398 @@
1−{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE InstanceSigs #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5module Task
1module Task
6− ( calculate,
2+ ( -- * List Monoids
7− Expr(..),
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
8 )
31 )
9where
32where
10
33
11−import Control.Applicative
34+import System.Random
12−import Control.Monad.State.Lazy
13−import Data.Char
14−import Data.Maybe
15−import Test.QuickCheck
16−import Text.Read
17−import Debug.Trace
18import Control.Monad
35import Control.Monad
19
36
20−type ParsingResult a = Either String (a, String)
37+newtype State m s a = State { runState :: s -> (s, m a) }
21−
38+newtype Reader m s a = Reader { runReader :: s -> m a }
22−-- Parser :: Type -> Type
39+type Foo s s' a = State (Reader Identity s') s a
23−newtype Parser a = Parser (String -> ParsingResult a)
40+
24− deriving Functor
41+instance Functor (State s) where
25−
42+ -- fmap :: (a -> b) -> functor a -> functor b
26−instance Applicative Parser where
43+ fmap f (State g) = State (\s -> let (s', a) = g s in (s', f a))
27− pure :: a -> Parser a
44+ -- fmap f (State g) = State (fmap (fmap f) g)
28− pure x = Parser (\q -> Right (x, q))
45+
29−
46+instance Applicative (State s) where
30− (<*>) :: Parser (a -> b) -> Parser a -> Parser b
47+ pure a = State (\s -> (s, a))
31− (<*>)
48+ (<*>) = ap
32− (Parser (e :: String -> ParsingResult (a -> b)))
49+
33− (Parser (x :: String -> ParsingResult a)) = Parser (\s ->
34− case e s of
35− Left err -> Left err
36− Right (arr, sLeft) -> case x sLeft of
37− Left err2 -> Left err2
38− Right (resOfTypeA, sLeft2) -> Right (arr resOfTypeA, sLeft2))
39−
40−instance Monad Parser where
50+instance Monad (State s) where
41− return :: a -> Parser a
51+ -- (>>=) :: State s a -> (a -> State s b) -> State s b
42− return = pure
52+ State g >>= f = State $ \s -> let (s', a) = g s in
43−
53+ let State h = f a in
44− (>>=) :: Parser a -> (a -> Parser b) -> Parser b
54+ h s'
45− (>>=) (Parser x) e = Parser (\s ->
55+
46− case x s of
56+get :: State s s
47− Left err -> Left err
57+get = State (\s -> (s, s))
48− Right (a, s1) -> case e a of
58+
49− Parser f -> f s1
59+put :: s -> State s ()
50− )
60+put s = State (\_ -> (s, ()))
51−
61+
52−instance MonadFail Parser where
62+stRandom :: Random a => State StdGen a
53− fail :: String -> Parser a
63+stRandom = do
54− fail err = Parser . const . Left $ err
64+ s <- get
55−
65+ let (r, s') = random s
56−instance Alternative Parser where
66+ put s'
57− empty :: Parser a
67+ return r
58− empty = Parser . const . Left $ "I'm empty"
68+
59−
69+runStRandom :: State StdGen a -> a
60− (Parser left) <|> (Parser right) = Parser $ \s -> case (left s, right s) of
70+runStRandom (State g) = snd (g (mkStdGen 8))
61− (Right res, _) -> Right res
71+
62− (Left _, Right res) -> Right res
72+genStIntDouble :: State StdGen (Int, Double)
63− (Left err1, Left err2) -> Left $ "Both alternatives failed: 1) " ++ err1 ++ "\n2:" ++ err2
73+genStIntDouble = do
64−
74+ int <- stRandom
65−anyToken :: Parser Char
75+ double <- stRandom
66−anyToken = Parser $ \s -> case s of
76+ return (int, double)
67− "" -> Left "Empty String"
77+
68− (hd: tl) -> Right (hd, tl)
78+foo :: State StdGen [(Int, Double)]
69−
79+foo = sequenceA [genStIntDouble, genStIntDouble]
70−eos :: Parser ()
80+
71−eos = Parser $ \s -> case s of
81+-- fold [] = mempty
72− "" -> Right ((), "")
82+-- fold (x: xs) = x <> fold xs
73− s -> Left $ "unexpected trailing content: " ++ s
83+
74−
84+-- _ _ _ __ __ _ _
75−token :: Char -> Parser ()
85+-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
76−-- token expected = Parser $ \s -> case s of
86+-- | | | / __| __| | |\/| |/ _ \| '_ \ / _ \| |/ _` / __|
77−-- "" -> Left "Empty String"
87+-- | |___| \__ \ |_ | | | | (_) | | | | (_) | | (_| \__ \
78−-- (hd: tl) -> if hd == expected then Right ((), tl) else Left $
88+-- |_____|_|___/\__| |_| |_|\___/|_| |_|\___/|_|\__,_|___/
79−token expected = do
89+
80− actual <- anyToken
90+-- Write a datatype and a Monoid instance for it such that:
81− when (actual /= expected) $ fail $ "expected " ++ [expected] ++ ", got " ++ [actual]
91+--
82−-- when :: Applicative f => Bool -> f () -> f ()
92+-- (destructFirstMonoid . fold . fmap constructFirstMonoid) == safeHead
83−
93+--
84−tokens :: String -> Parser ()
94+-- (constructFirstMonoid and destructFirstMonoid would wrap and
85−tokens "" = pure ()
95+-- unwrap the `FirstMonoid`)
86−tokens (c: cs) = do
96+--
87− token c
97+-- In other words, it needs to have a monoid instance such that `fold`ing
88− tokens cs
98+-- a list of `FirstMonoid`s should return the first element
89−
99+--
90−-- "x"
100+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) [1, 2, 3]
91−-- u <- tokensWhile (== 'a')
101+-- Just 1
92−
102+--
93−tokensWhile :: (Char -> Bool) -> Parser String
103+-- >>> (destructFirstMonoid . fold . fmap constructFirstMonoid) []
94−-- tokensWhile e = (do
104+-- Nothing
95−-- char <- anyToken
105+data FirstMonoid a = FirstMonoid (Maybe a)
96−-- str <- if e char then tokensWhile e else empty
106+
97−-- pure (char:str)) <|> (pure "")
107+-- class Semigroup a where
98−-- tokensWhile e = (do
108+-- (<>) :: a -> a -> a
99−-- char <- anyToken
109+
100−-- str <- if e char then tokensWhile e else empty
110+-- instance Semigroup [a] where
101−-- pure (char:str)) <|> (pure "")
111+-- [] <> xs = xs
102−
112+-- (x : xs) <> ys = x (xs <> ys)
103−tokensWhile e = tokensWhile1 e <|> pure ""
113+
104−
114+instance Semigroup (FirstMonoid a) where
105−tokensWhile1 :: (Char -> Bool) -> Parser String
115+ FirstMonoid Nothing <> a = a
106−tokensWhile1 e = do
116+ FirstMonoid (Just a) <> _ = FirstMonoid (Just a)
107− char <- anyToken
117+
108− -- traceShowM char
118+instance Monoid (FirstMonoid a) where
109− str <- if e char then tokensWhile e else empty
119+ mempty = FirstMonoid Nothing
110− pure (char:str)
120+
111−
121+-- Warps an `a` in a `FirstMonoid`.
112−-- isDigit :: Char -> Bool
122+constructFirstMonoid :: a -> FirstMonoid a
113−
123+constructFirstMonoid a = FirstMonoid (Just a)
114−-- TODO: add negative numbers
124+
115−number:: Parser Int
125+-- Unwraps the `a` from a `FirstMonoid`, if there is one.
116−number = do
126+destructFirstMonoid :: FirstMonoid a -> Maybe a
117− chars <- tokensWhile1 isDigit
127+destructFirstMonoid (FirstMonoid a) = a
118− case readMaybe chars of
128+
119− Just res -> return res
129+-- Write a datatype and a Monoid instance for it such that:
120− Nothing -> fail $ "unexpected invalid number: '" ++ chars ++ "'"
130+--
121−
131+-- (destructLastMonoid . fold . fmap constructLastMonoid) == safeLast
122−data Expr
132+--
123− = Num Int
133+-- (constructLastMonoid and destructLastMonoid would wrap and
124− | AddExpr Expr Expr
134+-- unwrap the `LastMonoid`)
125− | MulExpr Expr Expr
135+--
126− | SubExpr Expr Expr
136+-- In other words, it needs to have a monoid instance such that `fold`ing
127− | DivExpr Expr Expr
137+-- a list of `LastMonoid`s should return the last element
128− deriving Show
138+--
129−
139+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) [1, 2, 3]
130−half :: Gen a -> Gen a
140+-- Just 3
131−half = scale (`div` 2)
141+--
132−
142+-- >>> (destructLastMonoid . fold . fmap constructLastMonoid) []
133−instance Arbitrary Expr where
143+-- Nothing
134− arbitrary = do
144+data LastMonoid a = LastMonoid (Maybe a)
135− size <- getSize
145+
136− case size of
146+instance Semigroup (LastMonoid a) where
137− 0 -> Num <$> arbitrary
147+ a <> LastMonoid Nothing = a
138− otherwise ->
148+ _ <> LastMonoid (Just a) = LastMonoid (Just a)
139− oneof [
149+
140− Num <$> arbitrary,
150+
141− AddExpgr <$> half arbitrary <*> half arbitrary,
151+instance Monoid (LastMonoid a) where
142− SubExpr <$> half arbitrary <*> half arbitrary,
152+ mempty = LastMonoid Nothing
143− MulExpr <$> half arbitrary <*> half arbitrary,
153+
144− DivExpr <$> half arbitrary <*> half arbitrary
154+-- Warps an `a` in a `LastMonoid`.
145− ]
155+constructLastMonoid :: a -> LastMonoid a
146−
156+constructLastMonoid a = LastMonoid (Just a)
147−parse :: Parser Expr
157+
148−parse = Num <$> number <|> (do
158+-- Unwraps the `a` from a `LastMonoid`, if there is one.
149− token '('
159+destructLastMonoid :: LastMonoid a -> Maybe a
150− tokensWhile isSpace
160+destructLastMonoid (LastMonoid a) = a
151− expr1 <- parse
161+
152− tokensWhile isSpace
162+-- _____ _ _ _ _
153− operator <- anyToken
163+-- |_ _|__ __| | ___ | | (_)___| |_
154− tokensWhile isSpace
164+-- | |/ _ \ / _` |/ _ \ | | | / __| __|
155− expr2 <- parse
165+-- | | (_) | (_| | (_) | | |___| \__ \ |_
156− tokensWhile isSpace
166+-- |_|\___/ \__,_|\___/ |_____|_|___/\__|
157− token ')'
167+
158− case operator of
168+-- Your task is to create a todo list backend, which supports adding tasks,
159− '+' -> return $ AddExpr expr1 expr2
169+-- changing the priority of tasks, completing tasks, renaming tasks, and
160− '*' -> return $ MulExpr expr1 expr2
170+-- displaying tasks as a list in order of descending priority.
161− '-' -> return $ SubExpr expr1 expr2
171+
162− '/' -> return $ DivExpr expr1 expr2
172+-- | The priority of a task.
163− _ -> fail "unknown operator"
173+data Priority = Low | Medium | High
164− )
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"
165
389
166−parseFull :: Parser Expr
390+-- | And just to torment those who love sugar lets make a function which
167−parseFull = do
391+-- calculates health hazard (sugar content) of the given orders.
168− e <- parse
392+--
169− eos
393+-- The only ingredient that elevates the danger level is, of course, sugar:
170− return e
394+--
171−
395+-- WhiteSugar: 2 extra danger points
172−evaluate :: Expr -> Maybe Int
396+-- BrownSugar: 1 extra danger point
173−evaluate (Num x) = Just x
397+calculateSugarDanger :: [Coffee] -> Int
174−evaluate (AddExpr left right) = (+) <$> (evaluate left) <*> (evaluate right)
398+calculateSugarDanger = error "TODO: calculateSugarDanger"
175−evaluate (MulExpr left right) = (*) <$> (evaluate left) <*> (evaluate right)
176−evaluate (SubExpr left right) = (-) <$> (evaluate left) <*> (evaluate right)
177−evaluate (DivExpr _ right) | evaluate right == Just 0 = Nothing
178−evaluate (DivExpr left right) = div <$> (evaluate left) <*> (evaluate right)
179−
180−
181−runParser :: Parser x -> String -> Maybe x
182−runParser (Parser parser_fun) context =
183− case parser_fun context of
184− Left msg -> trace msg Nothing
185− Right (x, _) -> Just x
186−
187−calculate :: String -> Maybe Int
188−calculate s = do
189− expression <- runParser parseFull s
190− evaluate expression
seminars/2/stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-22.6
1+resolver: nightly-2024-10-11
2
2
3packages:
3packages:
4- .
4- .
seminars/2/task.cabal+6−8
@@ -1,10 +1,10 @@
1cabal-version: 2.2
1cabal-version: 2.2
2
2
3−-- This file has been generated from package.yaml by hpack version 0.36.0.
3+-- This file has been generated from package.yaml by hpack version 0.37.0.
4--
4--
5-- see: https://github.com/sol/hpack
5-- see: https://github.com/sol/hpack
6--
6--
7−-- hash: c2b1bcd2599c61a3fda41614499046ca5654131a2e5ac9976e0c07ec2b8887d8
7+-- hash: 15a870ebff263dd9493d8624136d4468bfa3ade7fad4a0cb1b9a047b79b109d8
8
8
9name: task
9name: task
10version: 0.1.0.0
10version: 0.1.0.0
@@ -21,9 +21,8 @@ library
21 hs-source-dirs:
21 hs-source-dirs:
22 src
22 src
23 build-depends:
23 build-depends:
24− QuickCheck
25− , base >=4.7 && <5
24+ base >=4.7 && <5
26− , mtl
25+ , random
27 default-language: Haskell2010
26 default-language: Haskell2010
28
27
29test-suite task-tests
28test-suite task-tests
@@ -37,9 +36,8 @@ test-suite task-tests
37 hs-source-dirs:
36 hs-source-dirs:
38 test
37 test
39 build-depends:
38 build-depends:
40− QuickCheck
41− , base >=4.7 && <5
39+ base >=4.7 && <5
42− , mtl
40+ , random
43 , task
41 , task
44 , tasty
42 , tasty
45 , tasty-hunit
43 , tasty-hunit
seminars/2/test/Tests.hs+427−15
@@ -3,25 +3,437 @@ module Tests
3 )
3 )
4where
4where
5
5
6+import Data.Foldable
7+import Data.Function
8+import Data.List
6import Task
9import Task
7import Test.Tasty
10import Test.Tasty
8import Test.Tasty.HUnit
11import Test.Tasty.HUnit
9
12
10tests :: TestTree
13tests :: TestTree
11tests = testGroup "Tests"
14tests = testGroup "Tests"
12− [ testCase "Basic expression" $ do
15+ [ testGroup "List Monoids"
13− calculate "((1 + 2) * 3)" @=? Just 9
16+ [ testCase "FirstMonoid" $ do
14− calculate "1" @=? Just 1
17+ let getFirst = destructFirstMonoid . fold . fmap constructFirstMonoid
15− calculate "(((1 + 2) *3) +(1 + 1) )" @=? Just 11
18+ getFirst [1 :: Int, 2, 3] @=? Just 1
16− calculate "(((1 + 2) *3) +(1 + 1) " @=? Nothing
19+ getFirst [] @=? (Nothing :: Maybe ())
17− calculate "1 + " @=? Nothing
20+ getFirst [True, False] @=? Just True
18− calculate "(1 / (8 - 8))" @=? Nothing
21+ getFirst [True, True, False] @=? Just True
19− calculate "(4 / 2)" @=? Just 2
22+ getFirst [1 .. 1000] @=? Just (1 :: Int)
20− , testCase "Complex expression" $ do
23+ getFirst [100 .. 1000] @=? Just (100 :: Int)
21− calculate "if ( 1 = 2 ) then (2 + 4) else 2" @=? Just 2
24+ getFirst [6, 2, 7, 398, 1984, 383, -1020] @=? Just (6 :: Int)
22− calculate "(((1 + 2) *3) +( if ( 1 = 2 ) then (2 + 4) else 2 + 1) )" @=? Just 12
25+ , testCase "LastMonoid" $ do
23− calculate "(((1 + 2) *3) +( if 1 = 2 ) then (2 + 4) else 2 + 1) )" @=? Nothing
26+ let getLast = destructLastMonoid . fold . fmap constructLastMonoid
24− calculate "(((1 + 2) *3) +( if ( 1 = 2 ) then (2 + 4) else 2 + 1)" @=? Nothing
27+ getLast [1 :: Int, 2, 3] @=? Just 3
25− calculate "(((1 + 2) *3) +( f ( 1 = 2 ) then (2 + 4) else 2 + 1) )" @=? Nothing
28+ getLast [] @=? (Nothing :: Maybe ())
26− calculate "(((1 + 2) *3) +( f ( 1 = 2 ) then (2 + 4) + 1) )" @=? Nothing
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+ ]
27 ]
439 ]
seminars/calc/.gitignorenew file+2
@@ -0,0 +1,2 @@
1+.stack-work/
2+*~
seminars/calc/CHANGELOG.mdnew file+11
@@ -0,0 +1,11 @@
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/LICENSEnew file+26
@@ -0,0 +1,26 @@
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.mdnew file+1
@@ -0,0 +1 @@
1+# calc
seminars/calc/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
seminars/calc/app/Main.hsnew file+6
@@ -0,0 +1,6 @@
1+module Main (main) where
2+
3+import Lib
4+
5+main :: IO ()
6+main = server
seminars/calc/calc.cabalnew file+76
@@ -0,0 +1,76 @@
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.yamlnew file+62
@@ -0,0 +1,62 @@
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.hsnew file+27
@@ -0,0 +1,27 @@
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.yamlnew file+71
@@ -0,0 +1,71 @@
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.hsnew file+2
@@ -0,0 +1,2 @@
1+main :: IO ()
2+main = putStrLn "Test suite not yet implemented"
shell.nixdeleted−11
@@ -1,11 +0,0 @@
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−}