route-generator (empty) → 0.1

raw patch · 5 files changed

+219/−0 lines, 5 filesdep +attoparsecdep +basedep +textsetup-changed

Dependencies added: attoparsec, base, text, yesod-routes

Files

COPYING +13/−0
README +30/−0
Setup.hs +3/−0
route-generator.cabal +62/−0
routeGenerator.hs +111/−0

+ COPYING view

@@ -0,0 +1,13 @@+Copyright © 2012, Stephen Paul Weber <singpolyma.net>++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

+ README view

@@ -0,0 +1,30 @@+Most of the defacto Haskell web routing libraries are either linear+in complexity, or require lots of extra extensions, like Template+Haskell.++Luckily, yesod-routes has Yesod.Routes.Dispatch, which is a very clean,+efficient, and extension-free router.  Writing routes out in code can,+however, be quite verbose.  This utility is a code generator to produce+routes compatible with Yesod.Routes.Dispatch from a nice input format.++Example:++> GET /       => home+> GET /post/: => showPost+> PUT /*      => updateSomething++> ./routeGenerator routes.txt SomeModule++Will generate routes that map the correct HTTP verb (which you should+pass as a prepended "path segment" to your Dispatch) and path to+functions imported from the module specified in the second parameter.++A colon matches any path segment, and passes the matched segment+through to the specified function, passing each match segment in order.+The expected type of the segment is inferred from the type of the+function.  If the segment cannot be parsed as that type, the path does+not match.  Parsing is done with Web.PathPieces.fromPathPiece.++An asterisk at the end of the path causes rhHasMulti to be set to True,+meaning that any path segments after what has been specified will be+allowed.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

+ route-generator.cabal view

@@ -0,0 +1,62 @@+name:            route-generator+version:         0.1+cabal-version:   >= 1.8+license:         OtherLicense+license-file:    COPYING+category:        Utility+copyright:       © 2012 Stephen Paul Weber+author:          Stephen Paul Weber <singpolyma@singpolyma.net>+maintainer:      Stephen Paul Weber <singpolyma@singpolyma.net>+stability:       experimental+tested-with:     GHC == 7.0.3+synopsis:        Utility to generate routes for use with yesod-routes+homepage:        http://github.com/singpolyma/route-generator+bug-reports:     http://github.com/singpolyma/route-generator/issues+build-type:      Simple+description:+        Most of the defacto Haskell web routing libraries are either linear+        in complexity, or require lots of extra extensions, like Template+        Haskell.+        .+        Luckily, yesod-routes has Yesod.Routes.Dispatch, which is a very clean,+        efficient, and extension-free router.  Writing routes out in code can,+        however, be quite verbose.  This utility is a code generator to produce+        routes compatible with Yesod.Routes.Dispatch from a nice input format.+        .+        Example:+        .+        > GET /       => home+        > GET /post/: => showPost+        > PUT /*      => updateSomething+        .+        > ./routeGenerator routes.txt SomeModule+        .+        Will generate routes that map the correct HTTP verb (which you should+        pass as a prepended "path segment" to your Dispatch) and path to+        functions imported from the module specified in the second parameter.+        .+        A colon matches any path segment, and passes the matched segment+        through to the specified function, passing each match segment in order.+        The expected type of the segment is inferred from the type of the+        function.  If the segment cannot be parsed as that type, the path does+        not match.  Parsing is done with Web.PathPieces.fromPathPiece.+        .+        An asterisk at the end of the path causes rhHasMulti to be set to True,+        meaning that any path segments after what has been specified will be+        allowed.++extra-source-files:+        README++executable routeGenerator+        main-is: routeGenerator.hs++        build-depends:+                base == 4.*,+                text >= 0.7,+                attoparsec >= 0.10.0.0,+                yesod-routes++source-repository head+        type:     git+        location: git://github.com/route-generator/BitBrawl.git

+ routeGenerator.hs view

@@ -0,0 +1,111 @@+module Main where++import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)+import Data.List (intercalate)+import Data.Char (isUpper, isSpace)+import Data.Maybe (catMaybes, isJust)+import Yesod.Routes.Dispatch (Piece(Static, Dynamic))++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T++import Data.Attoparsec.Text+import Control.Applicative++data Route = Route {+		method :: Text,+		pieces :: [Piece],+		multi  :: Bool,+		target :: Text+	}+	deriving (Show)++instance Show Piece where+	show Dynamic = "Dynamic"+	show (Static s) = "Static (pack " ++ show (T.unpack s) ++ ")"++emitRoutes :: [Route] -> IO ()+emitRoutes rs = do+	-- We want to be polymorphic in the parameter to route, so just let+	-- the inference engine do it all+	-- putStrLn "routes :: [Route a]"+	putStrLn "routes = ["+	putStrLn $ intercalate ",\n" $ map showRoute rs+	putStrLn "\t]"+	where+	showRoute r =+		"\t\tRoute {\n" +++		"\t\t\trhPieces = " +++		show (Static (method r) : pieces r) +++		",\n" ++++		"\t\t\trhHasMulti = " +++		show (multi r) +++		",\n" ++++		"\t\t\trhDispatch = (\\(" +++		piecesPattern (pieces r) +++		") -> (return " +++		T.unpack (target r) +++		")" +++		piecesAp (pieces r) +++		")\n" ++++		"\t\t}"++	piecesAp pieces = concat $ fst $ foldr (\p (ps,c) -> case p of+			Dynamic -> ((" `ap` (fromPathPiece val" ++ show c ++ ")"):ps, c+1)+			Static _ -> (ps, c)+		) ([],0::Int) pieces++	piecesPattern pieces = intercalate ":" $ ("_":) $ fst $+		foldr (\p (ps,c) -> case p of+			Dynamic -> (("val" ++ show c):ps, c+1)+			Static _ -> ("_":ps, c)+		) (["_"],0::Int) pieces++parser :: Parser [Route]+parser = many1 $ do+	skipSpace+	m <- method+	skipSpace+	p <- pieces+	multi <- fmap isJust $ option Nothing (fmap Just (char '*'))+	skipSpace+	_ <- char '='+	_ <- char '>'+	skipSpace+	t <- target+	skipWhile (\x -> isSpace x && not (isEndOfLine x))+	endOfLine+	return $ Route m p multi t+	where+	target = takeWhile1 (not . isSpace)+	method = takeWhile1 isUpper+	pieces = fmap catMaybes $ many1 $ do+		_ <- char '/'+		option Nothing (fmap Just piece)+	piece = dynamic <|> static+	static = fmap Static (takeWhile1 (\x -> x /= '/' && x /= '*' && not (isSpace x)))+	dynamic = char ':' >> return Dynamic++main :: IO ()+main = do+	args <- getArgs+	case args of+		[input, mod] -> do+			Right routes <- fmap (parseOnly parser) $ T.readFile input++			putStrLn "module Routes where"+			putStrLn ""+			putStrLn $ "import " ++ mod+			putStrLn "import Control.Monad (ap)"+			putStrLn "import Data.Text (pack)"+			putStrLn "import Web.PathPieces (fromPathPiece)"+			putStrLn "import Yesod.Routes.Dispatch (Route(..), Piece(Static, Dynamic))"+			putStrLn ""+			emitRoutes routes+		_ ->+			hPutStrLn stderr "Usage: ./routeGenerator <input file> <implementation module>"