nested-routes 0.3.2.1 → 1.0

raw patch · 16 files changed

+457/−367 lines, 16 filesdep +claydep +compositiondep +shakespearePVP ok

version bump matches the API change (PVP)

Dependencies added: clay, composition, shakespeare, wai-util, witherable

API changes (from Hackage documentation)

Files

• nested-routes.cabal +38/−31
• src/Web/Routes/Nested.hs +123/−179
• src/Web/Routes/Nested/FileExtListener.hs +1/−1
• src/Web/Routes/Nested/FileExtListener/Blaze.hs +12/−27
• src/Web/Routes/Nested/FileExtListener/Builder.hs +3/−6
• src/Web/Routes/Nested/FileExtListener/ByteString.hs +5/−8
• src/Web/Routes/Nested/FileExtListener/Cassius.hs +55/−0
• src/Web/Routes/Nested/FileExtListener/Clay.hs +56/−0
• src/Web/Routes/Nested/FileExtListener/Json.hs +15/−39
• src/Web/Routes/Nested/FileExtListener/Julius.hs +55/−0
• src/Web/Routes/Nested/FileExtListener/Lucid.hs +10/−37
• src/Web/Routes/Nested/FileExtListener/Lucius.hs +55/−0
• src/Web/Routes/Nested/FileExtListener/Text.hs +12/−31
• src/Web/Routes/Nested/FileExtListener/Types.hs +13/−7
• src/Web/Routes/Nested/Types.hs +0/−1
• src/Web/Routes/Nested/Types/UrlChunks.hs +4/−0

