Update for B252

MarekSuchanek · MarekSuchanek · commit 047aeb88c6e9 · 2026-02-26T17:23:51.000+01:00
diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
@@ -0,0 +1,44 @@
+name: 'Build and Test'
+
+on:
+  push:
+
+jobs:
+  build:
+    name: 'Build and Test'
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout git repository
+        uses: actions/checkout@v6
+
+      - name: Setup Haskell
+        uses: haskell-actions/setup@v2
+        with:
+          ghc-version: '9.6.7'
+          enable-stack: true
+          stack-version: 'latest'
+  
+      - name: Cache ~/.stack
+        id: cache-stack
+        uses: actions/cache@v5
+        with:
+          path: ~/.stack
+          key: stack-home-${{ hashFiles('**/package.yaml')}}-${{ hashFiles('**/stack.yaml*') }}
+          restore-keys: |
+            stack-home-
+
+      - name: Setup Stack
+        run: |
+          stack setup
+      
+      - name: Install dependencies
+        run: |
+          stack build --only-dependencies
+      
+      - name: Build
+        run: |
+          stack build
+      
+      - name: Test
+        run: |
+          stack test
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
@@ -1,4 +1,4 @@
-image: haskell:8.8.4
+image: haskell:9.6.7
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack"
diff --git a/README.md b/README.md
@@ -8,15 +8,14 @@ Homework to practice advanced work with typeclasses
    * First, implement instances of  `Validable` for each shape type with function `valid` that says if given shape is valid (its attributes are acceptable, i.e., not negative, forming a triangle).
    * Then, design on your own the `Shape2D` typeclass which is a subclass of `Validable`, define `area` and `circumference` (remove dummy ones). During the design consider using `valid` - for invalid shape, both functions should return zero.
    * Finally, implement instances of `Shape2D` for each shape type.
-2. *Data.SortedList* = implement all necessary functions to make data type `SortedList` to be an instance of `Semigroup`, `Monoid`, `Functor`, `Applicative`, `Monad`. After applying `(<>)` the resulting list must be sorted. Sadly, `Functor`, `Applicative`, and `Monad` won't allow you to use `Ord` constaint so the result won't be sorted. Implement some sort function if you want to... It is **forbidden** to just delegate to list and use `fromList` and `toList`.
+2. *Data.ResultList* = implement all necessary functions to make data type `ResultList` to be an instance of `Semigroup`, `Monoid`, `Functor`, `Applicative`, `Monad` (expectations should be clear from tests).
 3. The final (and also the most interesting) task is to implement functions and instances for next data type to represent integers - the `RomanNumeral` (from `Data.RomanNumeral`)! It is a representation of an integer as Roman numeral, for example, `125` is `"CXXV"`.
    * The biggest challenge is to implement functions `integral2RomanNumeral` and `romanNumeral2Integral` (related with `pack` and `unpack`). There is something already prepared in `Data.RomanNumeral.Helpers`. Take a look and feel free to edit as you need.
    * After having `pack` and `unpack` working, it will be very easy to make instances of `Bounded`, `Eq`, `Ord`, `Num`, `Enum`, and `Integral` (*you might need some more due to dependencies*) for the `RomanNumeral`.
 
 Hints & general requirements:
 
 * You should not hardcode any string or character in `Data.RomanNumeral` - use only those defined in `Data.RomanNumeral.Helpers` or enhance it.
