nested-routes 0.3 → 0.3.1

raw patch · 13 files changed

+486/−175 lines, 13 filesdep ~pred-triePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: pred-trie

API changes (from Hackage documentation)

Files

• nested-routes.cabal +10/−2
• src/Web/Routes/Nested.hs +13/−15
• src/Web/Routes/Nested/FileExtListener.hs +10/−148
• src/Web/Routes/Nested/FileExtListener/Blaze.hs +66/−0
• src/Web/Routes/Nested/FileExtListener/Builder.hs +38/−0
• src/Web/Routes/Nested/FileExtListener/ByteString.hs +37/−0
• src/Web/Routes/Nested/FileExtListener/Json.hs +105/−0
• src/Web/Routes/Nested/FileExtListener/Lucid.hs +82/−0
• src/Web/Routes/Nested/FileExtListener/Text.hs +69/−0
• src/Web/Routes/Nested/FileExtListener/Types.hs +51/−0
• src/Web/Routes/Nested/Types.hs +0/−5
• src/Web/Routes/Nested/Types/UrlChunks.hs +5/−0
• src/Web/Routes/Nested/VerbListener.hs +0/−5

@@ -1,10 +1,11 @@ Name:                   nested-routes-Version:                0.3+Version:                0.3.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3 License-File:           LICENSE Synopsis:               Declarative, compositional Wai responses+Category:               Web Description:   A method to writing Wai responses   .@@ -110,6 +111,13 @@                         Web.Routes.Nested.Types.UrlChunks                         Web.Routes.Nested.VerbListener                         Web.Routes.Nested.FileExtListener+                        Web.Routes.Nested.FileExtListener.Types+                        Web.Routes.Nested.FileExtListener.Text+                        Web.Routes.Nested.FileExtListener.Json+                        Web.Routes.Nested.FileExtListener.Builder+                        Web.Routes.Nested.FileExtListener.Blaze+                        Web.Routes.Nested.FileExtListener.ByteString+                        Web.Routes.Nested.FileExtListener.Lucid   Build-Depends:        base >= 4.6 && < 5                       , wai                       , wai-extra@@ -125,7 +133,7 @@                       , lucid                       , bytestring                       , attoparsec-                      , pred-trie >= 0.0.12+                      , pred-trie >= 0.1                       , poly-arity >= 0.0.3  Test-Suite spec

@@ -37,26 +37,20 @@  import           Network.HTTP.Types import           Network.Wai-import           Network.Wai.Middleware.AddHeaders  import           Control.Applicative-import           Control.Arrow                     (second, first, (***)) import           Control.Monad.IO.Class import           Control.Monad.Trans import           Control.Monad.Writer import           Control.Monad.Reader-import qualified Data.List.NonEmpty                as NE-import           Data.Monoid import           Data.Trie.Pred.Unified import qualified Data.Trie.Pred.Unified            as P-import           Data.Traversable import qualified Data.Text                         as T import qualified Data.Map.Lazy                     as M import qualified Data.ByteString.Lazy              as BL import           Data.Maybe                        (fromMaybe) import           Data.Constraint -import Data.Trie.Pred.Unified import Data.Function.Poly  @@ -226,23 +220,24 @@   case mMethod of     Just v -> do       menf <- handleNotFound mFileext v meitherNotFound+       let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req       case P.lookup cleanedPathInfo rtrie of-        Just eitherM -> continue mFileext v eitherM $ menf+        Just eitherM -> continue mFileext v eitherM menf         Nothing  -> case pathInfo req of-          [] -> liftIO $ respond404 $ menf+          [] -> liftIO $ respond404 menf           _  -> case trimFileExt $ last $ pathInfo req of             "index" -> case P.lookup (init $ pathInfo req) rtrie of-              Just eitherM -> continue mFileext v eitherM $ menf-              Nothing -> liftIO $ respond404 $ menf-            _ -> liftIO $ respond404 $ menf-    _ -> liftIO $ respond404 $ notFoundBasic+              Just eitherM -> continue mFileext v eitherM menf+              Nothing -> liftIO $ respond404 menf+            _ -> liftIO $ respond404 menf+    _ -> liftIO $ respond404 notFoundBasic    where     handleNotFound :: MonadIO m =>                       Maybe FileExt                    -> Verb-                   -> Maybe ( Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()) )+                   -> Maybe (EitherResponse z m)                    -> m (Maybe Response)     handleNotFound mf v meitherNotFound = case meitherNotFound of       Just (Left litmonad) -> case mf of@@ -265,7 +260,7 @@     continue :: MonadIO m =>                 Maybe FileExt              -> Verb-             -> Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ())+             -> EitherResponse z m              -> Maybe Response              -> m ResponseReceived     continue mf v eitherM mnfResp = case eitherM of@@ -332,7 +327,10 @@         Nothing -> liftIO $ respond404 mnfResp  +    respond404 :: Maybe Response -> IO ResponseReceived     respond404 mr = respond $ fromMaybe plain404 mr++    plain404 :: Response     plain404 = responseLBS status404 [("Content-Type","text/plain")] "404"      lookupMin :: Ord k => k -> M.Map k a -> Maybe a@@ -340,7 +338,7 @@                     | otherwise              = M.lookup k map      applyToLast :: (a -> a) -> [a] -> [a]-    applyToLast f [] = []+    applyToLast _ [] = []     applyToLast f (x:[]) = f x : []     applyToLast f (x:xs) = x : applyToLast f xs 

