1

I am trying to extend toy example explained in this blog post.

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}

module FreeToy where

import Control.Monad.State
import Control.Monad.Free
import Data.Map (Map)
import qualified Data.Map as M


-- defining commands
data Toy a next = 
          Output a next
        | AnnoyingOutput a (String -> next)
        | Done
        deriving (Functor)

-- lifing commands to free monad level
output :: a -> Free (Toy a) ()
output x = liftF $ Output x ()

annoyingOutput :: a -> Free (Toy a) {-some type-}
annoyingOutput x = liftF $ AnnoyingOutput x {-some function-}

done :: Free (Toy a) r
done = liftF $ Done

-- defining one of the interpreter
runToy :: (Show a, Show r) => Free (Toy a) r -> String
runToy (Free (Output a x)) =
    "output " ++ show a ++ "\n" ++ runToy x
runToy (Free (AnnoyingOutput a f)) = 
    "annoying output " ++ show a ++ runToy (f "blah blah blah \n")
runToy (Free Done) =
    "done\n"
runToy (Pure r) =
    "return " ++ show r ++ "\n"

The new thing I tried to add is AnnoyingOutput a (String -> next) this will take some thing and return String message. I am struct while lifting it to Free monad level using liftF function. Please help me to fill the blanks, and proper explanation is appreciable.

Edit: Adding example

module Main where

import FreeToy
import Control.Monad.Free

program ::  Free (Toy String) ()

program = do
      output "something"
      x <- annoyingOutput "something else"
      output x
      done

main :: IO ()
main = putStrLn $ runToy program
venu gangireddy
  • 107
  • 1
  • 8
  • Can you add an example of how you'd like to use these functions? – Bergi Sep 05 '16 at 15:54
  • @Bergi example is added, please note that this program not yet compiled, so please expect some bugs – venu gangireddy Sep 05 '16 at 16:01
  • 1
    I don't see in that example why or how the type of an annoying output would be any different from an ordinary output? What do you mean by "*will take some thing and return String message*"? – Bergi Sep 05 '16 at 16:05
  • I edited it again, please refresh question – venu gangireddy Sep 05 '16 at 16:06
  • My hunch would be that the type is `String` and the function is `id`, but I'm not sure – Bergi Sep 05 '16 at 16:14
  • Btw your `runToy` seems to miss the `Pure` case – Bergi Sep 05 '16 at 16:18
  • Yes, something wrong with `runToy` Errors : 1. Couldn't match expected type ‘Free (Toy a) r -> String’ with actual type ‘[Char]’ 2. Couldn't match expected type ‘[Char]’ with actual type ‘Free (Toy a0) r0 -> String’ – venu gangireddy Sep 05 '16 at 16:18
  • @Bergi Pure case added, still unable resolve above errors. any suggestions? – venu gangireddy Sep 05 '16 at 16:27
  • There are examples of how to write things like `annoyingOutput` in the answer to [this related question](http://stackoverflow.com/q/23766419/414413). `annoyingOutput` will look like `add`. – Cirdec Sep 05 '16 at 18:08
  • 1
    The `$` in `runToy $ f "blah blah blah \n"` should be replaced `runToy (f "blah blah blah \n")` – Michael Sep 05 '16 at 21:42
  • 1
    The type is `annoyingOutput :: a -> Free (Toy a) String; annoyingOutput x = liftF $ AnnoyingOutput x id`. This means that properly the run function should have access to a source of Strings where you just keep feeding it `"blah blah blah \n"` – Michael Sep 05 '16 at 21:44
  • @Michael thanks for the tip, actually it helped a lot. Can you please explain the difference between `runToy $ f "blah blah blah \n"` should be replaced `runToy (f "blah blah blah \n")`? in general `$` and `()` can be replaceable, why it is different in this case? – venu gangireddy Sep 06 '16 at 13:17
  • venu, it's just the ultra-low precedence of `$` is interfering with what you want which is something shaped like `... ++ ... ++ ...` The `$` has `infixr 0` so ghc is reading it as the dominant connective in the expression, so as something shaped like `... $ ...` which then it can't understand. You want the $ to be to be restricted to the last thing appended - you could also write `(runToy $ f "blah blah blah \n")` to control the `$`, but once you use parantheses you might as well put them around `(f "blah ..)`. You can query precedence in the ghci with `:i ++` or `:info $` or the like. – Michael Sep 06 '16 at 16:08

0 Answers0