Differences

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

--- codesnippets:statemonads [2021/04/07 17:07] – [Control.Monad.State applied] f2b216
+++ codesnippets:statemonads [2025/10/08 00:48] (current) – external edit 127.0.0.1
@@ Line 6: / Line 6: @@
   * inspired from [[https://wiki.haskell.org/State_Monad|]]
-  * example
+  * example compiles warning free with
-    * which compiles
-    * warning free with
       * compiler: GHC 8.10.4 using -Wall
       * package: [[https://downloads.haskell.org/~ghc/latest/docs/html/libraries/mtl-2.2.2/index.html|mtl-2.2.2]]
@@ Line 104: / Line 102: @@
       * compiler: GHC 8.10.4 using -Wall
       * package: [[https://downloads.haskell.org/~ghc/latest/docs/html/libraries/mtl-2.2.2/index.html|mtl-2.2.2]]
   * example:
     * <code Haskell>
@@ Line 186: / Line 183: @@
     S.get                    -- returns the state
 </code>
+  * executes, with output:
-    * executes, with output:
+    * <code>
-      * <code>
 test1:
    (Pos {rnLat = 9, rnLon = 13},Pos {rnLat = -1, rnLon = 3})
@@ Line 210: / Line 206: @@
       * package: [[https://downloads.haskell.org/~ghc/latest/docs/html/libraries/mtl-2.2.2/index.html|mtl-2.2.2]]
   * example:
-    * <code Haskell>import qualified Control.Monad.State as S
+    * <code Haskell>
+import qualified Control.Monad.State as S
 -- in package mtl-2.2.2, the line above seems to be the same as "import qualified mtl-2.2.2Control.Monad.State.Lazy ..."
 import Prelude hiding (div)
@@ Line 308: / Line 305: @@
 </code>
+===== A decoder =====
+  * example
+    * 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
+      * warning free with
+        * compiler: GHC 8.10.4 using -Wall
+        * package: [[https://downloads.haskell.org/~ghc/latest/docs/html/libraries/mtl-2.2.2/index.html|mtl-2.2.2]]
+    * code, of module ''Main'':<code Haskell>
+import qualified Control.Monad.State as S
+import qualified Safer as Sfr
+main :: IO ()
+main =
+    do
+        --                                                                                                          MyData
+        --                     + - take the next 4 characters converted to Integer ------------------------------->     4736
+        --                    /      + - take the next 3 Integer ------------------------------------------------->     [
+        --                   /      /  + - take the next 13 characters converted to Integer ---------------------->         7364537284958,
+        --                  /      /  /                + - take the next 2 characters converted to Integer ------->         12,
+        --                 /      /  /                /    + - 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 = [Char] -- the remaining chars
+class Decoder tValue where
+    decode :: DecodeState -> (Maybe tValue)
+    decode lch = S.evalState decodeMaybeS lch
+    decodeMaybeS :: S.State DecodeState (Maybe tValue)
+    decodeListS :: S.State DecodeState [tValue]
+    decodeListS =
+        do
+            nCount <- takeRepetitionCountS
+            liValues <- decodeNListS nCount
+            return liValues
+    decodeNListS :: Integer -> S.State DecodeState [tValue]
+    decodeNListS lCount
+        | 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
+                        ln2 <- decodeListS
+                        mn3 <- decodeMaybeS
+                        Sfr.ifJust mn3
+                            {- then -} (\n3 -> return (Just (MyData n1 ln2 n3)))
+                            {- else -} (return Nothing)
+                        )
+                {- else -} (return Nothing)
+instance Decoder Integer where
+    decodeMaybeS =
+        do
+            nLength <- takeRepetitionCountS
+            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 :: [Char] -> (Maybe Char)
+mchGet [] = Nothing
+mchGet (ch:_) = Just ch
+lchGet :: Integer -> [Char] -> [Char]
+lchGet _ [] = []
+lchGet nCount (ch:lrch)
+    | nCount > 0 = ch : (lchGet (nCount - 1) lrch)
+    | otherwise  = []
+takeCharListS :: Integer -> S.State DecodeState [Char]
+takeCharListS nCount =
+    do
+        lch <- S.gets (lchGet nCount)
+        S.modify (eatCh nCount)
+        return lch
+takeMaybeCharS :: S.State DecodeState (Maybe Char)
+takeMaybeCharS =
+    do
+        mch <- (S.gets mchGet)
+        if mch == Nothing
+            then return Nothing
+            else
+                do
+                    S.modify (eatCh 1)
+                    return mch
+</code>
+    * code, of module ''Safer'':<code Haskell>
+module Safer (
+        len,
+        take,
+        head,
+        ifJust
+    ) where
+import Prelude hiding (take, head)
+import qualified Data.List as Lst
+len :: [a] -> Integer
+len = Lst.genericLength
+take :: Integer -> [a] -> [a]
+take = Lst.genericTake
+head :: [a] -> (Maybe a)
+head [] = Nothing
+head (x:_) = Just x
+ifJust :: (Maybe a) -> (a -> b) -> b -> b
+ifJust (Just x) then' _ = then' x
+ifJust Nothing _ bDflt = bDflt
+</code>
+    * executes, with output:<code>
+Just (MyData 4736 [7364537284958,12,123] 44543.23456)
+</code>
+===== ✎ =====
+~~DISCUSSION~~