fix Travis on old GHC by using a Monad impl which doesn't depend on A…

…pplicative

benchmarks/IO.hs

@@ -3,12 +3,13 @@ module Main where
 
 import Lucid
 import Criterion.Main
+import Control.Applicative (Applicative)
 import Control.Monad (replicateM_)
 import qualified Data.Text.Lazy as LT
 import Control.Monad.Trans.Reader (runReader)
 import Data.Functor.Identity (runIdentity)
 
-lotsOfDivs :: Monad m => Int -> HtmlT m ()
+lotsOfDivs :: (Applicative m, Monad m) => Int -> HtmlT m ()
 lotsOfDivs n = body_
   $ replicateM_ n
   $ div_ "hello world!"

src/Lucid/Base.hs

@@ -140,7 +140,7 @@ instance Functor m => Functor (HtmlT m) where
 
 -- | Basically acts like Writer.
 instance Monad m => Monad (HtmlT m) where
-  return = pure
+  return a = HtmlT (return (mempty,a))
   {-# INLINE return #-}
 
   m >>= f = HtmlT $ do
@@ -149,7 +149,10 @@ instance Monad m => Monad (HtmlT m) where
     return (g <> h,b)
   {-# INLINE (>>=) #-}
 
-  (>>) = (*>)
+  m >> n = HtmlT $ do
+    ~(g, _) <- runHtmlT m
+    ~(h, b) <- runHtmlT n
+    return (g <> h, b)
   {-# INLINE (>>) #-}
 
 -- | Used for 'lift'.
@@ -310,12 +313,12 @@ class TermRaw arg result | result -> arg where
            -> result        -- ^ Result: either an element or an attribute.
 
 -- | Given attributes, expect more child input.
-instance (Monad m,ToHtml f, a ~ ()) => TermRaw [Attribute] (f -> HtmlT m a) where
+instance (Functor m, Monad m,ToHtml f, a ~ ()) => TermRaw [Attribute] (f -> HtmlT m a) where
   termRawWith name f attrs = with (makeElement name) (attrs <> f) . toHtmlRaw
 
 -- | Given children immediately, just use that and expect no
 -- attributes.
-instance (Monad m,a ~ ()) => TermRaw Text (HtmlT m a) where
+instance (Functor m, Monad m,a ~ ()) => TermRaw Text (HtmlT m a) where
   termRawWith name f = with (makeElement name) f . toHtmlRaw
 
 -- | Some termRaws (like 'Lucid.Html5.style_', 'Lucid.Html5.title_') can be used for

src/Lucid/Html5.hs

@@ -8,6 +8,7 @@ module Lucid.Html5 where
 
 import           Lucid.Base
 
+import           Control.Applicative
 import           Data.Monoid
 import           Data.Text (Text, unwords)
 

test/Main.hs

@@ -10,6 +10,7 @@ import Lucid
 import Lucid.Base
 import Lucid.Bootstrap
 
+import Control.Applicative
 import Control.Monad.State.Strict
 
 import Example1
@@ -206,7 +207,7 @@ testCommuteHtmlT =
   where
     example = renderText $ evalState (commuteHtmlT exampleHtml) 1
 
-    exampleHtml :: MonadState Int m => HtmlT m ()
+    exampleHtml :: (Applicative m, MonadState Int m) => HtmlT m ()
     exampleHtml = ul_ $ replicateM_ 5 $ do
       x <- get
       put (x + 1)