@@ -1,149 +1,11 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE StandaloneDeriving         #-}--module Web.Routes.Nested.FileExtListener where--import qualified Data.Aeson              as A-import qualified Data.Text               as T-import qualified Data.Text.Lazy          as LT-import qualified Data.Text.Lazy.Encoding as LT-import qualified Data.ByteString.Lazy    as B-import qualified Data.ByteString.Builder as BU-import qualified Text.Blaze.Html         as H-import qualified Text.Blaze.Html.Renderer.Text as H-import qualified Lucid.Base              as L-import           Network.HTTP.Types      (status200, RequestHeaders)-import           Network.Wai--import           Control.Applicative-import           Control.Monad.Trans-import           Control.Monad.Writer-import           Data.Monoid-import           Data.Map.Lazy-import           Data.Traversable-import           Data.Foldable hiding (elem)---data FileExt = Html-             | Json-             | Text-  deriving (Show, Eq, Ord)---toExt :: T.Text -> Maybe FileExt-toExt x | x `elem` htmls = Just Html-        | x `elem` jsons = Just Json-        | x `elem` texts = Just Text-        | otherwise      = Nothing-  where-    htmls = ["", ".htm", ".html"]-    jsons = [".json"]-    texts = [".txt"]--newtype FileExts a = FileExts { unFileExts :: Map FileExt a }-  deriving (Show, Eq, Functor, Traversable)--deriving instance Monoid      (FileExts a)-deriving instance Foldable     FileExts---newtype FileExtListenerT r m a =-  FileExtListenerT { runFileExtListenerT :: WriterT (FileExts r) m a }-    deriving (Functor)--deriving instance Applicative m => Applicative (FileExtListenerT r m)-deriving instance Monad m =>       Monad       (FileExtListenerT r m)-deriving instance MonadIO m =>     MonadIO     (FileExtListenerT r m)-deriving instance                  MonadTrans  (FileExtListenerT r)---json :: (A.ToJSON j, Monad m) =>-        j -> FileExtListenerT Response m ()-json i =-  let r = responseLBS status200 [("Content-Type", "application/json")] $-            A.encode i in-  FileExtListenerT $ tell $-    FileExts $ singleton Json r--jsonOnly :: (A.ToJSON j) =>-            j -> Response-jsonOnly i =-  responseLBS status200 [("Content-Type", "application/json")] $ A.encode i--jsonp :: (A.ToJSON j, Monad m) =>-         j -> FileExtListenerT Response m ()-jsonp i =-  let r = responseLBS status200 [("Content-Type", "application/javascript")] $-            A.encode i in-  FileExtListenerT $ tell $-    FileExts $ singleton Json r--jsonpOnly :: (A.ToJSON j) =>-            j -> Response-jsonpOnly i =-  responseLBS status200 [("Content-Type", "application/javascript")] $ A.encode i--text :: (Monad m) =>-        LT.Text -> FileExtListenerT Response m ()-text i =-  let r = responseLBS status200 [("Content-Type", "text/plain")] $-            LT.encodeUtf8 i in-  FileExtListenerT $ tell $-    FileExts $ singleton Text r--textOnly :: LT.Text -> Response-textOnly i =-  responseLBS status200 [("Content-Type", "text/plain")] $ LT.encodeUtf8 i--blaze :: (Monad m ) =>-         H.Html -> FileExtListenerT Response m ()-blaze i =-  let r = responseLBS status200 [("Content-Type", "text/html")] $-            LT.encodeUtf8 $ H.renderHtml i in-  FileExtListenerT $ tell $-    FileExts $ singleton Html r--blazeOnly :: H.Html -> Response-blazeOnly i =-  responseLBS status200 [("Content-Type", "text/html")] $ LT.encodeUtf8 $ H.renderHtml i--lucid :: (Monad m) =>-         L.HtmlT m () -> FileExtListenerT Response m ()-lucid i = do-  i' <- lift $ L.renderBST i-  let r = responseLBS status200 [("Content-Type", "text/html")] i'-  FileExtListenerT $ tell $-    FileExts $ singleton Html r--lucidOnly :: (Monad m) =>-             L.HtmlT m () -> m Response-lucidOnly i = do-  i' <- L.renderBST i-  return $ responseLBS status200 [("Content-Type", "text/html")] i'--builder :: (Monad m) =>-           BU.Builder -> RequestHeaders-        -> FileExt -> FileExtListenerT Response m ()-builder i hs e =-  let r = responseBuilder status200 hs i in-  FileExtListenerT $ tell $-    FileExts $ singleton e r--builderOnly :: BU.Builder -> RequestHeaders -> Response-builderOnly i hs =-  responseBuilder status200 hs i--bytestring :: (Monad m) =>-              B.ByteString -> RequestHeaders-           -> FileExt -> FileExtListenerT Response m ()-bytestring i hs e =-  let r = responseLBS status200 hs i in-  FileExtListenerT $ tell $-    FileExts $ singleton e r+module Web.Routes.Nested.FileExtListener+  ( module X+  ) where -bytestringOnly :: B.ByteString -> RequestHeaders -> Response-bytestringOnly i hs =-  responseLBS status200 hs i+import Web.Routes.Nested.FileExtListener.Types as X+import Web.Routes.Nested.FileExtListener.Builder as X+import Web.Routes.Nested.FileExtListener.ByteString as X+import Web.Routes.Nested.FileExtListener.Blaze as X+import Web.Routes.Nested.FileExtListener.Lucid as X+import Web.Routes.Nested.FileExtListener.Text as X+import Web.Routes.Nested.FileExtListener.Json as X

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.Blaze where++import           Web.Routes.Nested.FileExtListener.Types++import           Data.Map+import qualified Data.Text.Lazy.Encoding                 as LT+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai+import qualified Text.Blaze.Html                         as H+import qualified Text.Blaze.Html.Renderer.Text           as H++import           Control.Monad.Writer++++blaze :: Monad m => H.Html -> FileExtListenerT Response m ()+blaze i =+  let r = responseLBS status200 [("Content-Type", "text/html")] $+            LT.encodeUtf8 $ H.renderHtml i in+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++blazeHeaders :: Monad m => RequestHeaders -> H.Html -> FileExtListenerT Response m ()+blazeHeaders hs i =+  let r = responseLBS status200 hs $+            LT.encodeUtf8 $ H.renderHtml i in+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++blazeStatus :: Monad m => Status -> H.Html -> FileExtListenerT Response m ()+blazeStatus s i =+  let r = responseLBS s [("Content-Type", "text/html")] $+            LT.encodeUtf8 $ H.renderHtml i in+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++blazeStatusHeaders :: Monad m => Status -> RequestHeaders -> H.Html -> FileExtListenerT Response m ()+blazeStatusHeaders s hs i =+  let r = responseLBS s hs $+            LT.encodeUtf8 $ H.renderHtml i in+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++++blazeOnly :: H.Html -> Response+blazeOnly i =+  responseLBS status200 [("Content-Type", "text/html")] $ LT.encodeUtf8 $ H.renderHtml i++blazeOnlyHeaders :: RequestHeaders -> H.Html -> Response+blazeOnlyHeaders hs i =+  responseLBS status200 hs $ LT.encodeUtf8 $ H.renderHtml i++blazeOnlyStatus :: Status -> H.Html -> Response+blazeOnlyStatus s i =+  responseLBS s [("Content-Type", "text/html")] $ LT.encodeUtf8 $ H.renderHtml i++blazeOnlyStatusHeaders :: Status -> RequestHeaders -> H.Html -> Response+blazeOnlyStatusHeaders s hs i =+  responseLBS s hs $ LT.encodeUtf8 $ H.renderHtml i++

