User Tools

Site Tools


codesnippets:statefuldecoder

Stateful decoder

  • example
    • code, module Main:
      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, module Safer:
      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

This website uses cookies. By using the website, you agree with storing cookies on your computer. Also you acknowledge that you have read and understand our Privacy Policy. If you do not agree leave the website.More information about cookies
You could leave a comment if you were logged in.
codesnippets/statefuldecoder.txt · Last modified: by 127.0.0.1

Except where otherwise noted, content on this wiki is licensed under the following license: CC0 1.0 Universal
CC0 1.0 Universal Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki