A blog post for Data.Reflection

blogpost.lhs

(This code uses Data.{Reflection,Tagged} which are not in standard
 modules, So you need to run "cabal install reflection" to install
 them before loading it)

Normally, in LL (Lightweight Languages) such as Ruby or Perl, mocking
is very easy. It means just overwriting a function to be mocked. But I
want to do this in haskell. Every functions are immutable, so I can't
overwrite it.

So, in LL, If overwriting is not apporopriate, as usual, mocked
functions are passed as an argument. Becaouse functions are
first-order in them, as in Haskell too. But in Haskell, taking another
argument means needing to change a type of the function. I don't want
to do this.

In this post, I propose more Haskellish way to mock. Using Relection
and Type class, We can inject behavior of functions from outside.

Before actual coding, turn on some Language Extensions.

> {-# LANGUAGE
>     UndecidableInstances
>   , FlexibleContexts
>   , Rank2Types
>   , NoMonomorphismRestriction
>   , GeneralizedNewtypeDeriving
>   , StandaloneDeriving
>   #-}

Couple of extensions are activated, But important extensions are

- UndecidableInstances
- FlexibleContexts
- Rank2Types

These are necessary for this. Others are just for convinience.

And import some modules.

> import Control.Monad.Writer
> import Control.Monad.State
> import Control.Applicative
> import Data.Reflection
> import Data.Tagged

Assuming we have a function that prints out given string with newline
named "say", It can be defined as

< say :: String -> IO ()
< say = putStrLn

So simple Hello World program is

> hello_world = say "Hello, World"

But this say function is not polymorphic, cannot be mocked. Let's make
it polymorphic.

> class (Monad m) => Say m where
>     say :: String -> m ()

> instance Say IO where
>     say = putStrLn

So now, hello_world's type is changed from IO () to (Say m) => m
(). when it is called from REPL, m is defaulted to IO.

  *Main> hello_world
  Hello, World

(Yes, I changed the type of the function, but it cannot be avoided but
 doesn't add arguments, adds just an context. I think it is not bad)

Next, create a way to control say's behavior. Below code will do this,
but it is almost a copy of the code in
http://comonad.com/reader/2009/clearer-reflection/

> newtype WrapSay s m a = Wrap { unWrap :: m a }
> deriving instance (Monad m) => Monad (WrapSay s m)
> deriving instance (MonadIO m) => MonadIO (WrapSay s m)

> wrapTag :: WrapSay s m a -> Tagged s (m a)
> wrapTag = Tagged . unWrap
> tagWrap :: Tagged s (m a) -> WrapSay s m a
> tagWrap = Wrap . unTagged

> instance (Monad m, s `Reifies` String -> m ()) => Say (WrapSay s m) where
>     say str = tagWrap (reflect <*> pure str)

> sayWith :: (String -> m ())
>         -> (forall s. (s `Reifies` String -> m ()) => WrapSay s m r)
>         -> m r
> sayWith sayFunc wrapped = reify sayFunc (wrapTag wrapped)

sayWith injects say's definition to inside of WrapSay Monad.

  *Main> sayWith (putStrLn . reverse) hello_world
  dlroW ,olleH

A function to inject can be any monadic function.

> outputOf = execWriter . sayWith (tell . (++"\n"))

  *Main> outputOf hello_world
  "Hello, World\n"

Now, Hello World program can be tested like

> test_hello_world :: (forall m s. (Say (WrapSay s m)) => WrapSay s m ())
>                  -> Bool
> test_hello_world action = outputOf action == "Hello, World\n"

Above function takes an action saying something, then return a Bool
value represents whether the action says just "Hello, World\n"

  *Main> test_hello_world hello_world
  True

The type variables of a first argument of test_hello_world should be
forall'd for the type checker.

mock.hs

-- | Straight implementation of Helloworld.
hello_world :: IO ()
hello_world = putStrLn "Hello, World"

-- | Testable implementation of Helloworld.
hello_with :: (Monad m) => Print m -> m ()
hello_with print = withNewline print "Hello, World"

-- | Container of Print function.
data Print m = Print { doPrint :: String -> m () }

-- | Print function which does actual printing.
io_print :: Print IO
io_print = Print putStr

-- | Utility for adding output to Newline.
withNewline :: (Monad m) => Print m -> String -> m ()
withNewline print = doPrint print . (++"\n")

-- | Output represents output string to stdout.
newtype Output = Output String
  deriving (Show)

-- | Mocked Monad. This is writer monad for /Output/.
newtype Mocked a = Mock { unMock :: (Output,a) }

instance Monad Mocked where
    return a = Mock (Output "", a)
    m >>= f = let (Output s,a)  = unMock m
                  (Output s',b) = unMock $ f a
              in Mock (Output $ s++s',b)

-- | Mocked Printer
mock_print :: Print Mocked
mock_print = Print $ \s -> Mock (Output s, ())

-- | Getting output string of Mocked action.
getOutputOf :: Mocked a -> Output
getOutputOf = fst . unMock

-- | Testing whether output satisfies given predicate.
doesOutputSatisfy :: (String -> Bool) -> Mocked a -> Bool
doesOutputSatisfy pred action =
  case getOutputOf action of
    Output output -> pred output

-- | Testing whether output equals to given string.
isOutput :: String -> Mocked a -> Bool
isOutput = doesOutputSatisfy . (==)

main :: IO ()
main = do
  -- test if hello world program is ok
  print (isOutput "Hello, World\n" (hello_with mock_print))
  -- running hello world in real world
  hello_with io_print