@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.Builder where++import           Web.Routes.Nested.FileExtListener.Types++import qualified Data.ByteString.Builder                 as BU+import           Data.Map+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai++import           Control.Monad.Writer+++-- | A builder is ambiguous, therefore we require @RequestHeaders@ and a @FileExt@ to be explicitly+-- supplied.+builder :: Monad m => FileExt -> RequestHeaders -> BU.Builder -> FileExtListenerT Response m ()+builder e hs i =+  let r = responseBuilder status200 hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton e r++builderStatus :: Monad m => FileExt -> Status -> RequestHeaders -> BU.Builder -> FileExtListenerT Response m ()+builderStatus e s hs i =+  let r = responseBuilder s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton e r++++builderOnly :: RequestHeaders -> BU.Builder -> Response+builderOnly = responseBuilder status200++-- | The exact same thing as @Network.Wai.responseBuilder@.+builderOnlyStatus :: Status -> RequestHeaders -> BU.Builder -> Response+builderOnlyStatus = responseBuilder

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.ByteString where++import           Web.Routes.Nested.FileExtListener.Types++import qualified Data.ByteString.Lazy                    as B+import           Data.Map+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai++import           Control.Monad.Writer+++-- | @ByteString@ is ambiguous - we need to know what @RequestHeaders@ and @FileExt@ should be associated.+bytestring :: Monad m => FileExt -> RequestHeaders -> B.ByteString -> FileExtListenerT Response m ()+bytestring e hs i =+  let r = responseLBS status200 hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton e r++bytestringStatus :: Monad m => FileExt -> Status -> RequestHeaders -> B.ByteString -> FileExtListenerT Response m ()+bytestringStatus e s hs i =+  let r = responseLBS s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton e r+++bytestringOnly :: RequestHeaders -> B.ByteString -> Response+bytestringOnly = responseLBS status200++-- | The exact same thing as @Network.Wai.responseLBS@.+bytestringOnlyStatus :: Status -> RequestHeaders -> B.ByteString -> Response+bytestringOnlyStatus = responseLBS+