@@ -1,5 +1,5 @@ Name:                   nested-routes-Version:                0.3.2.1+Version:                1.0 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -25,19 +25,23 @@   > router = route handlers   >   where   >     handlers = do-  >       handleLit o-  >         (Left $ get $ text "home")+  >       handle o+  >         (get $ text "home")   >         Nothing-  >       handleLit (l "foo" </> l "bar" </> o)-  >         (Left $ get $ text "foobar") $ Just $-  >         handleParse (p ("baz",double) </> o)-  >           (\d -> Right $ get $ textOnly $ LT.pack (show d) `LT.append` " bazs")+  >       handle ("foo" </> "bar")+  >         (get $ text "foobar") $ Just $+  >         handle (p ("baz", double) </> o)+  >           (\d -> get $ text $ LT.pack (show d) <> " bazs")   >           Nothing-  >       handleParse (p ("num",double) </> o)-  >         (\d -> Right $ get $ textOnly $ LT.pack $ show d) $ Just $-  >         handleLit (l "bar" </> o)-  >            (\d -> Left $ get $ text $ (LT.pack $ show d) `LT.append` " bars")+  >       handle (p ("num",double) </> o)+  >         (\d -> get $ text $ LT.pack $ show d) $ Just $ do+  >         handle "bar"+  >            (\d -> get $ do+  >                     text $ (LT.pack $ show d) <> " bars")+  >                     json $ (LT.pack $ show d) <> " bars!")   >            Nothing+  >         handle (r ("email", mkRegex "(^[-a-zA-Z0-9_.]+@[-a-zA-Z0-9]+\\.[-a-zA-Z0-9.]+$)") </> o)+  >            (\d e -> get $ textOnly $ (LT.pack $ show d) <> " " <> (LT.pack $ show e)   .   The route specification syntax is a little strange right now - @l@ specifies   a "literal chunk" of a handlable url (ie - @l \"foo\" \<\/\> l \"bar\" \<\/\> o@ would@@ -47,56 +51,50 @@   the end of a url string, and can be used alone in a handler to capture requests   to the root path.   .-  Each route being handled needs some kind of content - that's where the @Either@-  stuff comes in to play. For every parsed url chunk, the route expects a function+  Each route being handled needs some kind of content. For every parsed url chunk,+  the route expects a function   of arity matching 1-for-1 with the parsed contents. For example, @\d -> ...@ in the   demonstration above is such a function, where @d :: Double@.   .-  We use the @Either@ for a subtle reason - literal url strings may have a file-  extension, while url strings ending with a parser would not. @get@, @post@, etc.-  are all monadic expressions, accumulating a @Map@ for HTTP verbs, likewise with-  @text@, @lucid@, @json@, @bytestring@ etc., where they may also match a particular-  file extension. @textOnly@ and the other @-Only@ variants are not monadic, and-  simply give us a convenient unwrapper. Basically, url paths ending with a literal-  chunk are @Left@ and contain a @VerbListenerT z (FileExtListenerT Response m ()) m ()@,-  while paths ending with a parser are @Right@ and contain @VerbListenerT z Response m ()@.+  Internally, we match against both the file extension and Accept headers in the+  HTTP request - the Accept header may override the file extension.   .   When we test our application:   .-  >  λ> curl localhost:3000/+  >  λ> curl localhost:3000/ -H "Accept: text/plain, */*"   >  ↪ "home"   .   requests may end with index   .-  >  λ> curl localhost:3000/index+  >  λ> curl localhost:3000/index -H "Accept: text/plain, */*"   >  ↪ "home"   .   and specify the file extension   .-  >  λ> curl localhost:3000/index.txt+  >  λ> curl localhost:3000/index.txt -H "Accept: text/plain, */*"   >  ↪ "home"   .   each responding with the "closest" available file type   .-  >  λ> curl localhost:3000/index.html+  >  λ> curl localhost:3000/index.html -H "Accept: text/html, */*"   >  ↪ "home"   .-  >  λ> curl localhost:3000/foo/bar+  >  λ> curl localhost:3000/foo/bar -H "Accept: text/plain, */*"   >  ↪ "foobar"   .-  >  λ> curl localhost:3000/foo/bar.txt+  >  λ> curl localhost:3000/foo/bar.txt -H "Accept: text/plain, */*"   >  ↪ "foobar"   .-  >  λ> curl localhost:3000/foo/bar/5678.5678+  >  λ> curl localhost:3000/foo/bar/5678.5678 -H "Accept: text/plain, */*"   >  ↪ "5678.5678 bazs"   .-  >  λ> curl localhost:3000/1234.1234+  >  λ> curl localhost:3000/1234.1234 -H "Accept: text/plain, */*"   >  ↪ "1234.1234"   .-  >  λ> curl localhost:3000/2e5+  >  λ> curl localhost:3000/2e5 -H "Accept: text/plain, */*"   >  ↪ "200000.0"   .-  >  λ> curl localhost:3000/1234.1234/bar+  >  λ> curl localhost:3000/1234.1234/bar -H "Accept: text/plain, */*"   >  ↪ "1234.1234 bars"  Cabal-Version:          >= 1.10@@ -118,13 +116,20 @@                         Web.Routes.Nested.FileExtListener.Blaze                         Web.Routes.Nested.FileExtListener.ByteString                         Web.Routes.Nested.FileExtListener.Lucid+                        Web.Routes.Nested.FileExtListener.Clay+                        Web.Routes.Nested.FileExtListener.Julius+                        Web.Routes.Nested.FileExtListener.Lucius+                        Web.Routes.Nested.FileExtListener.Cassius   Build-Depends:        base >= 4.6 && < 5                       , wai                       , wai-extra+                      , wai-util                       , http-types                       , http-media                       , mtl                       , transformers+                      , witherable+                      , composition                       , semigroups                       , constraints                       , containers@@ -132,6 +137,8 @@                       , aeson                       , blaze-html                       , lucid+                      , shakespeare+                      , clay                       , bytestring                       , attoparsec                       , regex-compat

@@ -23,16 +23,15 @@   , module Web.Routes.Nested.VerbListener   , module Web.Routes.Nested.Types   , HandlerT (..)-  , EitherResponse-  , handleLit-  , handleParse-  , notFoundLit-  , notFoundParse+  , ActionT+  , handle+  , notFound   , route   ) where  import           Web.Routes.Nested.Types import           Web.Routes.Nested.FileExtListener+import           Web.Routes.Nested.FileExtListener.Types (FileExt) import           Web.Routes.Nested.VerbListener  import           Network.HTTP.Types@@ -48,9 +47,12 @@ import qualified Data.Trie.Pred.Unified            as P import qualified Data.Text                         as T import qualified Data.Map.Lazy                     as M+import qualified Data.ByteString                   as B import qualified Data.ByteString.Lazy              as BL import           Data.Maybe                        (fromMaybe) import           Data.Constraint+import           Data.Witherable+import           Data.List  import Data.Function.Poly @@ -66,9 +68,7 @@ instance MonadTrans (HandlerT z x) where   lift ma = HandlerT $ lift ma --type EitherResponse z m = Either (VerbListenerT z (FileExtListenerT Response m ()) m ())-                                 (VerbListenerT z Response m ())+type ActionT z m a = VerbListenerT z (FileExtListenerT Response m a) m a  type family LastIsNothing (xs :: [Maybe *]) :: Constraint where   LastIsNothing '[] = ()@@ -80,107 +80,53 @@   LastIsJust (x ': xs) = LastIsJust xs  -- | For routes ending with a literal.-handleLit :: ( Monad m-             , Functor m-             , cleanxs ~ OnlyJusts xs-             , HasResult childType (EitherResponse z m)-             , ExpectArity cleanxs childType-             , Singleton (UrlChunks xs)-                 childType-                 (RUPTrie T.Text result)-             , Extrude (UrlChunks xs)-                 (RUPTrie T.Text childType)-                 (RUPTrie T.Text result)-             , (ArityMinusTypeList childType cleanxs) ~ result-             , childType ~ TypeListToArity cleanxs result-             , LastIsNothing xs-             ) =>-             UrlChunks xs -- ^ Path to match against-          -> childType -- ^ Possibly a function, ending in @EitherResponse z m@-          -> Maybe (HandlerT z childType m ()) -- ^ Potential child routes-          -> HandlerT z result m ()-handleLit ts vl Nothing =-  HandlerT $ tell (singleton ts vl, mempty)-handleLit ts vl (Just cs) = do-  ((Rooted _ ctrie),_) <- lift $ execWriterT $ runHandler cs-  HandlerT $ tell (extrude ts $ Rooted (Just vl) ctrie, mempty)----- | For routes ending with a parser.-handleParse :: ( Monad m-               , Functor m-               , cleanxs ~ OnlyJusts xs-               , HasResult childType (EitherResponse z m)-               , ExpectArity cleanxs childType-               , Singleton (UrlChunks xs)-                   childType-                   (RUPTrie T.Text result)-               , Extrude (UrlChunks xs)-                   (RUPTrie T.Text childType)-                   (RUPTrie T.Text result)-               , (ArityMinusTypeList childType cleanxs) ~ result-               , childType ~ TypeListToArity cleanxs result-               , LastIsJust xs-               ) =>-               UrlChunks xs-            -> childType-            -> Maybe (HandlerT z childType m ())-            -> HandlerT z result m ()-handleParse ts vl Nothing =+handle :: ( Monad m+          , Functor m+          , cleanxs ~ OnlyJusts xs+          , HasResult childType (ActionT z m ())+          , ExpectArity cleanxs childType+          , Singleton (UrlChunks xs)+              childType+              (RUPTrie T.Text result)+          , Extrude (UrlChunks xs)+              (RUPTrie T.Text childType)+              (RUPTrie T.Text result)+          , (ArityMinusTypeList childType cleanxs) ~ result+          , childType ~ TypeListToArity cleanxs result+          , LastIsNothing xs+          ) =>+          UrlChunks xs -- ^ Path to match against+       -> childType -- ^ Possibly a function, ending in @ActionT z m ()@.+       -> Maybe (HandlerT z childType m ()) -- ^ Potential child routes+       -> HandlerT z result m ()+handle ts vl Nothing =   HandlerT $ tell (singleton ts vl, mempty)-handleParse ts vl (Just cs) = do+handle ts vl (Just cs) = do   ((Rooted _ ctrie),_) <- lift $ execWriterT $ runHandler cs   HandlerT $ tell (extrude ts $ Rooted (Just vl) ctrie, mempty)  -notFoundLit :: ( Monad m-               , Functor m-               , cleanxs ~ OnlyJusts xs-               , HasResult childType (EitherResponse z m)-               , ExpectArity cleanxs childType-               , Singleton (UrlChunks xs)-                   childType-                   (RUPTrie T.Text result)-               , Extrude (UrlChunks xs)-                   (RUPTrie T.Text childType)-                   (RUPTrie T.Text result)-               , (ArityMinusTypeList childType cleanxs) ~ result-               , childType ~ TypeListToArity cleanxs result-               , LastIsNothing xs-               ) =>-               UrlChunks xs-            -> childType-            -> Maybe (HandlerT z childType m ())-            -> HandlerT z result m ()-notFoundLit ts vl Nothing = do-  HandlerT $ tell (mempty, singleton ts vl)-notFoundLit ts vl (Just cs) = do-  ((Rooted _ ctrie),_) <- lift $ execWriterT $ runHandler cs-  HandlerT $ tell (mempty, extrude ts $ Rooted (Just vl) ctrie)---notFoundParse :: ( Monad m-                 , Functor m-                 , cleanxs ~ OnlyJusts xs-                 , HasResult childType (EitherResponse z m)-                 , ExpectArity cleanxs childType-                 , Singleton (UrlChunks xs)-                     childType-                     (RUPTrie T.Text result)-                 , Extrude (UrlChunks xs)-                     (RUPTrie T.Text childType)-                     (RUPTrie T.Text result)-                 , (ArityMinusTypeList childType cleanxs) ~ result-                 , childType ~ TypeListToArity cleanxs result-                 , LastIsJust xs-                 ) =>-                 UrlChunks xs-              -> childType-              -> Maybe (HandlerT z childType m ())-              -> HandlerT z result m ()-notFoundParse ts vl Nothing = do+notFound :: ( Monad m+            , Functor m+            , cleanxs ~ OnlyJusts xs+            , HasResult childType (ActionT z m ())+            , ExpectArity cleanxs childType+            , Singleton (UrlChunks xs)+                childType+                (RUPTrie T.Text result)+            , Extrude (UrlChunks xs)+                (RUPTrie T.Text childType)+                (RUPTrie T.Text result)+            , (ArityMinusTypeList childType cleanxs) ~ result+            , childType ~ TypeListToArity cleanxs result+            ) =>+            UrlChunks xs+         -> childType+         -> Maybe (HandlerT z childType m ())+         -> HandlerT z result m ()+notFound ts vl Nothing = do   HandlerT $ tell (mempty, singleton ts vl)-notFoundParse ts vl (Just cs) = do+notFound ts vl (Just cs) = do   ((Rooted _ ctrie),_) <- lift $ execWriterT $ runHandler cs   HandlerT $ tell (mempty, extrude ts $ Rooted (Just vl) ctrie) @@ -190,22 +136,23 @@          , Monad m          , MonadIO m          ) =>-         HandlerT z (EitherResponse z m) m a -- ^ Assembled @handle@ calls+         HandlerT z (ActionT z m ()) m a -- ^ Assembled @handle@ calls       -> Request       -> (Response -> IO ResponseReceived) -> m ResponseReceived route h req respond = do-  -- liftIO $ print $ (return . parseContentType) =<< (Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req)   (rtrie, nftrie) <- execWriterT $ runHandler h   let mMethod  = httpMethodToMSym $ requestMethod req       mFileext = case pathInfo req of                          [] -> Just Html                          xs -> toExt $ T.pack $ dropWhile (/= '.') $ T.unpack $ last xs-      meitherNotFound = P.lookupNearestParent (pathInfo req) nftrie+      mnftrans = P.lookupNearestParent (pathInfo req) nftrie+      acceptBS = Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req+      fe = fromMaybe Html mFileext -  notFoundBasic <- handleNotFound (Just Html) Get meitherNotFound+  notFoundBasic <- handleNotFound acceptBS Html Get mnftrans    maybe (liftIO $ respond404 notFoundBasic) (\v -> do-    menf <- handleNotFound mFileext v meitherNotFound+    menf <- handleNotFound acceptBS fe v mnftrans     let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req         fail = liftIO $ respond404 menf @@ -213,10 +160,10 @@         [] -> fail         _  -> case trimFileExt $ last $ pathInfo req of           "index" -> maybe fail-                       (\eitherM -> continue mFileext v eitherM menf)+                       (\foundM -> continue acceptBS fe v foundM menf)                        (P.lookup (init $ pathInfo req) rtrie)           _ -> fail-      ) (\eitherM -> continue mFileext v eitherM menf)+      ) (\foundM -> continue acceptBS fe v foundM menf)       (P.lookup cleanedPathInfo rtrie)     ) mMethod @@ -226,48 +173,43 @@       handleNotFound :: MonadIO m =>-                      Maybe FileExt+                      Maybe B.ByteString+                   -> FileExt                    -> Verb-                   -> Maybe (EitherResponse z m)+                   -> Maybe (ActionT z m ())                    -> m (Maybe Response)-    handleNotFound mf v meitherNotFound =-      let handleEither (Left litmonad) =-            onJustM (\f -> do-                vmapLit <- execWriterT $ runVerbListenerT litmonad-                onJustM (\(_, femonad) -> do-                    femap <- execWriterT $ runFileExtListenerT femonad-                    return $ lookupMin f $ unFileExts femap) $-                  M.lookup v $ unVerbs vmapLit) mf-          handleEither (Right predmonad) = do-            vmapPred <- execWriterT $ runVerbListenerT predmonad-            onJustM (\(_, r) -> return $ Just r) $ M.lookup v $ unVerbs vmapPred+    handleNotFound acceptBS f v mnfcomp =+      let handleEither nfcomp = do+            vmapLit <- execWriterT $ runVerbListenerT nfcomp+            onJustM (\(_, femonad) -> do+                femap <- execWriterT $ runFileExtListenerT femonad+                return $ lookupProper acceptBS f $ unFileExts femap+              ) $ M.lookup v $ unVerbs vmapLit       in-      onJustM handleEither meitherNotFound+      onJustM handleEither mnfcomp       continue :: MonadIO m =>-                Maybe FileExt+                Maybe B.ByteString+             -> FileExt              -> Verb-             -> EitherResponse z m+             -> ActionT z m ()              -> Maybe Response              -> m ResponseReceived-    continue mf v eitherM mnfResp = case eitherM of-       Left litmonad -> maybe (liftIO $ respond404 mnfResp) (\f -> do-                          vmapLit <- execWriterT $ runVerbListenerT litmonad-                          continueLit f v (unVerbs vmapLit) mnfResp)-                        mf-       Right predmonad -> do-         vmapPred <- execWriterT $ runVerbListenerT predmonad-         continuePred v (unVerbs vmapPred) mnfResp+    continue acceptBS f v foundM mnfResp = do+      vmapLit <- execWriterT $ runVerbListenerT foundM+      continueMap acceptBS f v (unVerbs vmapLit) mnfResp -    continueLit :: MonadIO m =>-                   FileExt+    continueMap :: MonadIO m =>+                   Maybe B.ByteString+                -> FileExt                 -> Verb                 -> M.Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), FileExtListenerT Response m ())                 -> Maybe Response                 -> m ResponseReceived-    continueLit f v vmap mnfResp =-      let fail = liftIO $ respond404 mnfResp in+    continueMap acceptBS f v vmap mnfResp = do+      let fail = liftIO $ respond404 mnfResp+       maybe fail (\(mreqbodyf, femonad) -> do           femap <- execWriterT $ runFileExtListenerT femonad           maybe fail (\r -> do@@ -286,33 +228,8 @@                               liftIO $ respond r                       else fail                     _ -> fail) $-            lookupMin f $ unFileExts femap) $ M.lookup v vmap---    continuePred :: MonadIO m =>-                    Verb-                 -> M.Map Verb (Maybe (ReaderT BL.ByteString m z, Maybe BodyLength), Response)-                 -> Maybe Response-                 -> m ResponseReceived-    continuePred v vmap mnfResp =-      let fail = liftIO $ respond404 mnfResp in-      maybe fail (\(mreqbodyf, r) ->-          case mreqbodyf of-            Nothing              -> liftIO $ respond r-            Just (reqbf,Nothing) -> do-              body <- liftIO $ strictRequestBody req-              (runReaderT $ reqbf) body-              liftIO $ respond r-            Just (reqbf,Just bl) -> do-              case requestBodyLength req of-                KnownLength bl' ->-                  if bl' <= bl-                  then do body <- liftIO $ strictRequestBody req-                          (runReaderT $ reqbf) body-                          liftIO $ respond r-                  else fail-                _ -> fail-          ) $ M.lookup v vmap+            lookupProper acceptBS f $ unFileExts femap) $+        M.lookup v vmap       respond404 :: Maybe Response -> IO ResponseReceived@@ -321,21 +238,46 @@     plain404 :: Response     plain404 = responseLBS status404 [("Content-Type","text/plain")] "404" -    lookupMin :: Ord k => k -> M.Map k a -> Maybe a-    lookupMin k map | all (k <) (M.keys map) = M.lookup (minimum $ M.keys map) map-                    | otherwise              = M.lookup k map--    lookupProper :: FileExt -> M.Map FileExt a -> Maybe a-    lookupProper k map = case M.lookup k map of-      Nothing -> case M.lookup (feSequence k !! 0) map of-        Nothing -> M.lookup (feSequence k !! 1) map-        Just x  -> Just x-      Just x  -> Just x+    lookupProper :: Maybe B.ByteString -> FileExt -> M.Map FileExt a -> Maybe a+    lookupProper maccept k map =+      let+        attempts = maybe+                     [Html,Text,Json,JavaScript,Css]+                     (\accept -> possibleFileExts k accept)+                     maccept+      in+      foldr (go map) Nothing attempts       where-        feSequence Html = [Text, Json]-        feSequence Json = [Text, Html]-        feSequence Text = [Json, Html]+        go map x Nothing = M.lookup x map+        go _ _  (Just y) = Just y +    possibleFileExts :: FileExt -> B.ByteString -> [FileExt]+    possibleFileExts fe accept =+      let computed = sortFE fe $ nub $ concat $+            catMaybes [ mapAccept [ ("application/json" :: B.ByteString, [Json])+                                  , ("application/javascript" :: B.ByteString, [Json,JavaScript])+                                  ] accept+                      , mapAccept [ ("text/html" :: B.ByteString, [Html])+                                  ] accept+                      , mapAccept [ ("text/plain" :: B.ByteString, [Text])+                                  ] accept+                      , mapAccept [ ("text/css" :: B.ByteString, [Css])+                                  ] accept+                      ]++          wildcard = concat $+            catMaybes [ mapAccept [ ("*/*" :: B.ByteString, [Html,Text,Json,JavaScript,Css])+                                  ] accept+                      ]+      in+      if length wildcard /= 0 then wildcard else computed++    sortFE Html       xs = [Html, Text]             `intersect` xs+    sortFE JavaScript xs = [JavaScript, Text]       `intersect` xs+    sortFE Json       xs = [Json, JavaScript, Text] `intersect` xs+    sortFE Css        xs = [Css, Text]              `intersect` xs+    sortFE Text       xs = [Text]                   `intersect` xs+     applyToLast :: (a -> a) -> [a] -> [a]     applyToLast _ [] = []     applyToLast f (x:[]) = f x : []@@ -346,7 +288,9 @@                     then T.pack $ takeWhile (/= '.') $ T.unpack s                     else s       where-        possibleExts = [".html",".htm",".txt",".json"]+        possibleExts = [ ".html",".htm",".txt",".json",".lucid"+                       , ".julius",".css",".cassius",".lucius"+                       ]         endsWithAny s xs = (dropWhile (/= '.') s) `elem` xs      httpMethodToMSym :: Method -> Maybe Verb

