yesod-routes-typescript (empty) → 0.3.0.0
raw patch · 5 files changed
+258/−0 lines, 5 filesdep +attoparsecdep +basedep +classy-preludesetup-changed
Dependencies added: attoparsec, base, classy-prelude, system-fileio, text, yesod-core, yesod-routes
Files
- LICENSE +20/−0
- README.md +55/−0
- Setup.hs +2/−0
- Yesod/Routes/Typescript/Generator.hs +134/−0
- yesod-routes-typescript.cabal +47/−0
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 docmunch++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,55 @@+yesod-routes-typescript+=======================++parse the Yesod routes data structure and generate routes that can be used in typescript++The routing structure is generated by:++ mkYesodDispatch "App" resourcesApp++You can generate routes at startup inside the `makeApplication` function++ when development $+ genTypeScriptRoutes resourcesApp "assets/ts/paths-gen.ts"+++This generates typescript code:++ class PATHS_TYPE_paths {+ public contacts: PATHS_TYPE_paths_contacts;+ public admin: PATHS_TYPE_paths_admin;++ constructor(){+ this.contacts = new PATHS_TYPE_paths_contacts();+ this.admin = new PATHS_TYPE_paths_admin();+ }+ }++ class PATHS_TYPE_paths_contacts {+ public get():string { return '/api/v1/contacts/get'; }+ }++ class PATHS_TYPE_paths_admin {+ public adminDocs: PATHS_TYPE_paths_admin_adminDocs;++ constructor(){+ this.adminDocs = new PATHS_TYPE_paths_admin_adminDocs();+ }+ }++ class PATHS_TYPE_paths_admin_adminDocs {+ public get():string { return '/api/v1/admin/docs/get'; }+ }+++ var PATHS:PATHS_TYPE_paths = new PATHS_TYPE_paths();+++In your typescript code you can now do:+++ PATHS.admin.adminDocs.get()+++Please note that the Haskell code was hastily translated from javascript code and is pretty horrible.+There are bugs and edge cases to be addressed, but this works ok for us.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Yesod/Routes/Typescript/Generator.hs view
@@ -0,0 +1,134 @@+module Yesod.Routes.Typescript.Generator (genTypeScriptRoutes) where++import ClassyPrelude+import Data.Text (dropWhileEnd)+import qualified Data.Text as DT+import Filesystem (createTree)+import Data.Char (isUpper)+import Yesod.Routes.TH+ -- ( ResourceTree(..),+ -- Piece(Dynamic, Static),+ -- FlatResource,+ -- Resource(resourceDispatch, resourceName, resourcePieces),+ -- Dispatch(Methods, Subsite) )++-- Import all relevant handler modules here.+-- Don't forget to add new modules to your cabal file!++genTypeScriptRoutes :: [ResourceTree String] -> FilePath -> IO ()+genTypeScriptRoutes resourcesApp fp = do+ createTree $ directory fp+ writeFile fp routesCs+ where+ routesCs =+ let res = (resToCoffeeString Nothing "" $ ResourceParent "paths" [] hackedTree)+ in either id id (snd res)+ <> "\nvar PATHS:PATHS_TYPE_paths = new PATHS_TYPE_paths();"++ -- route hackery..+ fullTree = resourcesApp :: [ResourceTree String]+ landingRoutes = flip filter fullTree $ \case+ ResourceParent _ _ _ -> False+ ResourceLeaf res -> not $ elem (resourceName res) ["AuthR", "StaticR"]++ parentName :: String -> ResourceTree String -> Bool+ parentName name (ResourceParent n _ _) = n == name+ parentName _ _ = False++ parents =+ filter (\n -> parentName "PartialsH" n || parentName "ApiH" n) fullTree+ hackedTree = ResourceParent "staticPages" [] landingRoutes : parents+ cleanName = uncapitalize . dropWhileEnd isUpper+ where uncapitalize t = (toLower $ take 1 t) <> drop 1 t++ renderRoutePieces pieces = intercalate "/" $ map renderRoutePiece pieces+ renderRoutePiece p = case p of+ (_, Static st) -> pack st :: Text+ (_, Dynamic "Text") -> ":string"+ (_, Dynamic "Int") -> ":number"+ (_, Dynamic d) -> ":string"+ isVariable r = length r > 1 && DT.head r == ':'+ resRoute res = renderRoutePieces $ resourcePieces res+ resName res = cleanName . pack $ resourceName res+ lastName res = fromMaybe (resName res)+ . find (not . isVariable)+ . map renderRoutePiece+ . reverse+ . resourcePieces+ $ res+ singleSlash = DT.replace "//" "/"+ resToCoffeeString :: Maybe Text -> Text -> ResourceTree String -> ([(Text, Text)], Either Text Text)+ resToCoffeeString _ routePrefix (ResourceLeaf res) =+ let rname = resName res in+ -- previously assumed there weren't multiple methods per route path+ -- now hacking in support+ let jsNames = case resourceDispatch res of+ Subsite _ _ -> error "subsite!"+ Methods _ [] -> error "no methods!"+ Methods _ methods ->+ if length methods > 1 || rname == ""+ then map (toLower . pack) methods+ else [DT.replace "." "" $ lastName res]+ in ([], Right $ intercalate "\n" $ map mkLine jsNames)+ where+ pieces = DT.splitOn "/" routeString+ variables = snd $ foldl' (\(i,prev) typ -> (i+1, prev <> [("a" <> tshow i, typ)]))+ (0::Int, [])+ (filter isVariable pieces)+ mkLine jsName = " public " <> jsName <> "("+ <> csvArgs variables+ <> "):string { "+ -- <> presenceChk+ <> "return " <> quote (routeStr variables variablePieces) <> "; }"+ -- presenceChk = case variables of+ -- [] -> ""+ -- l -> "if (" <> intercalate " || " (map (("!" <>) . fst) l) <> ") { return null } "+ routeStr vars ((Left p):rest) | null p = routeStr vars rest+ | otherwise = "/" <> p <> routeStr vars rest+ routeStr (v:vars) ((Right _):rest) = "/' + " <> fst v <> ".toString() + '" <> routeStr vars rest+ routeStr [] [] = ""+ routeStr _ [] = error "extra vars!"+ routeStr [] _ = error "no more vars!"++ variablePieces = map (\p -> if isVariable p then Right p else Left p) pieces+ csvArgs :: [(Text, Text)] -> Text+ csvArgs = intercalate "," . map (\(var, typ) -> var <> typ)+ quote str = "'" <> str <> "'"+ routeString = singleSlash routePrefix <> resRoute res++ -- this is here because in the typescript code, we dont refer to+ -- PATHS.api.doc.foo but PATHS.doc.foobar. so we can keep our route+ -- orgazniation in place but also leave TS alone+ resToCoffeeString parent routePrefix (ResourceParent "ApiH" pieces children) =+ (concatMap fst res, Left $ intercalate "\n" (map (either id id . snd) res))+ where+ fxn = resToCoffeeString parent (routePrefix <> "/" <> renderRoutePieces pieces <> "/")+ res = map fxn children++ resToCoffeeString parent routePrefix (ResourceParent name pieces children) =+ ([linkFromParent], Left $ resourceClassDef)+ where+ parentMembers f =+ intercalate "\n " $ map f $ concatMap fst childTypescript+ memberInitFromParent (slot, klass) = " this." <> slot <> " = new " <> klass <> "();"+ memberLinkFromParent (slot, klass) = "public " <> slot <> ": " <> klass <> ";"+ linkFromParent = (pref, resourceClassName)+ resourceClassDef = "class " <> resourceClassName <> " {\n"+ <> intercalate "\n" childMembers+ <> " " <> parentMembers memberLinkFromParent+ <> "\n\n"+ <> " constructor(){\n "+ <> parentMembers memberInitFromParent+ <> "\n }\n"+ <> "}\n\n"+ <> intercalate "\n" childClasses+ (childClasses, childMembers) = partitionEithers $ map snd childTypescript+ childTypescript = map fxn children+ jsName = maybe "" (<> "_") parent <> pref+ fxn = resToCoffeeString (Just jsName)+ (routePrefix <> "/" <> renderRoutePieces pieces <> "/")+ pref = cleanName $ pack name+ resourceClassName = "PATHS_TYPE_" <> jsName++deriving instance (Show a) => Show (ResourceTree a)+deriving instance (Show a) => Show (FlatResource a)
+ yesod-routes-typescript.cabal view
@@ -0,0 +1,47 @@+-- Initial yesod-routes-typescript.cabal generated by cabal init. For +-- further documentation, see http://haskell.org/cabal/users-guide/++name: yesod-routes-typescript+version: 0.3.0.0+synopsis: generate TypeScript routes for Yesod+description: parse the Yesod routes data structure and generate routes that can be used in typescript+homepage: https://github.com/docmunch/yesod-routes-typescript+license: MIT+license-file: LICENSE+author: Max Cantor+maintainer: max@docmunch.com+-- copyright: +category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ exposed-modules: Yesod.Routes.Typescript.Generator+ -- other-modules: + -- other-extensions: + default-extensions:+ ConstraintKinds,+ DeriveDataTypeable,+ ExtendedDefaultRules,+ FlexibleContexts,+ FlexibleInstances,+ LambdaCase,+ NoImplicitPrelude,+ OverloadedStrings,+ RecordWildCards,+ ScopedTypeVariables,+ StandaloneDeriving,+ TemplateHaskell,+ TupleSections,+ TypeSynonymInstances+ build-depends:+ attoparsec,+ base < 5,+ classy-prelude >= 0.7,+ system-fileio,+ text,+ yesod-core >= 1.2 && < 2.0,+ yesod-routes >= 1.2 && < 2.0+ -- hs-source-dirs: + default-language: Haskell2010