@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.Json where++import           Web.Routes.Nested.FileExtListener.Types++import qualified Data.Aeson                              as A+import           Data.Map+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai++import           Control.Monad.Writer+++++json :: ( A.ToJSON j+        , Monad m ) =>+        j -> FileExtListenerT Response m ()+json i =+  let r = responseLBS status200 [("Content-Type", "application/json")] $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r++jsonStatus :: ( A.ToJSON j+        , Monad m ) =>+        Status -> j -> FileExtListenerT Response m ()+jsonStatus s i =+  let r = responseLBS s [("Content-Type", "application/json")] $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r++jsonp :: ( A.ToJSON j+        , Monad m ) =>+        j -> FileExtListenerT Response m ()+jsonp i =+  let r = responseLBS status200 [("Content-Type", "application/javascript")] $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r++jsonpStatus :: ( A.ToJSON j+        , Monad m ) =>+        Status -> j -> FileExtListenerT Response m ()+jsonpStatus s i =+  let r = responseLBS s [("Content-Type", "application/javascript")] $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r++jsonHeaders :: ( A.ToJSON j+        , Monad m ) =>+        RequestHeaders -> j -> FileExtListenerT Response m ()+jsonHeaders hs i =+  let r = responseLBS status200 hs $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r++jsonStatusHeaders :: ( A.ToJSON j+        , Monad m ) =>+        Status -> RequestHeaders -> j -> FileExtListenerT Response m ()+jsonStatusHeaders s hs i =+  let r = responseLBS s hs $+            A.encode i in+  FileExtListenerT $ tell $+    FileExts $ singleton Json r+++++jsonOnly :: A.ToJSON j =>+            j -> Response+jsonOnly i =+  responseLBS status200 [("Content-Type", "application/json")] $ A.encode i++jsonOnlyStatus :: A.ToJSON j =>+            Status -> j -> Response+jsonOnlyStatus s i =+  responseLBS s [("Content-Type", "application/json")] $ A.encode i++jsonpOnly :: A.ToJSON j =>+            j -> Response+jsonpOnly i =+  responseLBS status200 [("Content-Type", "application/javascript")] $ A.encode i++jsonpOnlyStatus :: A.ToJSON j =>+            Status -> j -> Response+jsonpOnlyStatus s i =+  responseLBS s [("Content-Type", "application/javascript")] $ A.encode i++jsonOnlyHeaders :: A.ToJSON j =>+            RequestHeaders -> j -> Response+jsonOnlyHeaders hs i =+  responseLBS status200 hs $ A.encode i++jsonOnlyStatusHeaders :: A.ToJSON j =>+            Status -> RequestHeaders -> j -> Response+jsonOnlyStatusHeaders s hs i =+  responseLBS s hs $ A.encode i+