@@ -2,7 +2,7 @@   ( module X   ) where -import Web.Routes.Nested.FileExtListener.Types as X+import Web.Routes.Nested.FileExtListener.Types as X hiding (FileExt) import Web.Routes.Nested.FileExtListener.Builder as X import Web.Routes.Nested.FileExtListener.ByteString as X import Web.Routes.Nested.FileExtListener.Blaze as X

@@ -4,6 +4,7 @@ module Web.Routes.Nested.FileExtListener.Blaze where  import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString  import           Data.Map import qualified Data.Text.Lazy.Encoding                 as LT@@ -16,51 +17,35 @@ import           Control.Monad.Writer  -+-- | Uses @Html@ as the key in the map, and @"text/html"@ as the content type. 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+blaze = blazeStatusHeaders status200 [("Content-Type", "text/html")]  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+blazeStatus s = blazeStatusHeaders s [("Content-Type", "text/html")] +blazeHeaders :: Monad m => RequestHeaders -> H.Html -> FileExtListenerT Response m ()+blazeHeaders = blazeStatusHeaders status200+ 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+  let r = blazeOnlyStatusHeaders s hs 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+blazeOnly = blazeOnlyStatusHeaders status200 [("Content-Type", "text/html")]  blazeOnlyHeaders :: RequestHeaders -> H.Html -> Response-blazeOnlyHeaders hs i =-  responseLBS status200 hs $ LT.encodeUtf8 $ H.renderHtml i+blazeOnlyHeaders = blazeOnlyStatusHeaders status200  blazeOnlyStatus :: Status -> H.Html -> Response-blazeOnlyStatus s i =-  responseLBS s [("Content-Type", "text/html")] $ LT.encodeUtf8 $ H.renderHtml i+blazeOnlyStatus s = blazeOnlyStatusHeaders s [("Content-Type", "text/html")]  blazeOnlyStatusHeaders :: Status -> RequestHeaders -> H.Html -> Response blazeOnlyStatusHeaders s hs i =-  responseLBS s hs $ LT.encodeUtf8 $ H.renderHtml i+  bytestringOnlyStatus s hs $ LT.encodeUtf8 $ H.renderHtml i  

