Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{- stack script
--resolver lts-14.20
-}
{-# Language RebindableSyntax
, ScopedTypeVariables
, FlexibleInstances
, NoMonomorphismRestriction
, OverloadedStrings
, InstanceSigs
, RoleAnnotations
#-}
module IxMonadParser where
import Prelude (fromIntegral, fromInteger, IO, Show, print, putStrLn)
import Control.Applicative (pure, (<$>))
import Control.Monad.Trans.Class (MonadTrans(..))
import Data.Coerce (Coercible, coerce)
import Data.Function (($), (.))
import Data.Int (Int)
import Data.String (fromString)
import Data.Text (Text)
import Data.Tuple (fst, snd)
import GHC.Generics (Generic)
import qualified Control.Monad.IO.Class as CM
import qualified Control.Monad as CM
-- Define Example data
newtype SourceCode = SourceCode Text
newtype Tokenized = Tokenized [Text]
data Expr = EInt Int | EStr Text | EVar Text | EApp Expr Expr deriving (Show)
newtype Syntax = Syntax { unSyntax :: Expr } deriving (Show)
newtype Core = Core { unCore :: Expr } deriving (Show)
-- example transitions
source2Toke :: SourceCode -> Tokenized
source2Toke (SourceCode txt) = Tokenized [txt] -- can we coerce here as well?
toke2Syntax :: Tokenized -> Syntax
toke2Syntax _ = Syntax $ EApp (EVar "Fn") $ EInt . fromIntegral $ 42
syntax2Core :: Syntax -> Core
syntax2Core = coerce -- "safe" newtype coerce
-- indexed monad
newtype IxMonadT i o m a = IxMonadT { runIx :: i -> m (a, o) }
evalIxMonadT :: (CM.Functor m) => IxMonadT i o m a -> i -> m a
evalIxMonadT st i = fst <$> runIx st i
execIxMonadT :: (CM.Functor m) => IxMonadT i o m a -> i -> m o
execIxMonadT st i = snd <$> runIx st i
return :: (CM.Monad m) => a -> IxMonadT s s m a
return a = IxMonadT $ \s -> CM.return (a, s)
(>>=) :: (CM.Monad m) => IxMonadT i c m a -> (a -> IxMonadT c o m b) -> IxMonadT i o m b
(>>=) v f = IxMonadT $ \i -> runIx v i CM.>>= \(a', o') -> runIx (f a') o'
(>>) :: (CM.Monad m) => IxMonadT i c m a -> IxMonadT c o m b -> IxMonadT i o m b
v >> w = v >>= \_ -> w
instance MonadTrans (IxMonadT s s) where
lift :: (CM.Monad m) => m a -> IxMonadT s s m a
lift ma = IxMonadT $ \s -> ma CM.>>= (\a -> CM.return (a, s))
liftIO :: CM.MonadIO m => IO a -> IxMonadT s s m a
liftIO = lift . CM.liftIO
put :: (CM.Monad m) => o -> IxMonadT i o m ()
put o = IxMonadT $ \_ -> CM.return ((), o)
modify :: (CM.Monad m) => (i -> o) -> IxMonadT i o m ()
modify f = IxMonadT $ \i -> CM.return ((), f i)
get :: CM.Monad m => IxMonadT s s m s
get = IxMonadT $ \x -> CM.return (x, x)
gets :: CM.Monad m => (a -> o) -> IxMonadT a o m a
gets f = IxMonadT $ \s -> CM.return (s, f s)
instance (CM.Monad m) => CM.Functor (IxMonadT i o m) where
fmap :: (CM.Monad m) => (a -> b) -> IxMonadT i o m a -> IxMonadT i o m b
fmap f v = IxMonadT $ \i ->
runIx v i CM.>>= \(a', o') -> CM.return (f a', o')
-- demonstration function
run :: IxMonadT SourceCode Core IO Core
run = do
toke <- gets source2Toke -- :: IxMonadT IO SourceCode Tokenized ()
liftIO $ putStrLn "inside IxMonad" -- :: IxMonadT IO Tokenized Tokenized ()
syn <- gets toke2Syntax -- :: IxMonadT IO Tokenized Syntax ()
modify syntax2Core -- :: IxMonadT IO Syntax Core ()
result <- get -- :: IxMonadT Syntax Core IO Core
-- with get we can manipulate the value of the transformation
liftIO $ print result -- :: IxMonadT Syntax Core IO Core
return result -- :: IxMonadT SourceCode Core IO Core -- (final type)
main :: IO ()
main = do
let srcCode = SourceCode "here is my source code"
in execIxMonadT run srcCode CM.>> print "done"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.