Differences

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

--- codesnippets:statemonads [2021/05/03 21:50] – [A decoder] f2b216
+++ codesnippets:statemonads [2025/10/08 00:48] (current) – external edit 127.0.0.1
@@ Line 1: / Line 1: @@
 ====== State monads ======
-~~DISCUSSION ~~
   * inspired by [[http://brandon.si/code/the-state-monad-a-tutorial-for-the-confused/|Brandon Simmons: The State Monad: A Tutorial for the Confused?]]
@@ Line 309: / Line 308: @@
   * example
-    * to show how a decoder can be designed
+    * to show how a decoder can be designed by using the monad ''State''
       * to take symbols that influence the amount of the following reading
     * compiles
@@ Line 323: / Line 322: @@
 main =
     do
-        --            +-take up to 3 Integer
+        --                                                                                                          MyData
-        --            |  +-take the next 5 characters converted to Integer
+        --                     + - take the next 4 characters converted to Integer ------------------------------->     4736
-        --            |  |     +-take the next 2 characters converted to Integer
+        --                    /      + - take the next 3 Integer ------------------------------------------------->     [
-        --            |  |     |  +-take the next 3 characters converted to Integer
+        --                   /      /  + - take the next 13 characters converted to Integer ---------------------->         7364537284958,
-        --            v  v     v  v
+        --                  /      /  /                + - take the next 2 characters converted to Integer ------->         12,
-        print ((parse 3 "5123452123123") :: [Integer])
+        --                 /      /  /                /    + - take the next 11 characters converted to Integer -->         123]
+        --                /      /  /                /    /     + -take the next 11 characters converted to Double>     44543.2345
+        --               /      /  /                /    /     /
+        --              v      v  v                v    v     v
+        print ((decode "|4:4736|3:|13:7364537284958|2:12|3:123|11:44543.23456") :: (Maybe MyData))
-type DecodeState = (Integer, [Char]) -- the number of char to be encoded and the remaining chars
+type DecodeState = [Char] -- the remaining chars
 class Decoder tValue where
-    parse :: Integer -> [Char] -> [tValue]
+    decode :: DecodeState -> (Maybe tValue)
-    parse n lch = S.evalState parseS (n, lch)
+    decode lch = S.evalState decodeMaybeS lch
-    parseS :: S.State DecodeState [tValue]
+    decodeMaybeS :: S.State DecodeState (Maybe tValue)
+    decodeListS :: S.State DecodeState [tValue]
-instance Decoder Integer where
+    decodeListS =
-    parseS =
         do
-            (nCount, _) <- S.get
+            nCount <- takeRepetitionCountS
-            liValues <- parseS' nCount
+            liValues <- decodeNListS nCount
             return liValues
-        where
+    decodeNListS :: Integer -> S.State DecodeState [tValue]
-            parseS' :: Integer -> S.State DecodeState [Integer]
+    decodeNListS lCount
-            parseS' lCount'
+        | lCount > 0 =
-                | lCount' > 0 =
+            do
+                mx <- decodeMaybeS
+                Sfr.ifJust mx
+                    {- then -} (\x ->
+                        do
+                            liValues <- decodeNListS (lCount - 1)
+                            return (x : liValues))
+                    {- else -} (return [])
+        | otherwise = return []
+data MyData = MyData Integer [Integer] Double
+    deriving Show
+instance Decoder MyData where
+    decodeMaybeS =
+        do
+            mn1 <- decodeMaybeS
+            Sfr.ifJust mn1
+                {- then -} (\n1 ->
                     do
-                        miValue <- parseS''
+                        ln2 <- decodeListS
-                        liValues <- parseS' (lCount' - 1)
+                        mn3 <- decodeMaybeS
-                        Sfr.ifJust miValue
+                        Sfr.ifJust mn3
-                            {- then -} (\x -> return (x : liValues))
+                            {- then -} (\n3 -> return (Just (MyData n1 ln2 n3)))
-                            {- else -} (return [])
+                            {- else -} (return Nothing)
-                | otherwise = return []
+                        )
-            parseS'' :: S.State DecodeState (Maybe Integer)
+                {- else -} (return Nothing)
-            parseS'' =
-                do
-                    mch <- takeMaybeCharS
-                    miValue <- parseS''' mch
-                    return miValue
-            parseS''' :: (Maybe Char) -> S.State DecodeState (Maybe Integer)
-            parseS''' Nothing = return Nothing
-            parseS''' (Just ch)=
-                do
-                    nLength <- pure ((read [ch]) :: Integer)
-                    lch <- takeCharListS nLength
-                    if (Sfr.len lch) > 0
-                        then return (Just ((read lch) :: Integer))
-                        else return Nothing
-eatCh :: Integer -> (Integer, [Char]) -> (Integer, [Char])
+instance Decoder Integer where
-eatCh _ (n, []) = (n, [])
+    decodeMaybeS =
-eatCh nCount (n, lch@(_:lrch))
+        do
-    | nCount > 0 = eatCh (nCount - 1) ((n - 1), lrch)
+            nLength <- takeRepetitionCountS
-    | otherwise  = (n, lch)
+            lch <- takeCharListS nLength
+            if (Sfr.len lch) > 0
+                then return (Just ((read lch) :: Integer))
+                else return Nothing
+instance Decoder Double where
+    decodeMaybeS =
+        do
+            nLength <- takeRepetitionCountS
+            lch <- takeCharListS nLength
+            if (Sfr.len lch) > 0
+                then return (Just ((read lch) :: Double))
+                else return Nothing
+takeRepetitionCountS :: S.State DecodeState Integer
+takeRepetitionCountS =
+    do
+        mch <- takeMaybeCharS
+        if mch == (Just '|')
+            then takeRepetitionCountS'
+            else return 0
+    where
+        takeRepetitionCountS' :: S.State DecodeState Integer
+        takeRepetitionCountS' =
+            do
+                lch <- takeUntilS ':'
+                nCount <- pure ((read lch) :: Integer)
+                return nCount
+takeUntilS :: Char -> S.State DecodeState [Char]
+takeUntilS ch =
+    do
+        mch <- takeMaybeCharS
+        if mch == (Just ch)
+            then return []
+            else
+                Sfr.ifJust mch
+                    {- then -} (\ch' ->
+                        do
+                            lch <- takeUntilS ch
+                            return (ch' : lch))
+                    {- else -} (return [])
+eatCh :: Integer -> [Char] -> [Char]
+eatCh _ [] = []
+eatCh nCount lch@(_:lrch)
+    | nCount > 0 = eatCh (nCount - 1) lrch
+    | otherwise  = lch
-mchGet :: (Integer, [Char]) -> (Maybe Char)
+mchGet :: [Char] -> (Maybe Char)
-mchGet (_, []) = Nothing
+mchGet [] = Nothing
-mchGet (_, (ch:_)) = Just ch
+mchGet (ch:_) = Just ch
-lchGet :: Integer -> (Integer, [Char]) -> [Char]
+lchGet :: Integer -> [Char] -> [Char]
-lchGet _ (_, []) = []
+lchGet _ [] = []
-lchGet nCount (n, (ch:lrch))
+lchGet nCount (ch:lrch)
-    | nCount > 0 = ch : (lchGet (nCount - 1) ((n - 1), lrch))
+    | nCount > 0 = ch : (lchGet (nCount - 1) lrch)
     | otherwise  = []
@@ Line 430: / Line 483: @@
 </code>
     * executes, with output:<code>
-[12345,12,123]
+Just (MyData 4736 [7364537284958,12,123] 44543.23456)
 </code>
+===== ✎ =====
+~~DISCUSSION~~