@@ -17,21 +17,18 @@ -- | 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+builder e  = builderStatus e status200  builderStatus :: Monad m => FileExt -> Status -> RequestHeaders -> BU.Builder -> FileExtListenerT Response m () builderStatus e s hs i =-  let r = responseBuilder s hs i in+  let r = builderOnlyStatus s hs i in   FileExtListenerT $ tell $     FileExts $ singleton e r    builderOnly :: RequestHeaders -> BU.Builder -> Response-builderOnly = responseBuilder status200+builderOnly = builderOnlyStatus status200  -- | The exact same thing as @Network.Wai.responseBuilder@. builderOnlyStatus :: Status -> RequestHeaders -> BU.Builder -> Response

@@ -10,28 +10,25 @@ import           Network.HTTP.Types                      (RequestHeaders,                                                           Status, status200) import           Network.Wai+import qualified Network.Wai.Util                        as U  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+bytestring e = bytestringStatus e status200  bytestringStatus :: Monad m => FileExt -> Status -> RequestHeaders -> B.ByteString -> FileExtListenerT Response m ()-bytestringStatus e s hs i =-  let r = responseLBS s hs i in+bytestringStatus e s hs i = do+  r <- lift $ U.bytestring s hs i   FileExtListenerT $ tell $     FileExts $ singleton e r   bytestringOnly :: RequestHeaders -> B.ByteString -> Response-bytestringOnly = responseLBS status200+bytestringOnly = bytestringOnlyStatus status200  -- | The exact same thing as @Network.Wai.responseLBS@. bytestringOnlyStatus :: Status -> RequestHeaders -> B.ByteString -> Response bytestringOnlyStatus = responseLBS-

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++++module Web.Routes.Nested.FileExtListener.Cassius where++import           Web.Routes.Nested.FileExtListener.Types as FE+import           Web.Routes.Nested.FileExtListener.ByteString++import           Data.Map+import           Text.Cassius+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+++-- | Uses @cassius@ as the key in the map, and @"cassius/plain"@ as the content type.+cassius :: Monad m => Css -> FileExtListenerT Response m ()+cassius = cassiusStatusHeaders status200 [("Content-Type", "cassius/css")]++cassiusStatus :: Monad m => Status -> Css -> FileExtListenerT Response m ()+cassiusStatus s = cassiusStatusHeaders s [("Content-Type", "cassius/css")]++cassiusHeaders :: Monad m => RequestHeaders -> Css -> FileExtListenerT Response m ()+cassiusHeaders = cassiusStatusHeaders status200++cassiusStatusHeaders :: Monad m => Status -> RequestHeaders -> Css -> FileExtListenerT Response m ()+cassiusStatusHeaders s hs i =+  let r = cassiusOnlyStatusHeaders s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton Css r+++++cassiusOnly :: Css -> Response+cassiusOnly = cassiusOnlyStatusHeaders status200 [("Content-Type", "cassius/css")]++cassiusOnlyStatus :: Status -> Css -> Response+cassiusOnlyStatus s = cassiusOnlyStatusHeaders s [("Content-Type", "cassius/css")]++cassiusOnlyHeaders :: RequestHeaders -> Css -> Response+cassiusOnlyHeaders = cassiusOnlyStatusHeaders status200++cassiusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response+cassiusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderCss i+++++

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++++module Web.Routes.Nested.FileExtListener.Clay where++import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString++import           Data.Map+import           Clay.Render+import           Clay.Stylesheet+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+++-- | Uses @Text@ as the key in the map, and @"text/css"@ as the content type.+clay :: Monad m => Config -> [App] -> Css -> FileExtListenerT Response m ()+clay c as = clayStatusHeaders c as status200 [("Content-Type", "text/css")]++clayStatus :: Monad m =>Config -> [App] ->  Status -> Css -> FileExtListenerT Response m ()+clayStatus c as s = clayStatusHeaders c as s [("Content-Type", "text/css")]++clayHeaders :: Monad m => Config -> [App] -> RequestHeaders -> Css -> FileExtListenerT Response m ()+clayHeaders c as = clayStatusHeaders c as status200++clayStatusHeaders :: Monad m => Config -> [App] -> Status -> RequestHeaders -> Css -> FileExtListenerT Response m ()+clayStatusHeaders c as s hs i =+  let r = clayOnlyStatusHeaders c as s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton Css r+++++clayOnly :: Config -> [App] -> Css -> Response+clayOnly c as = clayOnlyStatusHeaders c as status200 [("Content-Type", "text/css")]++clayOnlyStatus :: Config -> [App] -> Status -> Css -> Response+clayOnlyStatus c as s = clayOnlyStatusHeaders c as s [("Content-Type", "text/css")]++clayOnlyHeaders :: Config -> [App] -> RequestHeaders -> Css -> Response+clayOnlyHeaders c as = clayOnlyStatusHeaders c as status200++clayOnlyStatusHeaders :: Config -> [App] -> Status -> RequestHeaders -> Css -> Response+clayOnlyStatusHeaders c as s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderWith c as i+++++

