Skip to content
This repository was archived by the owner on May 23, 2019. It is now read-only.

added hacky, ugly, multi path support #1

Open
wants to merge 5 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 25 additions & 9 deletions Yesod/Routes/Typescript/Generator.hs
Original file line number Diff line number Diff line change
@@ -1,10 +1,11 @@
module Yesod.Routes.Typescript.Generator (genTypeScriptRoutes) where

import ClassyPrelude
import ClassyPrelude hiding (last)
import Data.Text (dropWhileEnd)
import qualified Data.Text as DT
import Filesystem (createTree)
import Data.Char (isUpper)
import Data.List (findIndices, last)
import Yesod.Routes.TH
-- ( ResourceTree(..),
-- Piece(Dynamic, Static),
Expand All @@ -18,8 +19,11 @@ import Yesod.Routes.TH
genTypeScriptRoutes :: [ResourceTree String] -> FilePath -> IO ()
genTypeScriptRoutes resourcesApp fp = do
createTree $ directory fp
writeFile fp routesCs
writeFile fp $ marshallFxn <> routesCs
where
-- referenced from http://stackoverflow.com/questions/4775722/check-if-object-is-array
marshallFxn =
"var __mrshl = (p:any) => (Object.prototype.toString.call(p) === '[object Array]' ? p.join('/') : p.toString())\n"
routesCs =
let res = (resToCoffeeString Nothing "" $ ResourceParent "paths" [] hackedTree)
in either id id (snd res)
Expand All @@ -41,15 +45,25 @@ genTypeScriptRoutes resourcesApp fp = do
cleanName = uncapitalize . dropWhileEnd isUpper
where uncapitalize t = (toLower $ take 1 t) <> drop 1 t

renderRoutePieces pieces = intercalate "/" $ map renderRoutePiece pieces
renderRoutePieces pieces isMulti =
intercalate "/" $ zipWith renderCheckingIdx [0..] pieces
where
renderCheckingIdx idx piece = renderRoutePiece piece <> arrayType
where arrayType | isMulti && idx == lastVarIdx = "[]"
| otherwise = ""
isDyn (_, Static _) = False
isDyn _ = True
lastVarIdx = case findIndices isDyn pieces of
[] -> error "Expected multipiece, didn't find a last var"
l -> last l
renderRoutePiece p = case p of
(_, Static st) -> pack st :: Text
(_, Dynamic "Text") -> ":string"
(_, Dynamic "Int") -> ":number"
(_, Dynamic d) ->
":" <> pack (if isSuffixOf "Id" d then "string" else pack d)
isVariable r = length r > 1 && DT.head r == ':'
resRoute res = renderRoutePieces $ resourcePieces res
resRoute res = renderRoutePieces (resourcePieces res) (isJust $ methodsMulti (resourceDispatch res))
resName res = cleanName . pack $ resourceName res
lastName res = fromMaybe (resName res)
. find (not . isVariable)
Expand All @@ -72,17 +86,19 @@ genTypeScriptRoutes resourcesApp fp = do
else [DT.replace "." "" $ lastName res]
in ([], Right $ intercalate "\n" $ map mkLine jsNames)
where
pieces :: [Text]
pieces = DT.splitOn "/" routeString
variables :: [(Text, Text)]
variables = snd $ foldl' (\(i,prev) typ -> (i+1, prev <> [("a" <> tshow i, typ)]))
(0::Int, [])
(filter isVariable pieces)
(filter isVariable pieces)
mkLine jsName = " public " <> jsName <> "("
<> csvArgs variables
<> "):string { return " <> quote (routeStr variables variablePieces) <> "; }"

routeStr vars ((Left p):rest) | null p = routeStr vars rest
| otherwise = "/" <> p <> routeStr vars rest
routeStr (v:vars) ((Right _):rest) = "/' + " <> fst v <> " + '" <> routeStr vars rest
routeStr (v:vars) ((Right _):rest) = "/' + __mrshl(" <> fst v <> ") + '" <> routeStr vars rest
routeStr [] [] = ""
routeStr _ [] = error "extra vars!"
routeStr [] _ = error "no more vars!"
Expand All @@ -99,7 +115,7 @@ genTypeScriptRoutes resourcesApp fp = do
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 <> "/")
fxn = resToCoffeeString parent (routePrefix <> "/" <> renderRoutePieces pieces False<> "/")
res = map fxn children

resToCoffeeString parent routePrefix (ResourceParent name pieces children) =
Expand All @@ -114,7 +130,7 @@ genTypeScriptRoutes resourcesApp fp = do
<> intercalate "\n" childMembers
<> " " <> parentMembers memberLinkFromParent
<> "\n\n"
<> " constructor(){\n "
<> " constructor(){\n"
<> parentMembers memberInitFromParent
<> "\n }\n"
<> "}\n\n"
Expand All @@ -123,7 +139,7 @@ genTypeScriptRoutes resourcesApp fp = do
childTypescript = map fxn children
jsName = maybe "" (<> "_") parent <> pref
fxn = resToCoffeeString (Just jsName)
(routePrefix <> "/" <> renderRoutePieces pieces <> "/")
(routePrefix <> "/" <> renderRoutePieces pieces False <> "/")
pref = cleanName $ pack name
resourceClassName = "PATHS_TYPE_" <> jsName

Expand Down
2 changes: 1 addition & 1 deletion yesod-routes-typescript.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
-- further documentation, see http://haskell.org/cabal/users-guide/

name: yesod-routes-typescript
version: 0.1.0.0
version: 0.2.0.0
-- synopsis:
-- description:
homepage: https://github.com/docmunch/yesod-routes-typescript
Expand Down