SimpleApp to LiteApp

yesod-core/Yesod/Core.hs

@@ -57,8 +57,8 @@ module Yesod.Core
     , yesodVersion
     , yesodRender
     , runFakeHandler
-      -- * SimpleApp
-    , module Yesod.Core.Internal.SimpleApp
+      -- * LiteApp
+    , module Yesod.Core.Internal.LiteApp
       -- * Re-exports
     , module Yesod.Core.Content
     , module Yesod.Core.Dispatch
@@ -98,7 +98,7 @@ import Yesod.Routes.Class
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Base (MonadBase (..))
 import Control.Monad.Trans.Control (MonadBaseControl (..))
-import Yesod.Core.Internal.SimpleApp
+import Yesod.Core.Internal.LiteApp
 
 -- | Return an 'Unauthorized' value, with the given i18n message.
 unauthorizedI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> m AuthResult

yesod-core/Yesod/Core/Internal/LiteApp.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PatternGuards #-}
+module Yesod.Core.Internal.LiteApp where
+
+import Yesod.Routes.Dispatch
+import Yesod.Routes.Class
+import Data.Monoid
+import Yesod.Core.Class.Yesod
+import Yesod.Core.Class.Dispatch
+import Yesod.Core.Types
+import Yesod.Core.Content
+import Data.Text (Text)
+import Web.PathPieces
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.ByteString (ByteString)
+import Network.Wai
+import Yesod.Core.Handler
+import Yesod.Core.Internal.Run
+import Network.HTTP.Types (Method)
+import Data.Maybe (fromMaybe)
+import Control.Applicative ((<|>))
+
+newtype LiteApp = LiteApp
+    { unLiteApp :: Method -> [Text] -> Maybe (LiteHandler TypedContent)
+    }
+
+instance Yesod LiteApp
+
+instance YesodDispatch LiteApp where
+    yesodDispatch yre req =
+        yesodRunner
+            (fromMaybe notFound $ f (requestMethod req) (pathInfo req))
+            yre
+            (Just $ LiteAppRoute $ pathInfo req)
+            req
+      where
+        LiteApp f = yreSite yre
+
+instance RenderRoute LiteApp where
+    data Route LiteApp = LiteAppRoute [Text]
+        deriving (Show, Eq, Read, Ord)
+    renderRoute (LiteAppRoute x) = (x, [])
+instance ParseRoute LiteApp where
+    parseRoute (x, _) = Just $ LiteAppRoute x
+
+instance Monoid LiteApp where
+    mempty = LiteApp $ \_ _ -> Nothing
+    mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps
+
+type LiteHandler = HandlerT LiteApp IO
+type LiteWidget = WidgetT LiteApp IO
+
+dispatchTo :: ToTypedContent a => LiteHandler a -> LiteApp
+dispatchTo handler = LiteApp $ \_ ps ->
+    if null ps
+        then Just $ fmap toTypedContent handler
+        else Nothing
+
+onMethod :: Method -> LiteApp -> LiteApp
+onMethod method (LiteApp f) = LiteApp $ \m ps ->
+    if method == m
+        then f m ps
+        else Nothing
+
+onStatic :: Text -> LiteApp -> LiteApp
+onStatic p0 (LiteApp f) = LiteApp $ \m ps0 ->
+    case ps0 of
+        p:ps | p == p0 -> f m ps
+        _ -> Nothing
+
+withDynamic :: PathPiece p => (p -> LiteApp) -> LiteApp
+withDynamic f = LiteApp $ \m ps0 ->
+    case ps0 of
+        p:ps | Just v <- fromPathPiece p -> unLiteApp (f v) m ps
+        _ -> Nothing
+
+withDynamicMulti :: PathMultiPiece ps => (ps -> LiteApp) -> LiteApp
+withDynamicMulti f = LiteApp $ \m ps ->
+    case fromPathMultiPiece ps of
+        Nothing -> Nothing
+        Just v -> unLiteApp (f v) m []

yesod-core/Yesod/Core/Internal/SimpleApp.hs

