====== Stateful decoder ======

  * example
    * code, 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, 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>


===== ✎ =====
~~DISCUSSION~~