A complete example of DSL in Haskell

dsl.hs

{-# LANGUAGE DeriveFunctor #-}
-- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- {-# LANGUAGE XRankNTypes #-}
-- run this online https://repl.it/repls/GraciousCooperativeNijssenissdwarfchihlid

import Control.Applicative  -- <$>
import Control.Monad   

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



data Op next
  = Push Double next -- ^ Push element to the stack
  | Pop (Maybe Double -> next) -- ^ Pop element and return it, if it exists
  | Flip next -- ^ Flip top two element of stack, if they exist
  | Add next -- ^ Add top two elements, if they exist
  | Subtract next
  | Multiply next
  | Divide next
  | End -- ^ Terminate program
  deriving (Functor)

-- instance Functor f => Monad (Free f) where
--  return x = Pure x
--  (Pure r) >>= f = f r
--  (Free x) >>= f = Free (fmap (>>= f) x)

instance Functor f => Functor (Free f) where
  fmap g (Pure a)  = Pure (g a)
  fmap g (Free fv) = Free ((g <$>) <$> fv)

instance Functor f => Monad (Free f) where
  return = Pure
  Pure a  >>= k = k a
  Free fv >>= k = Free ((k =<<) <$> fv)
  
instance Functor f => Applicative (Free f) where
  pure = return
  fg <*> fv = ap fg fv


liftF :: (Functor f) => f r -> Free f r
liftF command = Free (fmap Pure command)

--type Adder a = Free AdderF a
type Program a = Free Op a

push :: Double -> Program ()
push x
  = liftF $ Push x ()
add :: Program ()
add = liftF $ Add ()
multiply :: Program ()
multiply = liftF $ Multiply ()
done   = liftF  End


end
  = liftF End

--prog0 :: forall a. Program a 
prog0 = do
    push 3
    push 2
    add
    end
    --Push 3 $
      --Push 2 $
        --Add $
          --End

--prog :: forall a. Program a 
prog2 = do 
  push 2 
  push 2
  multiply 
  push 3 
  push 3 
  multiply 
  add
  end

modStack :: (a -> a -> a) -> [a] -> [a]
modStack f (x : x' : xs)
  = f x x' : xs
modStack _ xs
  = xs

newtype State s a = State { runState :: s -> (a,s) } 

instance Monad (State s) where  
    return x = State $ \s -> (x,s)  
    (State h) >>= f = State $ \s -> let (a, newState) = h s  
                                        (State g) = f a  
                                    in  g newState  

instance Functor (State s) where
  fmap = Control.Monad.liftM
  
instance Applicative (State s) where
  pure = return
  (<*>) = Control.Monad.ap

evalState :: State s a -> s -> a
evalState p s = fst (runState p s)

execState :: State s a -> s -> s
execState p s = snd (runState p s)

modify :: (s -> s) -> State s ()
modify f =
    State (\s -> ( (), f s ))

interpret prog
  = execState (interpret' prog) []
  where
    interpret' :: Program a -> State [Double] ()
    interpret' (Free (Push x next)) = do
      modify (x :)
      interpret' next
    interpret' (Free (Add next)) = do
      modify $ modStack (+)
      interpret' next
    interpret' (Free (Subtract next)) = do
      modify $ modStack (-)
      interpret' next
    interpret' (Free (Multiply next)) = do
      modify $ modStack (*)
      interpret' next
    interpret' (Free (Divide next)) = do
      modify $ modStack (/)
      interpret' next
    interpret' (Free End)
      = return ()

main = do
  print $ interpret prog0
  print $ interpret prog2
  print "check it out"