diff --git a/rest-gen.cabal b/rest-gen.cabal --- a/rest-gen.cabal +++ b/rest-gen.cabal @@ -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.* diff --git a/src/Rest/Gen/Base.hs b/src/Rest/Gen/Base.hs --- a/src/Rest/Gen/Base.hs +++ b/src/Rest/Gen/Base.hs @@ -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 diff --git a/src/Rest/Gen/Base/ActionInfo.hs b/src/Rest/Gen/Base/ActionInfo.hs --- a/src/Rest/Gen/Base/ActionInfo.hs +++ b/src/Rest/Gen/Base/ActionInfo.hs @@ -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] diff --git a/src/Rest/Gen/Base/JSON.hs b/src/Rest/Gen/Base/JSON.hs --- a/src/Rest/Gen/Base/JSON.hs +++ b/src/Rest/Gen/Base/JSON.hs @@ -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) diff --git a/src/Rest/Gen/Base/JSON/Pretty.hs b/src/Rest/Gen/Base/JSON/Pretty.hs --- a/src/Rest/Gen/Base/JSON/Pretty.hs +++ b/src/Rest/Gen/Base/JSON/Pretty.hs @@ -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 diff --git a/src/Rest/Gen/Base/Link.hs b/src/Rest/Gen/Base/Link.hs --- a/src/Rest/Gen/Base/Link.hs +++ b/src/Rest/Gen/Base/Link.hs @@ -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) diff --git a/src/Rest/Gen/Base/XML.hs b/src/Rest/Gen/Base/XML.hs --- a/src/Rest/Gen/Base/XML.hs +++ b/src/Rest/Gen/Base/XML.hs @@ -41,9 +41,9 @@ ++ indent (concatMap (showSchema' "") ss) ++ [""] - 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)) = [""] showSchema' ats (Element n (Seq [])) = [""] diff --git a/src/Rest/Gen/Docs.hs b/src/Rest/Gen/Docs.hs --- a/src/Rest/Gen/Docs.hs +++ b/src/Rest/Gen/Docs.hs @@ -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) diff --git a/src/Rest/Gen/Haskell.hs b/src/Rest/Gen/Haskell.hs --- a/src/Rest/Gen/Haskell.hs +++ b/src/Rest/Gen/Haskell.hs @@ -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 () "" diff --git a/src/Rest/Gen/JavaScript.hs b/src/Rest/Gen/JavaScript.hs --- a/src/Rest/Gen/JavaScript.hs +++ b/src/Rest/Gen/JavaScript.hs @@ -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" diff --git a/src/Rest/Gen/Ruby.hs b/src/Rest/Gen/Ruby.hs --- a/src/Rest/Gen/Ruby.hs +++ b/src/Rest/Gen/Ruby.hs @@ -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 ++ "'" diff --git a/tests/Runner.hs b/tests/Runner.hs --- a/tests/Runner.hs +++ b/tests/Runner.hs @@ -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