@@ -4,6 +4,7 @@ module Web.Routes.Nested.FileExtListener.Json where  import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString  import qualified Data.Aeson                              as A import           Data.Map@@ -15,58 +16,38 @@   -+-- | Uses @Json@ as the key in the map, and @"application/json"@ as the content type. 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+json = jsonStatusHeaders status200 [("Content-Type", "application/json")]  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+jsonStatus s = jsonStatusHeaders s [("Content-Type", "application/json")] +-- | Uses @Json@ as the key in the map, and @"application/javascript"@ as the content type. 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+jsonp = jsonStatusHeaders status200 [("Content-Type", "application/javascript")]  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+jsonpStatus s = jsonStatusHeaders s [("Content-Type", "application/javascript")]  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+jsonHeaders = jsonStatusHeaders status200  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+  let r = jsonOnlyStatusHeaders s hs i in   FileExtListenerT $ tell $     FileExts $ singleton Json r @@ -75,31 +56,26 @@  jsonOnly :: A.ToJSON j =>             j -> Response-jsonOnly i =-  responseLBS status200 [("Content-Type", "application/json")] $ A.encode i+jsonOnly = jsonOnlyStatusHeaders status200 [("Content-Type", "application/json")]  jsonOnlyStatus :: A.ToJSON j =>             Status -> j -> Response-jsonOnlyStatus s i =-  responseLBS s [("Content-Type", "application/json")] $ A.encode i+jsonOnlyStatus s = jsonOnlyStatusHeaders s [("Content-Type", "application/json")]  jsonpOnly :: A.ToJSON j =>             j -> Response-jsonpOnly i =-  responseLBS status200 [("Content-Type", "application/javascript")] $ A.encode i+jsonpOnly = jsonOnlyStatusHeaders status200 [("Content-Type", "application/javascript")]  jsonpOnlyStatus :: A.ToJSON j =>             Status -> j -> Response-jsonpOnlyStatus s i =-  responseLBS s [("Content-Type", "application/javascript")] $ A.encode i+jsonpOnlyStatus s = jsonOnlyStatusHeaders s [("Content-Type", "application/javascript")]  jsonOnlyHeaders :: A.ToJSON j =>             RequestHeaders -> j -> Response-jsonOnlyHeaders hs i =-  responseLBS status200 hs $ A.encode i+jsonOnlyHeaders = jsonOnlyStatusHeaders status200  jsonOnlyStatusHeaders :: A.ToJSON j =>             Status -> RequestHeaders -> j -> Response jsonOnlyStatusHeaders s hs i =-  responseLBS s hs $ A.encode i+  bytestringOnlyStatus s hs $ A.encode i 

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++++module Web.Routes.Nested.FileExtListener.Julius where++import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString++import           Data.Map+import           Text.Julius+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+++-- | Uses @julius@ as the key in the map, and @"application/javascript"@ as the content type.+julius :: Monad m => Javascript -> FileExtListenerT Response m ()+julius = juliusStatusHeaders status200 [("Content-Type", "application/javascript")]++juliusStatus :: Monad m => Status -> Javascript -> FileExtListenerT Response m ()+juliusStatus s = juliusStatusHeaders s [("Content-Type", "application/javascript")]++juliusHeaders :: Monad m => RequestHeaders -> Javascript -> FileExtListenerT Response m ()+juliusHeaders = juliusStatusHeaders status200++juliusStatusHeaders :: Monad m => Status -> RequestHeaders -> Javascript -> FileExtListenerT Response m ()+juliusStatusHeaders s hs i =+  let r = juliusOnlyStatusHeaders s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton JavaScript r+++++juliusOnly :: Javascript -> Response+juliusOnly = juliusOnlyStatusHeaders status200 [("Content-Type", "application/javascript")]++juliusOnlyStatus :: Status -> Javascript -> Response+juliusOnlyStatus s = juliusOnlyStatusHeaders s [("Content-Type", "application/javascript")]++juliusOnlyHeaders :: RequestHeaders -> Javascript -> Response+juliusOnlyHeaders = juliusOnlyStatusHeaders status200++juliusOnlyStatusHeaders :: Status -> RequestHeaders -> Javascript -> Response+juliusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderJavascript i+++++

