Freeモナドのスコット・エンコーディングによる実装ですー＞ω＜ kazu-yamamoto氏のhttps://gist.github.com/kazu-yamamoto/4064634#file-gistfile1-hs-L76を参考にさせていただきましたのです(｀・ω・´)

Scott.hs

{-# LANGUAGE Rank2Types, DeriveFunctor, LambdaCase #-}
module Control.Monad.Free.Scott (($|), Free(..), free', pure', liftF) where

infixl 1 $|
($|) :: (a -> b) -> a -> b
f $| x = f x

-- Type

newtype Free f a = Free {
  matchFree :: forall r. (f (Free f a) -> r) -- Free (f (Free f a))
                      -> (a -> r)             -- Pure a
                      -> r }

-- Constructors

free' :: (f (Free f a)) -> Free f a
free' x = Free $ \f p-> f x

pure' :: a -> Free f a
pure' x = Free $ \f p-> p x

-- Instances

instance Functor f => Functor (Free f) where
  fmap f x = matchFree x
    $| (\y -> free' $ fmap (fmap f) y)
    $| (\x'-> pure' $ f x')

instance Functor f => Monad (Free f) where
  return x = pure' x
  x >>= f = matchFree x
    $| (\y -> free' $ fmap (>>= f) y)
    $| (\x'-> f x')

-- Functions

liftF :: Functor f => f r -> Free f r
liftF = free' . fmap pure'

usage.hs

{-# LANGUAGE Rank2Types, DeriveFunctor, LambdaCase #-}
import Control.Monad.Free.Scott
import Test.QuickCheck (quickCheck)

type CharIO = Free CharActions

data CharActions a
  = PutCh Char a
  | GetCh (Char -> a)
  deriving (Functor)

putCh :: Char -> CharIO ()
putCh c = liftF $ PutCh c ()

getCh :: CharIO Char
getCh = liftF $ GetCh id

runCharIO :: CharIO a -> IO ()
runCharIO x = matchFree x
  $| (\case
    PutCh c x'-> putChar c >> runCharIO x'
    GetCh f   -> getChar >>= runCharIO . f)
  $| (\_-> return ())

echo :: CharIO ()
echo = do
  getCh >>= putCh
  echo

main = runCharIO echo

data Output a
  = Print Char (Output a)
  | Read (Output a)
  | Return a
  | EOF
  deriving (Eq, Show)

toOutput :: CharIO a -> String -> Output a
toOutput x cs = matchFree x
  $| (\case
    PutCh c x'-> Print c (toOutput x' cs)
    GetCh f
      |null cs   -> EOF
      |otherwise -> Read $ toOutput (f $ head cs) $ tail cs)
  $| (\x-> Return x)

copy :: String -> Output a
copy "" = EOF
copy (c:cs) = Read $ Print c $ copy cs

propEcho :: String -> Bool
propEcho s = toOutput echo s == copy s

test :: IO ()
test = quickCheck propEcho