import Data.Monoid
import Control.Monad


newtype Writer_ w a = Writer_ { runWriter_ :: (a, w) }
  deriving (Show)

instance Monoid w => Monad (Writer_ w) where
 -- return :: a -> Writer_ a w
    return a = Writer_ (a, mempty)

 -- (>>=) :: Writer_ a w -> (a -> Writer_ w b) -> Writer_ w b
    Writer_ (a, w1) >>= f =
      let Writer_ (b, w2) = f a in
      Writer_ (b, w1 <> w2)

instance Monoid w => Applicative (Writer_ w) where {pure = return; (<*>) = ap}
instance Monoid w => Functor     (Writer_ w) where {fmap f x = pure f <*> x}


tell :: w -> Writer_ w ()
tell w = Writer_ ((), w)

censor :: (w -> w) -> Writer_ w a -> Writer_ w a
censor f = Writer_ . fmap f . runWriter_


data ChattyFunc a b =
  ChattyFunc { name :: String, call :: a -> b }

type Chatty b =
  Writer_ [String] b

applyChattyFunc :: (Show a, Show b) => ChattyFunc a b -> a -> Chatty b
applyChattyFunc chattyFunc a =
  let
    b = call chattyFunc a
    s = name chattyFunc ++ " " ++ show a ++ " = " ++ show b
  in
    Writer_ (b, [s])

printLog :: Chatty a -> IO ()
printLog = putStrLn . unlines . snd . runWriter_
 
square = ChattyFunc "square" (^2)
double = ChattyFunc "double" (2*)

{-
doubleSquareDouble :: Int -> Chatty Int
doubleSquareDouble n0 =
  let
    w0               = "Calling doubleSquareDouble"
    Writer_ (n1, w1) = applyChattyFunc double n0
    Writer_ (n2, w2) = applyChattyFunc square n1
    Writer_ (n3, w3) = applyChattyFunc double n2
  in
    Writer_ (n3, w0 <> w1 <> w2 <> w3)
-}

doubleSquareDouble :: Int -> Chatty Int
doubleSquareDouble n0 = do
  tell ["Calling doubleSquareDouble"]
  n1 <- applyChattyFunc double n0
  n2 <- applyChattyFunc square n1
  n3 <- applyChattyFunc double n2
  pure n3