rest-gen 0.20.0.0 → 0.20.0.1
raw patch · 12 files changed
+112/−89 lines, 12 filesdep ~Cabaldep ~basedep ~process
Dependency ranges changed: Cabal, base, process
Files
- rest-gen.cabal +12/−12
- src/Rest/Gen/Base.hs +5/−10
- src/Rest/Gen/Base/ActionInfo.hs +7/−9
- src/Rest/Gen/Base/JSON.hs +3/−2
- src/Rest/Gen/Base/JSON/Pretty.hs +3/−1
- src/Rest/Gen/Base/Link.hs +6/−6
- src/Rest/Gen/Base/XML.hs +3/−3
- src/Rest/Gen/Docs.hs +15/−14
- src/Rest/Gen/Haskell.hs +40/−13
- src/Rest/Gen/JavaScript.hs +10/−11
- src/Rest/Gen/Ruby.hs +7/−7
- tests/Runner.hs +1/−1
rest-gen.cabal view
@@ -1,5 +1,5 @@ name: rest-gen-version: 0.20.0.0+version: 0.20.0.1 description: Documentation and client generation from rest definition. synopsis: Documentation and client generation from rest definition. maintainer: code@silk.co@@ -49,22 +49,22 @@ Rest.Gen.NoAnnotation Rest.Gen.Utils build-depends:- base >= 4.5 && < 4.10- , Cabal >= 1.16 && < 1.26+ base >= 4.5 && < 4.11+ , Cabal >= 1.16 && < 2.2 , HStringTemplate >= 0.6 && < 0.9- , aeson >= 0.7 && < 1.1+ , aeson >= 0.7 && < 1.3 , base-compat >= 0.8 && < 0.10- , blaze-html >= 0.5 && < 0.9+ , blaze-html >= 0.5 && < 0.10 , code-builder == 0.1.*- , directory >= 1.1 && < 1.3+ , directory >= 1.1 && < 1.4 , fclabels >= 1.0.4 && < 2.1 , filepath >= 1.2 && < 1.5 , hashable >= 1.1 && < 1.3- , haskell-src-exts >= 1.18.1 && < 1.19+ , haskell-src-exts >= 1.18.1 && < 1.20 , hxt >= 9.2 && < 9.4 , json-schema >= 0.6 && < 0.8 , pretty >= 1.0 && < 1.2- , process >= 1.0 && < 1.5+ , process >= 1.0 && < 1.7 , rest-core >= 0.38 && < 0.40 , safe >= 0.2 && < 0.4 , semigroups >= 0.5 && < 0.19@@ -73,7 +73,7 @@ , text >= 0.11 && < 1.3 , uniplate >= 1.6.12 && < 1.7 , unordered-containers == 0.2.*- , vector >= 0.10 && < 0.12+ , vector >= 0.10 && < 0.13 if impl(ghc < 7.8) build-depends: tagged >= 0.2 && < 0.9 @@ -83,10 +83,10 @@ type: exitcode-stdio-1.0 ghc-options: -Wall build-depends:- base >= 4.5 && < 4.10- , HUnit >= 1.2 && < 1.4+ base >= 4.5 && < 4.11+ , HUnit >= 1.2 && < 1.7 , fclabels >= 1.0.4 && < 2.1- , haskell-src-exts >= 1.15.0 && < 1.19+ , haskell-src-exts >= 1.15.0 && < 1.20 , rest-core >= 0.38 && < 0.40 , rest-gen , test-framework == 0.8.*
src/Rest/Gen/Base.hs view
@@ -1,11 +1,6 @@-module Rest.Gen.Base- ( module Rest.Gen.Base.ActionInfo- , module Rest.Gen.Base.ActionInfo.Ident- , module Rest.Gen.Base.ApiTree- , module Rest.Gen.Base.Link- ) where+module Rest.Gen.Base (module X) where -import Rest.Gen.Base.ActionInfo-import Rest.Gen.Base.ActionInfo.Ident (Ident (Ident, description))-import Rest.Gen.Base.ApiTree-import Rest.Gen.Base.Link+import Rest.Gen.Base.ActionInfo as X+import Rest.Gen.Base.ActionInfo.Ident as X (Ident (Ident, description))+import Rest.Gen.Base.ApiTree as X+import Rest.Gen.Base.Link as X
src/Rest/Gen/Base/ActionInfo.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS -Wno-incomplete-patterns #-} {-# LANGUAGE GADTs , LambdaCase@@ -179,9 +180,7 @@ dataTypesToAcceptHeader def = \case [] -> dataTypeToAcceptHeader def xs -> intercalate "," . map dataTypeToAcceptHeader . (xs ++) $- if null (intersect xs [XML,JSON])- then [def]- else []+ [def | null (xs `intersect` [XML, JSON])] dataTypeToAcceptHeader :: DataType -> String dataTypeToAcceptHeader = \case@@ -219,7 +218,7 @@ intersection :: NonEmpty DataDescription -> NonEmpty DataDescription -> ResponseType intersection o e = -- Try to find a response type that can be used for both output and error.- case intersect (f o) (f e) of+ case f o `intersect` f e of -- If the response types are disjoint we need to specify both. [] -> ResponseType@@ -238,7 +237,7 @@ -- Prioritize formats . sortBy (comparing cmp) -- Pick only the data types in the intersection of outputs and errors- . filter ((`elem` dts) . (L.get (dataType . desc)))+ . filter ((`elem` dts) . L.get (dataType . desc)) . NList.toList -- When we have an intersection with multiple possible -- types, we prefer JSON over XML, and XML over the rest.@@ -346,7 +345,7 @@ <$> mkMultiHandler id_ (const id) h removeActionInfo :: Link -> Handler m -> ActionInfo-removeActionInfo lnk = handlerActionInfo Nothing True Delete Self "" DELETE lnk+removeActionInfo = handlerActionInfo Nothing True Delete Self "" DELETE multiRemoveActionInfo :: Monad m => Id sid -> String -> Handler m -> Maybe ActionInfo multiRemoveActionInfo id_ pth h = handlerActionInfo Nothing False DeleteMany Any pth DELETE []@@ -396,9 +395,7 @@ makeLink | postAct = ac ++ dirPart ++ identPart | otherwise = dirPart ++ identPart- where dirPart = if pth /= ""- then [LAction pth]- else []+ where dirPart = [LAction pth | pth /= ""] identPart = maybe [] ((:[]) . LParam . Ident.description) id_ @@ -465,6 +462,7 @@ -- so we stick with the convention of preferring JSON. RawJsonAndXmlO -> defaultDescription File "File" haskellStringType FileO -> defaultDescription File "File" haskellByteStringType+ -- TODO: MultiPartO -- | Extract input description from handlers handlerErrors :: Handler m -> [DataDescription]
src/Rest/Gen/Base/JSON.hs view
@@ -7,6 +7,7 @@ , showExamples ) where +import Control.Applicative ((<|>)) import Data.Aeson ((.=)) import Data.JSON.Schema import Data.List (transpose)@@ -104,7 +105,7 @@ boundExample :: Num a => Bound -> a-boundExample b = fromIntegral $ fromMaybe 0 (maybe (lower b) Just (upper b))+boundExample b = fromIntegral . fromMaybe 0 $ upper b <|> lower b lengthBoundExample :: Num a => LengthBound -> a-lengthBoundExample b = fromIntegral $ fromMaybe 0 (maybe (lowerLength b) Just (upperLength b))+lengthBoundExample b = fromIntegral $ fromMaybe 0 (upperLength b <|> lowerLength b)
src/Rest/Gen/Base/JSON/Pretty.hs view
@@ -11,6 +11,8 @@ import qualified Data.HashMap.Strict as H import qualified Data.Vector as V +{-# ANN module "Hlint: ignore Use camelCase" #-}+ pp_value :: Value -> Doc pp_value v = case v of Null -> pp_null@@ -55,7 +57,7 @@ where pp_field (k,v) = pp_string k <> colon <+> pp_value v pp_js_string :: String -> Doc-pp_js_string x = pp_string x+pp_js_string = pp_string pp_js_object :: HashMap Text Value -> Doc pp_js_object = pp_object . map (first unpack) . H.toList
src/Rest/Gen/Base/Link.hs view
@@ -69,16 +69,16 @@ getLinkIds :: Link -> [(String, [(String, String)])] getLinkIds l = case l of- [] -> []- (q: (LParam p) : rs) -> (itemString q, [(itemString q, p)]) : getLinkIds rs- (q: (LAccess ls) : rs) -> (itemString q, concatMap snd $ concatMap (getLinkIds . (q : )) ls) : getLinkIds rs- (_: rs) -> getLinkIds rs+ [] -> []+ (q: LParam p : rs) -> (itemString q, [(itemString q, p)]) : getLinkIds rs+ (q: LAccess ls : rs) -> (itemString q, concatMap snd $ concatMap (getLinkIds . (q : )) ls) : getLinkIds rs+ (_: rs) -> getLinkIds rs setLinkIds :: Link -> [String] -> String setLinkIds _ [] = error "Error in setLinkIds, not enough parameters" setLinkIds l (p : ps) = case l of [] -> ""- (_: (LParam _) : rs) -> "/" ++ p ++ setLinkIds rs ps- (_: (LAccess _) : rs) -> "/" ++ p ++ setLinkIds rs ps+ (_: LParam _ : rs) -> "/" ++ p ++ setLinkIds rs ps+ (_: LAccess _ : rs) -> "/" ++ p ++ setLinkIds rs ps (s: rs) -> "/" ++ itemString s ++ setLinkIds rs (p: ps)
src/Rest/Gen/Base/XML.hs view
@@ -41,9 +41,9 @@ ++ indent (concatMap (showSchema' "") ss) ++ ["</xs:choice>"] - showSchema' ats (Rep l u s) = showSchema' (ats ++ concatMap (' ':) (mn ++ mx)) s- where mn = if l >= 0 then ["minOccurs=" ++ show l] else []- mx = if u >= 0 then ["maxOccurs=" ++ show u] else []+ showSchema' ats (Rep _ u s) = showSchema' (unwords $ ats : mn ++ mx) s+ where mn = ["minOccurs=" ++ show u | u >= 0]+ mx = ["maxOccurs=" ++ show u | u >= 0] showSchema' ats (Element n (CharData dty)) = ["<xs:element name='" ++ n ++ "' type='" ++ dataToString dty ++ "'" ++ ats ++ "/>"] showSchema' ats (Element n (Seq [])) = ["<xs:element name='" ++ n ++ "'" ++ ats ++ "/>"]
src/Rest/Gen/Docs.hs view
@@ -11,7 +11,7 @@ , writeDocs ) where -import Prelude hiding (div, head, id, id, span, (.))+import Prelude hiding (div, head, span, (.)) import qualified Prelude as P import Control.Category ((.))@@ -24,10 +24,11 @@ import System.FilePath import Text.Blaze.Html import Text.Blaze.Html5 hiding (map, meta, style)-import Text.Blaze.Html5.Attributes hiding (method, span, title)+import Text.Blaze.Html5.Attributes hiding (id, method, span, title) import Text.Blaze.Html.Renderer.String import Text.StringTemplate-import qualified Data.Label.Total as L+import qualified Data.Label.Total as L+import qualified Text.Blaze.Html5.Attributes as A import Rest.Api (Router, Version) import Rest.Gen.Base@@ -101,10 +102,10 @@ -- | Recursively generate information for a resource structure resourcesInfo :: DocsContext -> ApiResource -> Html-resourcesInfo ctx = foldTree $ (\it -> sequence_ . (resourceInfo ctx it :) )+resourcesInfo ctx = foldTree $ \it -> sequence_ . (resourceInfo ctx it :) subResourcesInfo :: DocsContext -> ApiResource -> Html-subResourcesInfo ctx = foldTreeChildren sequence_ $ (\it -> sequence_ . (resourceInfo ctx it :) )+subResourcesInfo ctx = foldTreeChildren sequence_ $ \it -> sequence_ . (resourceInfo ctx it :) -- | Generate information for one resource resourceInfo :: DocsContext -> ApiResource -> Html@@ -125,16 +126,16 @@ resourceIdentifiers lnk lnks = case lnks of [] -> [toHtml "No identifiers"]- ls -> map (linkHtml . (lnk ++)) $ ls+ ls -> map (linkHtml . (lnk ++)) ls resourceTable :: ApiResource -> Html resourceTable it = let urlInfo = groupByFirst . concatMap (\ai -> map (,itemInfo ai) $ flattenLast $ itemLink ai) $ resItems it in table ! cls "bordered-table resource-table" $ do thead $ mapM_ (\v -> th ! cls v $ toHtml v) ["URL", "Method", "Description", "Input", "Output", "Errors", "Parameters"]- tbody $ flip mapM_ (zip [(1 :: Int)..] urlInfo) $ \(n, (url, ais)) ->- do tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-main-row") $ mapM_ td $- [ linkHtml $ url+ tbody $ forM_ (zip [(1 :: Int)..] urlInfo) $ \(n, (url, ais)) ->+ do tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-main-row") $ mapM_ td+ [ linkHtml url , toHtml $ show $ method $ P.head ais , toHtml $ mkActionDescription (resName it) $ P.head ais , dataDescriptions "None" $ inputs $ P.head ais@@ -142,8 +143,8 @@ , dataDescriptions "None" $ errors $ P.head ais , toHtml $ if null (params (P.head ais)) then "None" else intercalate ", " $ params $ P.head ais ]- flip mapM_ (tail ais) $ \ai ->- tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-data-row") $ mapM_ td $+ forM_ (tail ais) $ \ai ->+ tr ! cls ("stripe-" ++ show (n `mod` 2) ++ " url-data-row") $ mapM_ td [ return () , toHtml $ show $ method ai , toHtml $ mkActionDescription (resName it) ai@@ -172,13 +173,13 @@ mkCode :: String -> String -> String -> Html mkCode lng cap cd = let eid = "idv" ++ show (hash cd)- in do div ! cls "modal hide fade code" ! id (toValue eid) $+ in do div ! cls "modal hide fade code" ! A.id (toValue eid) $ do cdiv "modal-header" $ do a ! href (toValue "#") ! cls "close" $ toHtml "x" h3 $ toHtml cap cdiv "modal-body" $ div ! style (toValue "overflow:auto; max-height:600px") $- pre ! cls ("prettyprint lang-" ++ lng) $ toHtml $ cd+ pre ! cls ("prettyprint lang-" ++ lng) $ toHtml cd button ! cls "btn open-modal" ! customAttribute (fromString "data-controls-modal") (toValue eid) ! customAttribute (fromString "data-backdrop") (toValue "true")@@ -204,5 +205,5 @@ linkHtml = mapM_ linkItem where linkItem (LParam idf) = toHtml ("/<" ++ idf ++ ">") linkItem (LAccess lnks) = span ! class_ (toValue "link-block") $ sequence_ $ intersperse br- $ map linkHtml $ reverse $ sortBy (compare `on` length) lnks+ $ map linkHtml $ sortBy (flip compare `on` length) lnks linkItem x = toHtml ("/" ++ itemString x)
src/Rest/Gen/Haskell.hs view
@@ -86,32 +86,58 @@ updateExposedModules modules = modify _condLibrary (Just . maybe (mkCondLibrary modules) (set (_exposedModules . _condTreeData) modules)) mkGenericPackageDescription :: String -> [Cabal.ModuleName] -> Cabal.GenericPackageDescription-mkGenericPackageDescription name modules = Cabal.GenericPackageDescription pkg [] (Just (mkCondLibrary modules)) [] [] []+mkGenericPackageDescription name modules =+#if MIN_VERSION_Cabal(2,0,0)+ Cabal.GenericPackageDescription pkg [] (Just (mkCondLibrary modules)) [] [] [] [] []+#else+ Cabal.GenericPackageDescription pkg [] (Just (mkCondLibrary modules)) [] [] []+#endif where pkg = Cabal.emptyPackageDescription- { Cabal.package = Cabal.PackageIdentifier (Cabal.PackageName name) (Cabal.Version [0, 1] [])+ { Cabal.package = Cabal.PackageIdentifier (cabalPackageName name) (cabalVersion [0, 1]) , Cabal.buildType = Just Cabal.Simple- , Cabal.specVersionRaw = Right (Cabal.orLaterVersion (Cabal.Version [1, 8] []))+ , Cabal.specVersionRaw = Right (Cabal.orLaterVersion (cabalVersion [1, 8])) } mkCondLibrary :: [Cabal.ModuleName] -> Cabal.CondTree Cabal.ConfVar [Cabal.Dependency] Cabal.Library mkCondLibrary modules = Cabal.CondNode { Cabal.condTreeData = cabalLibrary modules , Cabal.condTreeConstraints =- [ Cabal.Dependency (Cabal.PackageName "base") (Cabal.withinVersion $ Cabal.Version [4] [])- , Cabal.Dependency (Cabal.PackageName "rest-types") (Cabal.withinVersion $ Cabal.Version [1, 10] [])- , Cabal.Dependency (Cabal.PackageName "rest-client") (Cabal.withinVersion $ Cabal.Version [0, 5, 2] [])+ [ Cabal.Dependency (cabalPackageName "base") (Cabal.withinVersion $ cabalVersion [4] )+ , Cabal.Dependency (cabalPackageName "rest-types") (Cabal.withinVersion $ cabalVersion [1, 10] )+ , Cabal.Dependency (cabalPackageName "rest-client") (Cabal.withinVersion $ cabalVersion [0, 5, 2]) ] , Cabal.condTreeComponents = [] } cabalLibrary :: [Cabal.ModuleName] -> Cabal.Library+#if MIN_VERSION_Cabal(2,0,0)+cabalLibrary mods = Cabal.emptyLibrary+ { Cabal.exposedModules = mods+ , Cabal.libBuildInfo = (Cabal.libBuildInfo Cabal.emptyLibrary) { Cabal.hsSourceDirs = ["src"] }+ }+#else #if MIN_VERSION_Cabal(1,22,0) cabalLibrary mods = Cabal.Library mods [] [] [] True Cabal.emptyBuildInfo { Cabal.hsSourceDirs = ["src"] } #else cabalLibrary mods = Cabal.Library mods True Cabal.emptyBuildInfo { Cabal.hsSourceDirs = ["src"] } #endif+#endif +cabalVersion :: [Int] -> Cabal.Version+#if MIN_VERSION_Cabal(2,0,0)+cabalVersion = Cabal.mkVersion+#else+cabalVersion v = Cabal.Version v []+#endif++cabalPackageName :: String -> Cabal.PackageName+#if MIN_VERSION_Cabal(2,0,0)+cabalPackageName = Cabal.mkPackageName+#else+cabalPackageName = Cabal.PackageName+#endif+ writeRes :: HaskellContext -> ApiResource -> IO () writeRes ctx node = do createDirectoryIfMissing True (targetPath ctx </> "src" </> modPath (namespace ctx ++ resParents node))@@ -180,7 +206,7 @@ useMQual :: Maybe N.ModuleName -> N.Name -> N.Exp useMQual Nothing = use-useMQual (Just qual) = H.Var () . (H.Qual () qual)+useMQual (Just qual) = H.Var () . H.Qual () qual mkFunction :: Version -> String -> ApiAction -> ([N.Decl], [N.ModuleName]) mkFunction ver res (ApiAction _ lnk ai) =@@ -363,11 +389,12 @@ (fparams, rhs) = case mi of Nothing ->- ([H.PVar () $ H.Ident () (dataName pth)],- (H.UnGuardedRhs () $ H.List () [stringLit pth]))+ ( [H.PVar () . H.Ident () $ dataName pth]+ , H.UnGuardedRhs () $ H.List () [stringLit pth]+ ) Just{} -> -- Pattern match with data constructor ([H.PParen () $ H.PApp () (H.UnQual () $ H.Ident () (dataName pth)) [H.PVar () x]],- (H.UnGuardedRhs () $ H.List () [stringLit pth, showURLx]))+ H.UnGuardedRhs () $ H.List () [stringLit pth, showURLx]) in [ H.DataDecl () (H.DataType ()) Nothing (H.DHead () tyIdent) (map ctor ls) Nothing , H.TypeSig () [funName] fType ] ++ concatMap fun ls@@ -379,7 +406,7 @@ funName :: N.Name funName = H.Ident () "readId" showURLx :: N.Exp- showURLx = H.App () (H.Var () $ H.UnQual () $ H.Ident () "showUrl") (H.Var () $ H.UnQual () $ x)+ showURLx = H.App () (H.Var () $ H.UnQual () $ H.Ident () "showUrl") (H.Var () $ H.UnQual () x) tyIdent :: N.Name tyIdent = H.Ident () "Identifier"@@ -403,8 +430,8 @@ Modify -> if resDir ai == "" then ["do"] else [resDir ai] target = if resDir ai == "" then maybe [] ((:[]) . description) (ident ai) else [resDir ai]- by = if target /= [] && (isJust (ident ai) || actionType ai == UpdateMany) then ["by"] else []- get = if isAccessor ai then [] else ["get"]+ by = ["by" | target /= [] && (isJust (ident ai) || actionType ai == UpdateMany)]+ get = ["get" | not (isAccessor ai)] hsName :: [String] -> N.Name hsName [] = H.Ident () ""
src/Rest/Gen/JavaScript.hs view
@@ -4,11 +4,10 @@ import Prelude hiding ((.)) import Control.Category ((.))-import Control.Monad import Data.Maybe import Text.StringTemplate-import qualified Data.Label.Total as L-import qualified Data.List.NonEmpty as NList+import qualified Data.Label.Total as L+import qualified Data.List.NonEmpty as NList import Code.Build import Code.Build.JavaScript@@ -20,8 +19,8 @@ mkJsApi :: N.ModuleName -> Bool -> Version -> Router m s -> IO String mkJsApi ns priv ver r =- do prelude <- liftM (render . setManyAttrib attrs . newSTMP) (readContent "Javascript/prelude.js")- epilogue <- liftM (render . setManyAttrib attrs . newSTMP) (readContent "Javascript/epilogue.js")+ do prelude <- render . setManyAttrib attrs . newSTMP <$> readContent "Javascript/prelude.js"+ epilogue <- render . setManyAttrib attrs . newSTMP <$> readContent "Javascript/epilogue.js" let cod = showCode $ mkStack [ unModuleName ns ++ ".prototype.version" .=. string (show ver) , mkJsCode (unModuleName ns) priv r@@ -39,7 +38,7 @@ mkJs ns = foldTreeChildren mkStack (\i ls -> mkStack $ mkRes ns i : ls) mkRes :: String -> ApiResource -> Code-mkRes ns node = mkStack $+mkRes ns node = mkStack [ if hasAccessor node then resourceLoc ns node .=. mkAccessorConstructor ns node else resourceLoc ns node .=. jsObject []@@ -80,8 +79,8 @@ let fParams = maybeToList mIdent urlPart = (if resDir ai == "" then "" else resDir ai ++ "/") ++ maybe "" (\i -> "' + encodeURIComponent(" ++ i ++ ") + '/") mIdent- mIdent = fmap (jsId . cleanName . description) $ ident ai- in function fParams $+ mIdent = jsId . cleanName . description <$> ident ai+ in function fParams [ var "postfix" $ "'" ++ urlPart ++ "'" , var "accessor" $ new "this" . code $ "this.contextUrl + postfix, " ++ "this.secureContextUrl + postfix, "@@ -100,16 +99,16 @@ urlPart = (if isAccessor ai then const "" else id) $ (if resDir ai == "" then "" else resDir ai ++ "/") ++ maybe "" (\i -> "' + encodeURIComponent(" ++ i ++ ") + '/") mIdent- mIdent = (if isAccessor ai then const Nothing else id) $ fmap (jsId . cleanName . description) $ ident ai+ mIdent = (if isAccessor ai then const Nothing else id) $ jsId . cleanName . description <$> ident ai in function fParams $ ret $ call (ns ++ "." ++ "ajaxCall") [ string (method ai)- , code $ (if (https ai) then "this.secureContextUrl" else "this.contextUrl") ++ " + '" ++ urlPart ++ "'"+ , code $ (if https ai then "this.secureContextUrl" else "this.contextUrl") ++ " + '" ++ urlPart ++ "'" , code "params" , code "success" , code "error" , string $ maybe "text/plain" snd3 mInp- , string $ mOut+ , string mOut , maybe (code "undefined") (\(p, _, f) -> f (code p)) mInp , code "callOpts" , code "this.modifyRequest"
src/Rest/Gen/Ruby.hs view
@@ -39,8 +39,8 @@ apiConstructor :: Version -> ApiResource -> Code apiConstructor ver node =- rbClass "BaseApi" $- [ function "initialize" ["resUrl"] $ mkStack $+ rbClass "BaseApi"+ [ function "initialize" ["resUrl"] $ mkStack [ "@url" .=. ("resUrl + '/v" ++ show ver ++ "/'") , "@api" .=. "self" ]@@ -68,11 +68,11 @@ ] mkPostFuncs :: ApiResource -> Code-mkPostFuncs node = mkStack . map mkFunction . filter (postAction . itemInfo) . resItems $ node+mkPostFuncs = mkStack . map mkFunction . filter (postAction . itemInfo) . resItems mkPreFuncs :: ApiResource -> Code mkPreFuncs node =- let (acs, funcs) = partition (isAccessor . itemInfo) . filter ((\i -> not $ postAction i) . itemInfo) $ resItems node+ let (acs, funcs) = partition (isAccessor . itemInfo) . filter (not . postAction . itemInfo) $ resItems node in mkStack (map mkAccessor acs) <-> mkStack (map mkFunction funcs) mkAccessor :: ApiAction -> Code@@ -82,7 +82,7 @@ ++ maybe "" (\i -> "' + " ++ i ++ " + '/") mIdent datType = maybe ":data" ((':':) . fst3 . mkType . L.get (dataType . desc) . chooseType) . NList.nonEmpty . outputs $ ai- mIdent = fmap (rbName . cleanName . description) $ ident ai+ mIdent = rbName . cleanName . description <$> ident ai in function (rbName $ mkFuncParts node) fParams $ ret $ new (className rid) ["@url + '" ++ urlPart ++ "'", "@api", datType] @@ -96,9 +96,9 @@ mOut = fmap (mkType . L.get (dataType . desc) . chooseType) . NList.nonEmpty . outputs $ ai urlPart = (if resDir ai == "" then "" else resDir ai ++ "/") ++ maybe "" (\i -> "' + " ++ i ++ " + '/") mIdent- mIdent = fmap (rbName . cleanName . description) $ ident ai+ mIdent = rbName . cleanName . description <$> ident ai in function (rbName $ mkFuncParts node) fParams $- call ("internalSilkRequest")+ call "internalSilkRequest" [ code "@api" , code $ ':' : map toLower (show $ method ai) , code $ "@url + '" ++ urlPart ++ "'"
tests/Runner.hs view
@@ -26,7 +26,7 @@ import Rest.Schema main :: IO ()-main = do+main = defaultMain [ testCase "Listing has right parameters." testListingParams , testCase "Selects should show up only once." testSingleSelect , testCase "Removes should show up only once." testSingleRemove