@@ -1,82 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PatternGuards #-}
-module Yesod.Core.Internal.SimpleApp where
-
-import Yesod.Routes.Dispatch
-import Yesod.Routes.Class
-import Data.Monoid
-import Yesod.Core.Class.Yesod
-import Yesod.Core.Class.Dispatch
-import Yesod.Core.Types
-import Yesod.Core.Content
-import Data.Text (Text)
-import Web.PathPieces
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.ByteString (ByteString)
-import Network.Wai
-import Yesod.Core.Handler
-import Yesod.Core.Internal.Run
-import Network.HTTP.Types (Method)
-import Data.Maybe (fromMaybe)
-import Control.Applicative ((<|>))
-
-newtype SimpleApp = SimpleApp
-    { unSimpleApp :: Method -> [Text] -> Maybe (SimpleHandler TypedContent)
-    }
-
-instance Yesod SimpleApp
-
-instance YesodDispatch SimpleApp where
-    yesodDispatch yre req =
-        yesodRunner
-            (fromMaybe notFound $ f (requestMethod req) (pathInfo req))
-            yre
-            (Just $ SimpleAppRoute $ pathInfo req)
-            req
-      where
-        SimpleApp f = yreSite yre
-
-instance RenderRoute SimpleApp where
-    data Route SimpleApp = SimpleAppRoute [Text]
-        deriving (Show, Eq, Read, Ord)
-    renderRoute (SimpleAppRoute x) = (x, [])
-instance ParseRoute SimpleApp where
-    parseRoute (x, _) = Just $ SimpleAppRoute x
-
-instance Monoid SimpleApp where
-    mempty = SimpleApp $ \_ _ -> Nothing
-    mappend (SimpleApp x) (SimpleApp y) = SimpleApp $ \m ps -> x m ps <|> y m ps
-
-type SimpleHandler = HandlerT SimpleApp IO
-type SimpleWidget = WidgetT SimpleApp IO
-
-dispatchTo :: ToTypedContent a => SimpleHandler a -> SimpleApp
-dispatchTo handler = SimpleApp $ \_ ps ->
-    if null ps
-        then Just $ fmap toTypedContent handler
-        else Nothing
-
-onMethod :: Method -> SimpleApp -> SimpleApp
-onMethod method (SimpleApp f) = SimpleApp $ \m ps ->
-    if method == m
-        then f m ps
-        else Nothing
-
-onStatic :: Text -> SimpleApp -> SimpleApp
-onStatic p0 (SimpleApp f) = SimpleApp $ \m ps0 ->
-    case ps0 of
-        p:ps | p == p0 -> f m ps
-        _ -> Nothing
-
-withDynamic :: PathPiece p => (p -> SimpleApp) -> SimpleApp
-withDynamic f = SimpleApp $ \m ps0 ->
-    case ps0 of
-        p:ps | Just v <- fromPathPiece p -> unSimpleApp (f v) m ps
-        _ -> Nothing
-
-withDynamicMulti :: PathMultiPiece ps => (ps -> SimpleApp) -> SimpleApp
-withDynamicMulti f = SimpleApp $ \m ps ->
-    case fromPathMultiPiece ps of
-        Nothing -> Nothing
-        Just v -> unSimpleApp (f v) m []

yesod-core/test/YesodCoreTest.hs

@@ -16,7 +16,7 @@ import qualified YesodCoreTest.RequestBodySize as RequestBodySize
 import qualified YesodCoreTest.Json as Json
 import qualified YesodCoreTest.Reps as Reps
 import qualified YesodCoreTest.Auth as Auth
-import qualified YesodCoreTest.SimpleApp as SimpleApp
+import qualified YesodCoreTest.LiteApp as LiteApp
 
 import Test.Hspec
 
@@ -38,4 +38,4 @@ specs = do
       Json.specs
       Reps.specs
       Auth.specs
-      SimpleApp.specs
+      LiteApp.specs

yesod-core/test/YesodCoreTest/LiteApp.hs

@@ -1,4 +1,4 @@
-module YesodCoreTest.SimpleApp (specs) where
+module YesodCoreTest.LiteApp (specs) where
 
 import Yesod.Core
 import Test.Hspec
@@ -14,7 +14,7 @@ iapp = toWaiApp $
     onMethod (S8.pack "GET") (dispatchTo $ return "GetHomepage") <>
     onMethod (S8.pack "POST") (dispatchTo $ return "PostHomepage") <>
     onStatic (T.pack "string") (withDynamic (\t -> dispatchTo $ return (t :: T.Text))) <>
-    onStatic (T.pack "multi") (withDynamicMulti (\[x, y] -> dispatchTo $ return (y :: T.Text)))
+    onStatic (T.pack "multi") (withDynamicMulti (\[_, y] -> dispatchTo $ return (y :: T.Text)))
 
 test :: String -- ^ method
      -> [String] -- ^ path
@@ -32,7 +32,7 @@ test method path expected = it (method ++ " " ++ show path) $ do
             Right b -> assertBody (L8.pack b) sres
 
 specs :: Spec
-specs = describe "SimpleApp" $ do
+specs = describe "LiteApp" $ do
     test "GET" [] $ Right "GetHomepage"
     test "POST" [] $ Right "PostHomepage"
     -- test "PUT" [] $ Left 405

yesod-core/yesod-core.cabal

@@ -35,7 +35,7 @@ extra-source-files:
   test/YesodCoreTest/Widget.hs
   test/YesodCoreTest/YesodTest.hs
   test/YesodCoreTest/Auth.hs
-  test/YesodCoreTest/SimpleApp.hs
+  test/YesodCoreTest/LiteApp.hs
   test/en.msg
   test/test.hs
 
@@ -107,7 +107,7 @@ library
                      Yesod.Core.Internal.Response
                      Yesod.Core.Internal.Run
                      Yesod.Core.Internal.TH
-                     Yesod.Core.Internal.SimpleApp
+                     Yesod.Core.Internal.LiteApp
                      Yesod.Core.Class.Yesod
                      Yesod.Core.Class.Dispatch
                      Yesod.Core.Class.Breadcrumbs