@@ -4,6 +4,7 @@ module Web.Routes.Nested.FileExtListener.Lucid where  import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString  import           Data.Map import qualified Lucid.Base                              as L@@ -14,36 +15,23 @@ import           Control.Monad.Writer  -+-- | Uses the @Html@ key in the map, and @"text/html"@ as the content type. 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+lucid = lucidStatusHeaders status200 [("Content-Type", "text/html")]  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+lucidStatus s = lucidStatusHeaders s [("Content-Type", "text/html")]  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+lucidHeaders = lucidStatusHeaders status200  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'+  r <- lift $ lucidOnlyStatusHeaders s hs i   FileExtListenerT $ tell $     FileExts $ singleton Html r @@ -52,31 +40,16 @@  lucidOnly :: Monad m =>              L.HtmlT m () -> m Response-lucidOnly i = do-  i' <- L.renderBST i-  return $ responseLBS status200 [("Content-Type", "text/html")] i'+lucidOnly = lucidOnlyStatusHeaders status200 [("Content-Type", "text/html")]  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'+lucidOnlyStatus s = lucidOnlyStatusHeaders s [("Content-Type", "text/html")]  lucidOnlyHeaders :: Monad m =>              RequestHeaders -> L.HtmlT m () -> m Response-lucidOnlyHeaders hs i = do-  i' <- L.renderBST i-  return $ responseLBS status200 hs i'+lucidOnlyHeaders = lucidOnlyStatusHeaders status200  lucidOnlyStatusHeaders :: Monad m =>              Status -> RequestHeaders -> L.HtmlT m () -> m Response-lucidOnlyStatusHeaders s hs i = do-  i' <- L.renderBST i-  return $ responseLBS s hs i'-------+lucidOnlyStatusHeaders s hs i = liftM (bytestringOnlyStatus s hs) $ L.renderBST i

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++++module Web.Routes.Nested.FileExtListener.Lucius where++import           Web.Routes.Nested.FileExtListener.Types as FE+import           Web.Routes.Nested.FileExtListener.ByteString++import           Data.Map+import           Text.Lucius+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+++-- | Uses @lucius@ as the key in the map, and @"lucius/css"@ as the content type.+lucius :: Monad m => Css -> FileExtListenerT Response m ()+lucius = luciusStatusHeaders status200 [("Content-Type", "lucius/css")]++luciusStatus :: Monad m => Status -> Css -> FileExtListenerT Response m ()+luciusStatus s = luciusStatusHeaders s [("Content-Type", "lucius/css")]++luciusHeaders :: Monad m => RequestHeaders -> Css -> FileExtListenerT Response m ()+luciusHeaders = luciusStatusHeaders status200++luciusStatusHeaders :: Monad m => Status -> RequestHeaders -> Css -> FileExtListenerT Response m ()+luciusStatusHeaders s hs i =+  let r = luciusOnlyStatusHeaders s hs i in+  FileExtListenerT $ tell $+    FileExts $ singleton FE.Css r+++++luciusOnly :: Css -> Response+luciusOnly = luciusOnlyStatusHeaders status200 [("Content-Type", "lucius/css")]++luciusOnlyStatus :: Status -> Css -> Response+luciusOnlyStatus s = luciusOnlyStatusHeaders s [("Content-Type", "lucius/css")]++luciusOnlyHeaders :: RequestHeaders -> Css -> Response+luciusOnlyHeaders = luciusOnlyStatusHeaders status200++luciusOnlyStatusHeaders :: Status -> RequestHeaders -> Css -> Response+luciusOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 $ renderCss i+++++

