nested-routes 0.2.1 → 0.2.2

raw patch · 4 files changed

+42/−29 lines, 4 filesdep ~pred-trie

Dependency ranges changed: pred-trie

Files

• nested-routes.cabal +2/−2
• src/Web/Routes/Nested.hs +30/−20
• src/Web/Routes/Nested/Types.hs +5/−5
• src/Web/Routes/Nested/Types/UrlChunks.hs +5/−2

@@ -1,5 +1,5 @@ Name:                   nested-routes-Version:                0.2.1+Version:                0.2.2 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -32,7 +32,7 @@                       , lucid                       , bytestring                       , attoparsec-                      , pred-trie >= 0.0.7.1+                      , pred-trie >= 0.0.8  Test-Suite spec   Type:                 exitcode-stdio-1.0

@@ -49,6 +49,7 @@ import Debug.Trace import Data.Trie.Pred.Unified import Data.Trie.Pred.Unified.Tail+import Data.List (intercalate)   newtype HandlerT z m a = HandlerT@@ -107,29 +108,29 @@                            (Either                               (VerbListenerT z (FileExtListenerT Response m ()) m ())                               (VerbListenerT z Response m ())))-               , Extrude (UrlChunks xs)-                   (RUPTrie T.Text-                           (Either-                              (VerbListenerT z (FileExtListenerT Response m ()) m ())-                              (VerbListenerT z Response m ())))-                   (RUPTrie T.Text-                           (Either-                              (VerbListenerT z (FileExtListenerT Response m ()) m ())-                              (VerbListenerT z Response m ())))+              --  , Extrude (UrlChunks xs)+              --      (RUPTrie T.Text+              --              (ExpectArity xs (Either+              --                 (VerbListenerT z (FileExtListenerT Response m ()) m ())+              --                 (VerbListenerT z Response m ()))))+              --      (RUPTrie T.Text+              --              (Either+              --                 (VerbListenerT z (FileExtListenerT Response m ()) m ())+              --                 (VerbListenerT z Response m ())))                ) =>                UrlChunks xs             -> ExpectArity xs (Either (VerbListenerT z (FileExtListenerT Response m ()) m ()) (VerbListenerT z Response m ()))-            -> [HandlerT z m ()]+            -- -> [HandlerT z m ()] TODO: Encode contained arity top-level? Can't poop the right butt atm             -> HandlerT z m ()-handleParse ts vl [] =+handleParse ts vl =   HandlerT $ tell (singleton ts vl, mempty)-handleParse ts vl cs = do-  (child,_) <- lift $ foldM (\acc c -> (acc <>) <$> (execWriterT $ runHandler c)) mempty cs--  HandlerT $ tell $ let-                      child' = extrude ts child-                    in-                    (P.merge child' $ singleton ts vl, mempty)+-- handleParse ts vl cs = do+--   (child,_) <- lift $ foldM (\acc c -> (acc <>) <$> (execWriterT $ runHandler c)) mempty cs+--+--   HandlerT $ tell $ let+--                       child' = extrude ts child+--                     in+--                     (P.merge child' $ singleton ts vl, mempty)   notFound :: ( Monad m@@ -159,7 +160,7 @@   (rtrie, nftrie) <- execWriterT $ runHandler h   let mMethod  = httpMethodToMSym $ requestMethod req       mFileext = case pathInfo req of-                         [] -> Just Html+                         [] -> Just Html -- fucky balls - I need to remove file extensions INCREMENTALLY balls                          xs -> possibleExts $ getFileExt $ last xs       meitherNotFound = P.lookupNearestParent (pathInfo req) nftrie @@ -169,8 +170,10 @@     (Just f, Just v) -> do       menf <- handleNotFound f v meitherNotFound       let cleanedPathInfo = applyToLast trimFileExt $ pathInfo req+      liftIO $ putStrLn $ (T.unpack $ T.intercalate "/" cleanedPathInfo)       case P.lookup cleanedPathInfo rtrie of-        Just eitherM -> continue f v eitherM $ menf+        Just eitherM -> do liftIO $ putStrLn $ "sheeit"+                           continue f v eitherM $ menf         Nothing  -> case pathInfo req of           [] -> liftIO $ respond404 $ menf           _  -> case trimFileExt $ last $ pathInfo req of@@ -181,6 +184,13 @@     _ -> liftIO $ respond404 $ notFoundBasic    where+    showRUP (Rooted mx xs) = "Rooted " ++ showMaybe mx ++ concatMap showUP xs+      where+        showMaybe Nothing = "nada"+        showMaybe (Just _) = "just"+        showUP (UMore t _ xs) = " UMore " ++ T.unpack t ++ concatMap showUP xs+        showUP (UPred t _ _ _) = " UPred " ++ T.unpack t+     handleNotFound :: MonadIO m =>                       FileExt                    -> Verb

@@ -16,7 +16,7 @@   ( Singleton (..)   , Extend (..)   , Extrude (..)-  , iResultToMaybe+  , eitherToMaybe   , restAreLits   , ToNE (..)   , ToL (..)@@ -55,7 +55,7 @@   extend ((:=) t) (Rooted mx xs) = Rooted Nothing [UMore t mx xs]  instance Extend (EitherUrlChunk ('Just r)) (RUPTrie T.Text (r -> a)) (RUPTrie T.Text a) where-  extend ((:~) (t,q)) (Rooted mx xs) = Rooted Nothing [UPred t (iResultToMaybe . parse q) mx xs]+  extend ((:~) (t,q)) (Rooted mx xs) = Rooted Nothing [UPred t (eitherToMaybe . parseOnly q) mx xs]   class Extrude chunks start result | chunks start -> result where@@ -69,9 +69,9 @@   extrude (Cons u us) r = extend u (extrude us r)  -iResultToMaybe :: IResult T.Text r -> Maybe r-iResultToMaybe (Done _ r) = Just r-iResultToMaybe _          = Nothing+eitherToMaybe :: Either String r -> Maybe r+eitherToMaybe (Right r) = Just r+eitherToMaybe _         = Nothing  restAreLits :: UrlChunks xs -> Bool restAreLits Root = False

@@ -17,6 +17,9 @@   (:=) :: T.Text             -> EitherUrlChunk 'Nothing   (:~) :: (T.Text, Parser r) -> EitherUrlChunk ('Just r) +l = (:=)+p = (:~)+ -- | Container when defining route paths data UrlChunks (xs :: [Maybe *]) where   Cons :: EitherUrlChunk mx -> UrlChunks xs -> UrlChunks (mx ': xs) -- unpacks left-to-right@@ -40,6 +43,6 @@  (</>) = Cons -infixr 8 </>+infixr 9 </> -(#) = Root+o = Root