Custom monad

M.hs

{-# LANGUAGE GHC2024 #-}

import System.IO
import Control.Monad
import Control.Applicative
import Data.ByteString (hGet, ByteString)

newtype M a = M { runM :: Handle -> Int -> IO (Maybe (Int, a)) } deriving Functor

instance Applicative M where
  pure x = M (\_ pos -> pure (pure (pos, x)))
  (<*>) = ap

instance Monad M where
  M f >>= k = M $ \hdl pos -> do
    f hdl pos >>= \case
      Nothing -> pure Nothing
      Just (pos', x) -> runM (k x) hdl pos'

instance Alternative M where
  empty = M $ \_ _ -> pure Nothing
  M p <|> M q = M $ \hdl pos ->
    p hdl pos >>= \case
      Nothing -> do
        hSeek hdl AbsoluteSeek (fromIntegral pos)
        q hdl pos
      x -> pure x

getBytes :: Int -> M ByteString
getBytes n = M $ \hdl pos -> do
  bs <- hGet hdl n
  pure (pure (pos + n, bs))