@@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-}  + module Web.Routes.Nested.FileExtListener.Text where  import           Web.Routes.Nested.FileExtListener.Types+import           Web.Routes.Nested.FileExtListener.ByteString  import           Data.Map import qualified Data.Text.Lazy                          as LT@@ -12,35 +14,23 @@                                                           Status, status200) import           Network.Wai +import           Data.Composition import           Control.Monad.Writer  -+-- | Uses @Text@ as the key in the map, and @"text/plain"@ as the content type. 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+text = textStatusHeaders status200 [("Content-Type", "text/plain")]  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+textStatus s = textStatusHeaders s [("Content-Type", "text/plain")]  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+textHeaders = textStatusHeaders status200  textStatusHeaders :: Monad m => Status -> RequestHeaders -> LT.Text -> FileExtListenerT Response m () textStatusHeaders s hs i =-  let r = responseLBS s hs $-            LT.encodeUtf8 i in+  let r = textOnlyStatusHeaders s hs i in   FileExtListenerT $ tell $     FileExts $ singleton Text r @@ -48,22 +38,13 @@   textOnly :: LT.Text -> Response-textOnly i =-  responseLBS status200 [("Content-Type", "text/plain")] $ LT.encodeUtf8 i+textOnly = textOnlyStatusHeaders status200 [("Content-Type", "text/plain")]  textOnlyStatus :: Status -> LT.Text -> Response-textOnlyStatus s i =-  responseLBS s [("Content-Type", "text/plain")] $ LT.encodeUtf8 i+textOnlyStatus s = textOnlyStatusHeaders s [("Content-Type", "text/plain")]  textOnlyHeaders :: RequestHeaders -> LT.Text -> Response-textOnlyHeaders hs i =-  responseLBS status200 hs $ LT.encodeUtf8 i+textOnlyHeaders = textOnlyStatusHeaders status200  textOnlyStatusHeaders :: Status -> RequestHeaders -> LT.Text -> Response-textOnlyStatusHeaders s hs i =-  responseLBS s hs $ LT.encodeUtf8 i-----+textOnlyStatusHeaders s hs i = bytestringOnlyStatus s hs $ LT.encodeUtf8 i