@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.Lucid where++import           Web.Routes.Nested.FileExtListener.Types++import           Data.Map+import qualified Lucid.Base                              as L+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai++import           Control.Monad.Writer++++lucid :: Monad m =>+         L.HtmlT m () -> FileExtListenerT Response m ()+lucid i = do+  i' <- lift $ L.renderBST i+  let r = responseLBS status200 [("Content-Type", "text/html")] i'+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++lucidStatus :: Monad m =>+         Status -> L.HtmlT m () -> FileExtListenerT Response m ()+lucidStatus s i = do+  i' <- lift $ L.renderBST i+  let r = responseLBS s [("Content-Type", "text/html")] i'+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++lucidHeaders :: Monad m =>+         RequestHeaders -> L.HtmlT m () -> FileExtListenerT Response m ()+lucidHeaders hs i = do+  i' <- lift $ L.renderBST i+  let r = responseLBS status200 hs i'+  FileExtListenerT $ tell $+    FileExts $ singleton Html r++lucidStatusHeaders :: Monad m =>+         Status -> RequestHeaders -> L.HtmlT m () -> FileExtListenerT Response m ()+lucidStatusHeaders s hs i = do+  i' <- lift $ L.renderBST i+  let r = responseLBS s hs i'+  FileExtListenerT $ tell $+    FileExts $ singleton Html r+++++lucidOnly :: Monad m =>+             L.HtmlT m () -> m Response+lucidOnly i = do+  i' <- L.renderBST i+  return $ responseLBS status200 [("Content-Type", "text/html")] i'++lucidOnlyStatus :: Monad m =>+             Status -> L.HtmlT m () -> m Response+lucidOnlyStatus s i = do+  i' <- L.renderBST i+  return $ responseLBS s [("Content-Type", "text/html")] i'++lucidOnlyHeaders :: Monad m =>+             RequestHeaders -> L.HtmlT m () -> m Response+lucidOnlyHeaders hs i = do+  i' <- L.renderBST i+  return $ responseLBS status200 hs i'++lucidOnlyStatusHeaders :: Monad m =>+             Status -> RequestHeaders -> L.HtmlT m () -> m Response+lucidOnlyStatusHeaders s hs i = do+  i' <- L.renderBST i+  return $ responseLBS s hs i'+++++++

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+++module Web.Routes.Nested.FileExtListener.Text where++import           Web.Routes.Nested.FileExtListener.Types++import           Data.Map+import qualified Data.Text.Lazy                          as LT+import qualified Data.Text.Lazy.Encoding                 as LT+import           Network.HTTP.Types                      (RequestHeaders,+                                                          Status, status200)+import           Network.Wai++import           Control.Monad.Writer++++text :: Monad m => LT.Text -> FileExtListenerT Response m ()+text i =+  let r = responseLBS status200 [("Content-Type", "text/plain")] $+            LT.encodeUtf8 i in+  FileExtListenerT $ tell $+    FileExts $ singleton Text r++textStatus :: Monad m => Status -> LT.Text -> FileExtListenerT Response m ()+textStatus s i =+  let r = responseLBS s [("Content-Type", "text/plain")] $+            LT.encodeUtf8 i in+  FileExtListenerT $ tell $+    FileExts $ singleton Text r++textHeaders :: Monad m => RequestHeaders -> LT.Text -> FileExtListenerT Response m ()+textHeaders hs i =+  let r = responseLBS status200 hs $+            LT.encodeUtf8 i in+  FileExtListenerT $ tell $+    FileExts $ singleton Text r++textStatusHeaders :: Monad m => Status -> RequestHeaders -> LT.Text -> FileExtListenerT Response m ()+textStatusHeaders s hs i =+  let r = responseLBS s hs $+            LT.encodeUtf8 i in+  FileExtListenerT $ tell $+    FileExts $ singleton Text r+++++textOnly :: LT.Text -> Response+textOnly i =+  responseLBS status200 [("Content-Type", "text/plain")] $ LT.encodeUtf8 i++textOnlyStatus :: Status -> LT.Text -> Response+textOnlyStatus s i =+  responseLBS s [("Content-Type", "text/plain")] $ LT.encodeUtf8 i++textOnlyHeaders :: RequestHeaders -> LT.Text -> Response+textOnlyHeaders hs i =+  responseLBS status200 hs $ LT.encodeUtf8 i++textOnlyStatusHeaders :: Status -> RequestHeaders -> LT.Text -> Response+textOnlyStatusHeaders s hs i =+  responseLBS s hs $ LT.encodeUtf8 i+++++

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE StandaloneDeriving         #-}+++module Web.Routes.Nested.FileExtListener.Types where++import qualified Data.Text            as T++import           Control.Applicative+import           Control.Monad.Trans+import           Control.Monad.Writer+import           Data.Foldable        hiding (elem)+import           Data.Map+import           Data.Monoid+import           Data.Traversable+++data FileExt = Html+             | Json+             | Text+  deriving (Show, Eq, Ord)+++toExt :: T.Text -> Maybe FileExt+toExt x | x `elem` htmls = Just Html+        | x `elem` jsons = Just Json+        | x `elem` texts = Just Text+        | otherwise      = Nothing+  where+    htmls = ["", ".htm", ".html"]+    jsons = [".json"]+    texts = [".txt"]++newtype FileExts a = FileExts { unFileExts :: Map FileExt a }+  deriving (Show, Eq, Functor, Traversable)++deriving instance Monoid      (FileExts a)+deriving instance Foldable     FileExts+++newtype FileExtListenerT r m a =+  FileExtListenerT { runFileExtListenerT :: WriterT (FileExts r) m a }+    deriving (Functor)++deriving instance Applicative m => Applicative (FileExtListenerT r m)+deriving instance Monad m =>       Monad       (FileExtListenerT r m)+deriving instance MonadIO m =>     MonadIO     (FileExtListenerT r m)+deriving instance                  MonadTrans  (FileExtListenerT r)

