Differences

This shows you the differences between two versions of the page.

--- codesnippets:monads [2022/04/21 22:18] – f2b216
+++ codesnippets:monads [2025/10/08 00:48] (current) – external edit 127.0.0.1
@@ Line 1: / Line 1: @@
 ~~DISCUSSION~~
 ====== Monads ======
+===== Example 1a =====
+  * this example shows how alternative results (sum type, algebraic type, see type A, B and C in the example) can be handled and propagated in a computation by means of 'case' / 'of' constructions
+  * it works but it is quite some code
+  * Code:<code Haskell>
+main :: IO ()
+main =
+    do
+        putStrLn $ show (fAListToC [(A 12), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 13), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A (-1)), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 11), (A 5), (A 13)] fAToB)
+data A a = A a | AError | ANone
+    deriving Show
+data B a = B a | BError | BNone
+    deriving Show
+data C a = C a | CError | CNone
+    deriving Show
+fAToB :: A Int -> B Int
+fAToB (A n)
+    | n <= 0 = BNone
+    | n < 13 = B (23 `div` n)
+    | otherwise = BError
+fAToB AError = BError
+fAToB ANone = BNone
+fAListToC :: [A a] -> (A a -> B a) -> C [a]
+fAListToC [] _ = C []
+fAListToC (a@(A _):lrAList) fAToB' =
+    do
+        case fAToB' a of
+            B b ->
+                let
+                    c = (fAListToC lrAList fAToB')
+                in
+                    case c of
+                        C lb -> C (b : lb)
+                        CNone -> CNone
+                        CError -> CError
+            BError -> CError
+            BNone -> CNone
+fAListToC (AError:_) _ = CError
+fAListToC (ANone:_) _ = CNone
+</code>
+  * Output:<code Haskell>
+C [1,3,2,4]
+CError
+CNone
+CError
+</code>
+===== Example 1b =====
+  * this example does not explain monads but an alternative solution where monads usually apply
+  * it shows how alternative results (sum type, algebraic type, see type A, B and C in the example) can be handled and propagated in a computation by means of a function that handles such alternative results
+  * that function handles such results by function 'ifC' and makes the job for a 'Monad' of type 'C'
+  * more detailed description of the program
+    * the function 'fAListToC' takes a list of 'A's (e.g. '[(A 12), (A 7), (A 11), (A 5)]') and transforms it to 'C' with a list of transformed data
+    * the transformation of data is according to function 'fAToB'
+    * 'fAToB' divides 23 by the number to be transformed, unless the number is 13 or greater then an error propagates ('BError'), and unless the number is 0 or smaler then no data propagates ('BNone')
+    * in 'fAListToC' 'BError' propagates to 'CError' and 'BNone' propagates to 'CNone'
+  * this example compile warning free with GHC 9.2.7 using -Wall
+  * Code:<code Haskell>
+main :: IO ()
+main =
+    do
+        putStrLn $ show (fAListToC [(A 12), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 13), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A (-1)), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 11), (A 5), (A 13)] fAToB)
+data A a = A a | AError | ANone
+    deriving Show
+data B a = B a | BError | BNone
+    deriving Show
+data C a = C a | CError | CNone
+    deriving Show
+fAToB :: A Int -> B Int
+fAToB (A n)
+    | n <= 0 = BNone
+    | n < 13 = B (23 `div` n)
+    | otherwise = BError
+fAToB AError = BError
+fAToB ANone = BNone
+fAListToC :: [A a] -> (A a -> B a) -> C [a]
+fAListToC [] _ = C []
+fAListToC (a@(A _):lrAList) fAToB' =
+    do
+        case fAToB' a of
+            B b -> ifC (fAListToC lrAList fAToB' ) (\lb -> C (b : lb)) CNone CError
+            BError -> CError
+            BNone -> CNone
+fAListToC (AError:_) _ = CError
+fAListToC (ANone:_) _ = CNone
+ifC :: C a -> (a -> b) -> b -> b -> b
+ifC (C x) fThen _ _ = fThen x
+ifC CNone _ bNone _ = bNone
+ifC CError _ _ bError = bError
+</code>
+  * Output:<code Haskell>
+C [1,3,2,4]
+CError
+CNone
+CError
+</code>
+===== Example 1c =====
+  * this example uses the instances for Functor, Applicative and Monad
+  * this way the operator '>>=' can be used
+  * Code:<code Haskell>
+import qualified Control.Monad as M (liftM, ap)
+instance Functor C where
+    fmap = M.liftM
+instance Applicative C where
+    pure = C
+    (<*>) = M.ap
+instance Monad C where
+    CError  >>= _   = CError
+    CNone   >>= _   = CNone
+    (C x)   >>= f   = f x
+    return          =  pure
+main :: IO ()
+main =
+    do
+        putStrLn $ show (fAListToC [(A 12), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 13), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A (-1)), (A 7), (A 11), (A 5)] fAToB)
+        putStrLn $ show (fAListToC [(A 7), (A 11), (A 5), (A 13)] fAToB)
+data A a = A a | AError | ANone
+    deriving Show
+data B a = B a | BError | BNone
+    deriving Show
+data C a = C a | CError | CNone
+    deriving Show
+fAToB :: A Int -> B Int
+fAToB (A n)
+    | n <= 0 = BNone
+    | n < 13 = B (23 `div` n)
+    | otherwise = BError
+fAToB AError = BError
+fAToB ANone = BNone
+fAListToC :: [A a] -> (A a -> B a) -> C [a]
+fAListToC [] _ = C []
+fAListToC (a@(A _):lrAList) fAToB' =
+    do
+        case fAToB' a of
+            B b -> fAListToC lrAList fAToB' >>= \lb -> return (b : lb)
+            BError -> CError
+            BNone -> CNone
+fAListToC (AError:_) _ = CError
+fAListToC (ANone:_) _ = CNone
+</code>
+  * Output:<code Haskell>
+C [1,3,2,4]
+CError
+CNone
+CError
+</code>
+===== Example 2 =====
   * inspired from https://wiki.haskell.org/All_About_Monads#A_physical_analogy_for_monads
   * examples compile warning free with GHC 8.10.4 using -Wall
-<code Haskell>
+  * Code:<code Haskell>
 module Main where
@@ Line 116: / Line 305: @@
     Empty s       >>= _      = Empty s
     (Contains x) >>= worker = worker x
-    return                  = Contains</code>
+    return                  = Contains
+</code>
-Output:
-<code>
+  * Output:<code>
 Contains (Wrapper (Chopsticks {nPieces = 54, nQuality = Polished}))
 Contains (StorageBin (Chopsticks {nPieces = 34, nQuality = Polished}))
@@ Line 128: / Line 316: @@
 Empty "no chopsticks at packing"
 </code>