{-# LANGUAGE DeriveFunctor #-}

module Langdsl where

import Control.Monad
import Parser

data Toy a next = Output a next | Bell next | Done
  deriving Functor

newtype Fix f = Fix (f (Fix f))

type Toy2 a = Fix (Toy a)

data Free f r = Free (f (Free f r)) | Pure r
  deriving Functor

instance Functor f => Monad (Free f) where
  return = Pure
  (Pure r) >>= f = f r
  (Free a) >>= f = Free $ (fmap (>>= f) a)

instance Functor f => Applicative (Free f) where
  pure = Pure
  (<*>) = ap

liftF x = Free (fmap Pure x)

output x = liftF (Output x ())
bell = liftF (Bell ())
done = liftF Done

sub :: Free (Toy Char) ()
sub = do
  output 'x'
  bell

prog = do
  sub
  output 'A'
  done

toyParser :: Parser (Toy c)