-* Being [DRY](https://cs.wikipedia.org/wiki/Don%27t_repeat_yourself) is essential, do not repeat code. Name expressions to reuse then, introduce helper functions.
 * Local names (via `where` or `let-in`) in functions should be introduced to make the code more readable. Creating very simple helper functions in module scope is not nice. If you need some complicated functions create separate "private" module.
 * Make your code as clean as possible. Prefer pattern matching and syntactic sugar everywhere it is reasonable.
 * **You must understand your code completely**!
diff --git a/package.yaml b/package.yaml
@@ -3,8 +3,8 @@ version:             0.1.0.0
 github:              "MI-AFP/hw05"
 license:             MIT
 author:              "Marek Suchánek"
-maintainer:          "marek.suchanek@fit.cvut.cz"
-copyright:           "2021 Marek Suchánek"
+maintainer:          "marek.suchanek@cvut.cz"
+copyright:           "2026 Marek Suchánek"
 
 extra-source-files:
 - README.md
diff --git a/src/Data/ResultList.hs b/src/Data/ResultList.hs
@@ -0,0 +1,40 @@
+module Data.ResultList where
+
+import Data.List (sort)
+import Data.Semigroup
+
+data ResultList a = Results [a] | Error Int String
+                  deriving (Show, Read, Eq)
+
+-- | Extract results to a list or return error with message
+-- TODO
+toList :: ResultList a -> [a]
+toList = undefined
+
+
+instance Semigroup (ResultList a) where
+  -- | Merge two result lists together
+  -- TODO
+  (<>) = undefined
+
+instance Monoid (ResultList a) where
+  -- TODO
+  mempty = undefined
+  mappend = (<>)
+
+instance Functor ResultList where
+  -- | Apply function over sorted list
+  -- TODO
+  fmap = undefined
+
+instance Applicative ResultList where
+  -- TODO
+  pure  = undefined
+  -- | Apply all functions to elements in result list
+  -- TODO
+  (<*>) = undefined
+
+instance Monad ResultList where
+  -- | Apply on result list if valid and not empty
+  -- TODO
+  (>>=) = undefined
diff --git a/src/Data/RomanNumeral.hs b/src/Data/RomanNumeral.hs
@@ -9,16 +9,16 @@ import Data.Maybe (fromMaybe)
 -- DO NOT HARDCODE ANY STRINGs/CHARs IN THIS MODULE!
 import qualified Data.RomanNumeral.Helpers as Helpers
 
--- | RomanNumeral type (wrapper) for English numerals
+-- | RomanNumeral type (wrapper) for Roman numerals
 newtype RomanNumeral = RomanNumeral String
                      deriving (Show, Read)
 
-   -- | Pack Integer into RomanNumeral (English numeral string)
+   -- | Pack Integer into RomanNumeral (Roman numeral string)
 pack :: (Integral a, Show a) => a -> RomanNumeral
 pack integral = RomanNumeral $ fromMaybe err (integral2RomanNumeral integral)
               where err = error $ Helpers.messageBadIntegral integral
 
--- | Unpack RomanNumeral (English numeral string) to Integer
+-- | Unpack RomanNumeral (Roman numeral string) to Integer
 unpack :: RomanNumeral -> Integer
 unpack (RomanNumeral numeral) = fromMaybe err (romanNumeral2Integral numeral)
                               where err = error $ Helpers.messageBadNumeral numeral
diff --git a/src/Data/RomanNumeral/Helpers.hs b/src/Data/RomanNumeral/Helpers.hs
@@ -3,6 +3,7 @@ module Data.RomanNumeral.Helpers where
 import Data.Tuple (swap)
 
 -- these are to help with RomanNumerals, feel free to edit it if needed
+-- you don't have to use them at all... but you can
 
 -- see: http://www.csgnetwork.com/csgromancnv.html
 
diff --git a/src/Data/SortedList.hs b/src/Data/SortedList.hs
diff --git a/stack.yaml b/stack.yaml
@@ -15,7 +15,7 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: lts-16.31
+resolver: lts-22.44
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -39,7 +39,7 @@ packages:
 - .
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
-extra-deps: [datetime-0.3.1]
+# extra-deps: [datetime-0.3.1]
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
@@ -48,7 +48,7 @@ extra-deps: [datetime-0.3.1]
 # extra-package-dbs: []
 
 # Control whether we use the GHC we find on the path
-# system-ghc: true
+system-ghc: true
 #
 # Require a specific version of stack, using version ranges
 # require-stack-version: -any # Default
diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -1,19 +1,19 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
 
 packages:
 - completed:
     hackage: datetime-0.3.1@sha256:7e275bd0ce7a2f66445bedfa0006abaf4d41af4c2204c3f8004c17eab5480e74,1534
     pantry-tree:
-      size: 334
       sha256: d41d182c143676464cb1774f0b7777e870ddeaf8b6cd5fee6ff0114997a1f504
+      size: 334
   original:
     hackage: datetime-0.3.1
 snapshots:
 - completed:
-    size: 534126
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
-    sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
-  original: lts-16.31
+    sha256: 238fa745b64f91184f9aa518fe04bdde6552533d169b0da5256670df83a0f1a9
+    size: 721141
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/44.yaml
+  original: lts-22.44
diff --git a/test/ResultListSpec.hs b/test/ResultListSpec.hs
@@ -0,0 +1,146 @@
+module ResultListSpec (spec) where
+
+import Control.Exception
+import Data.Semigroup
+import Test.Hspec
+import Test.QuickCheck hiding (SortedList(..))
+
+import Data.ResultList
+
+empty :: ResultList Int
+empty = Results []
+
+list1 :: ResultList Int
+list1 = Results [1..5]
+
+list2 :: ResultList Int
+list2 = Results [6,10]
+
+list3 :: ResultList Int
+list3 = Results [1,2,3,4,5,6,10]
+
+list4 :: ResultList Int
+list4 = Results [6,10,1,2,3,4,5]
+
+list5 :: ResultList Int
+list5 = Results [0,1,2,5,15]
+
+list6 :: ResultList String
+list6 = return "yolo"
+
+errorList1 :: ResultList Int
+errorList1 = Error 7 "Wild error appeared"
+
+errorList2 :: ResultList Int
+errorList2 = Error 666 "Higher priority error from hell"
+
+errorList3 :: ResultList Int
+errorList3 = Error 7 "Wilder error appeared"
+
+divisionOp :: Int -> Int -> ResultList Int
+divisionOp _ 0 = Error 10 "Division by zero"
+divisionOp x y = return $ x `div` y
+
+doChain1 :: ResultList Int
+doChain1 = do
+  x <- divisionOp 5 2 -- 2
+  divisionOp 3 x -- 1
+
+doChain2 :: ResultList Int
+doChain2 = do
+  Error 5 "Operation not permitted"
+  divisionOp 3 0
+  return (-123)
+
+doChain3 :: ResultList Int
+doChain3 = do
+  divisionOp 5 2 -- 2
+  divisionOp 3 0 -- error
+  return 666
+
+doChain4 :: ResultList String
+doChain4 = do
+  return "what"
+  return "the"
+  return "hell"
+
+
+instance (Ord a, Arbitrary a) => Arbitrary (ResultList a) where
+  arbitrary = fmap Results rndlst
+            where rndlst = sized $ \n -> do
+                              k <- choose (0, n)
+                              sequence [ arbitrary | _ <- [1..k] ]
+
+
+prop_AssocInt :: ResultList Int ->  ResultList Int -> ResultList Int -> Bool
+prop_AssocInt x y z = x <> (y <> z) == (x <> y) <> z
+
+prop_NeutralInt :: ResultList Int -> Bool
+prop_NeutralInt x = x <> mempty == x && mempty <> x == x
+
+prop_FmapIdInt :: ResultList Int -> Bool
+prop_FmapIdInt x = fmap id x == id x
+
+prop_FmapComposeInt :: ResultList Int -> Bool
+prop_FmapComposeInt x = fmap ((2*) . (\z -> z-5)) x == fmap (2*) (fmap (\z -> z-5) x)
+
+spec :: Spec
+spec = describe "data type ResultList" $ do
+        it "has working toList" $ do
+          toList list1 `shouldBe` [1..5]
+          evaluate (toList errorList1) `shouldThrow` errorCall "#7: Wild error appeared"
+
+        it "is instance of Semigroup (<>)" $ do
+          empty <> empty `shouldBe` empty
+          list1 <> empty `shouldBe` list1
+          empty <> list2 `shouldBe` list2
+          list1 <> list2 `shouldBe` list3
+          list2 <> list1 `shouldBe` list4
+        it "is instance of Semigroup (<>) for errors" $ do
+          errorList1 <> errorList2 `shouldBe` errorList2 -- higher priority wins
+          errorList2 <> errorList1 `shouldBe` errorList2 -- higher priority wins
+          errorList1 <> errorList3 `shouldBe` errorList1 -- same priority, first in order wins
+          errorList3 <> errorList1 `shouldBe` errorList3 -- same priority, first in order wins
+        it "is instance of Semigroup (and <> is associative)" $
+          property prop_AssocInt
+        it "is instance of Monoid (mempty, mappend, mconcat)" $ do
+          mappend list1 mempty `shouldBe` list1
+          mappend mempty list2 `shouldBe` list2
+          mappend list1 list2 `shouldBe` list3
+          mappend list2 list1 `shouldBe` list4
+          mconcat [list2, mempty, list1, mempty] `shouldBe` list4
+        it "is instance of Monoid (mempty is neutral)" $
+          property prop_NeutralInt
+
+        it "is instance of Functor (fmap, <$>)" $ do
+          fmap (*2) list1 `shouldBe` Results (map (*2) [1..5])
+          fmap (1-) list1 `shouldBe` Results [0, -1, -2, -3, -4]
+          const 0 <$> list1 `shouldBe` Results (replicate 5 0)
+        it "is instance of Functor (fmap has identity)" $
+          property prop_FmapIdInt
+        it "is instance of Functor (fmap is homomorphic)" $
+          property prop_FmapComposeInt
+
+        it "is instance of Applicative (pure, <*>)" $ do
+          pure 5 `shouldBe` Results [5] -- cannot test function equality
+          pure (*2) <*> list1 `shouldBe` Results (map (*2) [1..5])
+          pure (1-) <*> list1 `shouldBe` Results [0, -1, -2, -3, -4]
+          Results [(1-), (*3)] <*> list1 `shouldBe` Results [0, -1, -2, -3, -4, 3, 6, 9, 12, 15]
+
+        it "is instance of Monad (>>)" $ do
+          (empty >> empty) `shouldBe` empty
+          (empty >> list5) `shouldBe` empty
+          (list3 >> empty) `shouldBe` empty
+          (list6 >> list6) `shouldBe` list6
+          -- repeats like normal [] monad
+          (list2 >> list1) `shouldBe` Results [1, 2, 3, 4, 5, 1, 2, 3, 4, 5]
+          (errorList1 >> list1) `shouldBe` errorList1
+          (list1 >> errorList1 >> empty) `shouldBe` errorList1
+        it "is instance of Monad (>>=)" $ do
+          (empty >>= (\x -> return (x*x))) `shouldBe` empty
+          (list1 >>= (\x -> return (x*x))) `shouldBe` Results (map (^2) [1..5])
+        it "chains with 'do'" $ do
+          doChain1 `shouldBe` Results [1]
+          doChain2 `shouldBe` Error 5 "Operation not permitted"
+          doChain3 `shouldBe` Error 10 "Division by zero"
+          doChain4 `shouldBe` Results ["hell"]
diff --git a/test/SortedListSpec.hs b/test/SortedListSpec.hs
diff --git a/test/Spec.hs b/test/Spec.hs

Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`		`-image: haskell:8.8.4`
	`1`	`+image: haskell:9.6.7`
`2`	`2`
`3`	`3`	`variables:`
`4`	`4`	`STACK_ROOT: "${CI_PROJECT_DIR}/.stack"`