@@ -19,20 +19,26 @@   data FileExt = Html+             | Css+             | JavaScript              | 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+toExt x | x `elem` htmls       = Just Html+        | x `elem` csss        = Just Css+        | x `elem` javascripts = Just JavaScript+        | x `elem` jsons       = Just Json+        | x `elem` texts       = Just Text+        | otherwise            = Nothing   where-    htmls = ["", ".htm", ".html"]-    jsons = [".json"]-    texts = [".txt"]+    htmls       = [".htm", ".html"]+    csss        = [".css"]+    javascripts = [".js", ".javascript"]+    jsons       = [".json"]+    texts       = [".txt"]  newtype FileExts a = FileExts { unFileExts :: Map FileExt a }   deriving (Show, Eq, Functor, Traversable)

@@ -7,7 +7,6 @@   , RankNTypes   , FlexibleInstances   , UndecidableInstances-  , OverlappingInstances   , MultiParamTypeClasses   , FunctionalDependencies   , ConstraintKinds

@@ -10,6 +10,7 @@  import Data.Attoparsec.Text import Text.Regex+import Data.String (IsString (..)) import qualified Data.Text as T  @@ -21,6 +22,9 @@  l :: T.Text -> EitherUrlChunk 'Nothing l = (:=)++instance x ~ 'Nothing => IsString (EitherUrlChunk x) where+  fromString = l . T.pack  p :: (T.Text, Parser r) -> EitherUrlChunk ('Just r) p = (:~)