@@ -27,14 +27,9 @@  import Data.Attoparsec.Text import Web.Routes.Nested.Types.UrlChunks-import Web.Routes.Nested.VerbListener-import Web.Routes.Nested.FileExtListener-import Network.Wai import qualified Data.Text as T import           Data.List.NonEmpty-import qualified Data.List.NonEmpty as NE import Data.Trie.Pred.Unified-import Data.Function.Poly   type family OnlyJusts (xs :: [Maybe *]) :: [*] where

@@ -17,7 +17,10 @@   (:=) :: T.Text             -> EitherUrlChunk 'Nothing   (:~) :: (T.Text, Parser r) -> EitherUrlChunk ('Just r) +l :: T.Text -> EitherUrlChunk 'Nothing l = (:=)++p :: (T.Text, Parser r) -> EitherUrlChunk ('Just r) p = (:~)  -- | Container when defining route paths@@ -25,8 +28,10 @@   Cons :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs) -- stack is left-to-right   Root  :: UrlChunks '[] +(</>) :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs) (</>) = Cons  infixr 9 </> +o :: UrlChunks '[] o = Root

@@ -10,15 +10,10 @@  module Web.Routes.Nested.VerbListener where -import           Web.Routes.Nested.FileExtListener--import           Network.Wai- import           Control.Applicative hiding (empty) import           Control.Monad.Trans import           Control.Monad.Writer import           Control.Monad.Reader-import           Data.Monoid import           Data.Foldable import           Data.Traversable import           Data.Map.Lazy