rest-gen 0.10.0.4 → 0.11

raw patch · 5 files changed

+109/−65 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• rest-gen.cabal +1/−1
• src/Rest/Gen/Base/ActionInfo.hs +68/−22
• src/Rest/Gen/Base/ApiTree.hs +11/−19
• src/Rest/Gen/Haskell/Generate.hs +24/−23

@@ -1,5 +1,10 @@ # Changelog +## 0.11++* Bugfix: Haskell: Resources without a getter now generate identifier arguments for other end points+* Shuffles some internal (but exposed) functions around+ #### 0.10.0.4  * Drops `aeson-utils` dependency in favor of `scientific >= 0.3.2`

@@ -1,5 +1,5 @@ name:                rest-gen-version:             0.10.0.4+version:             0.11 description:         Documentation and client generation from rest definition. synopsis:            Documentation and client generation from rest definition. maintainer:          code@silk.co

@@ -1,4 +1,8 @@-{-# LANGUAGE GADTs, CPP, ScopedTypeVariables #-}+{-# LANGUAGE+    CPP+  , GADTs+  , ScopedTypeVariables+  #-} module Rest.Gen.Base.ActionInfo where  import Prelude hiding (id, (.))@@ -14,17 +18,18 @@ #if __GLASGOW_HASKELL__ < 704 import Data.List.Split #endif-import Rest.Gen.Base.ActionInfo.Ident (Ident (Ident))+import Rest.Gen.Base.ActionInfo.Ident (Ident (Ident), description) import Rest.Info import qualified Data.JSON.Schema   as J import qualified Data.Label.Total   as L import qualified Rest.Gen.Base.JSON as J import qualified Rest.Gen.Base.XML  as X -import Rest.Dictionary (Param (..), Input (..), Output (..), Error (..))+import Rest.Dictionary (Error (..), Input (..), Output (..), Param (..)) import Rest.Driver.Routing (mkListHandler, mkMultiHandler)+import Rest.Gen.Base.Link import Rest.Handler-import Rest.Resource+import Rest.Resource hiding (description) import Rest.Schema  import qualified Rest.Dictionary as Dict@@ -56,6 +61,7 @@   , errors       :: [DataDescription]   , params       :: [String]   , https        :: Bool+  , link         :: Link   } deriving (Show, Eq)  isAccessor :: ActionInfo -> Bool@@ -89,10 +95,37 @@     Schema mTopLevel step -> foldMap (topLevelActionInfo r) mTopLevel                           ++ stepActionInfo r step                           ++ foldMap (return . createActionInfo) (Rest.create r)-                          ++ foldMap (return . removeActionInfo) (Rest.remove  r)-                          ++ map (uncurry selectActionInfo) (Rest.selects r)-                          ++ map (uncurry actionActionInfo) (Rest.actions r)+                          ++ foldMap (return . removeActionInfo accLnk) (Rest.remove r)+                          ++ map (uncurry (selectActionInfo accLnk)) (Rest.selects r)+                          ++ map (uncurry (actionActionInfo accLnk)) (Rest.actions r)+      where+        accLnk = accessLink (accessors step) +accessLink :: [Accessor] -> Link+accessLink [] = []+accessLink xs = [LAccess . map f $ xs]+  where+    f ("", x) = par x+    f (pth, x) = LAction pth : par x+    par = maybe [] (return . LParam . description)++accessors :: Step sid mid aid -> [Accessor]+accessors (Named hs) = mapMaybe (uncurry accessorsNamed) hs+  where+    accessorsNamed pth (Right (Single g)) = Just (pth, getId g)+    accessorsNamed _ _ = Nothing+    getId (Singleton _) = Nothing+    getId (By id_) = Just . idIdent $ id_+accessors (Unnamed (Single id_)) = [("", Just . idIdent $ id_)]+accessors (Unnamed (Many _)) = []++type Accessor = (String, Maybe Ident)++resourceToAccessors :: Resource m s sid mid aid -> [Accessor]+resourceToAccessors r =+  case schema r of+    Schema _ step -> accessors step+ topLevelActionInfo :: Resource m s sid mid aid -> Cardinality sid mid -> [ActionInfo] topLevelActionInfo r            (Single _  ) = singleActionInfo r Nothing "" topLevelActionInfo r@Resource{} (Many   mid) = maybeToList@@ -141,36 +174,36 @@ -- * Smart constructors for ActionInfo.  getActionInfo :: Maybe (Id sid) -> String -> Handler m -> ActionInfo-getActionInfo mId pth = handlerActionInfo mId False Retrieve Self pth GET+getActionInfo mId pth = handlerActionInfo mId False Retrieve Self pth GET []  updateActionInfo :: Maybe (Id sid) -> String -> Handler m -> ActionInfo-updateActionInfo mId pth = handlerActionInfo mId False Update Any pth PUT+updateActionInfo mId pth = handlerActionInfo mId False Update Any pth PUT []  multiUpdateActionInfo :: Monad m => Id sid -> String -> Handler m -> Maybe ActionInfo-multiUpdateActionInfo id_ pth h =  handlerActionInfo Nothing False UpdateMany Any pth PUT+multiUpdateActionInfo id_ pth h =  handlerActionInfo Nothing False UpdateMany Any pth PUT []                                <$> mkMultiHandler id_ (const id) h -removeActionInfo :: Handler m -> ActionInfo-removeActionInfo = handlerActionInfo Nothing True Delete Self "" DELETE+removeActionInfo :: Link -> Handler m -> ActionInfo+removeActionInfo lnk = handlerActionInfo Nothing True Delete Self "" DELETE lnk  multiRemoveActionInfo :: Monad m => Id sid -> String -> Handler m -> Maybe ActionInfo-multiRemoveActionInfo id_ pth h =  handlerActionInfo Nothing False DeleteMany Any pth DELETE+multiRemoveActionInfo id_ pth h =  handlerActionInfo Nothing False DeleteMany Any pth DELETE []                                <$> mkMultiHandler id_ (const id) h  listActionInfo :: Monad m => Maybe (Id mid) -> String -> ListHandler m -> Maybe ActionInfo-listActionInfo mId pth h = handlerActionInfo mId False List Self pth GET <$> mkListHandler h+listActionInfo mId pth h = handlerActionInfo mId False List Self pth GET [] <$> mkListHandler h  staticActionInfo :: String -> Handler m -> ActionInfo-staticActionInfo pth = handlerActionInfo Nothing False Modify Any pth POST+staticActionInfo pth = handlerActionInfo Nothing False Modify Any pth POST []  createActionInfo :: Handler m -> ActionInfo-createActionInfo = handlerActionInfo Nothing False Create Self "" POST+createActionInfo = handlerActionInfo Nothing False Create Self "" POST [] -selectActionInfo :: String -> Handler m -> ActionInfo-selectActionInfo pth = handlerActionInfo Nothing True Retrieve Any pth GET+selectActionInfo :: Link -> String -> Handler m -> ActionInfo+selectActionInfo lnk pth = handlerActionInfo Nothing True Retrieve Any pth GET lnk -actionActionInfo :: String -> Handler m -> ActionInfo-actionActionInfo pth = handlerActionInfo Nothing True Modify Any pth POST+actionActionInfo :: Link -> String -> Handler m -> ActionInfo+actionActionInfo lnk pth = handlerActionInfo Nothing True Modify Any pth POST lnk  handlerActionInfo :: Maybe (Id id)                   -> Bool@@ -178,10 +211,11 @@                   -> ActionTarget                   -> String                   -> RequestMethod+                  -> Link                   -> Handler m                   -> ActionInfo-handlerActionInfo mId postAct actType actTarget pth mth h = ActionInfo-  { ident        = idIdent <$> mId+handlerActionInfo mId postAct actType actTarget pth mth ac h = ActionInfo+  { ident        = id_   , postAction   = postAct   , actionType   = actType   , actionTarget = actTarget@@ -192,7 +226,19 @@   , errors       = handlerErrors  h   , params       = handlerParams  h   , https        = secure         h+  , link         = makeLink   }+  where+    id_ = idIdent <$> mId+    makeLink :: Link+    makeLink+      | postAct   = ac ++ dirPart ++ identPart+      | otherwise = dirPart ++ identPart+      where dirPart   = if pth /= ""+                        then [LAction pth]+                        else []+            identPart = maybe [] ((:[]) . LParam . description) id_+  -------------------- -- * Utilities for extraction information from Handlers.

@@ -2,13 +2,12 @@ module Rest.Gen.Base.ApiTree where  import Data.Char+import Data.Function import Data.List import Data.Maybe-import Data.Function  import Rest.Api (Router (..), Some1 (..)) import Rest.Gen.Base.ActionInfo-import Rest.Gen.Base.ActionInfo.Ident (description) import Rest.Gen.Base.Link import Rest.Gen.Utils import qualified Rest.Resource as Res@@ -26,13 +25,16 @@     , resId          :: ResourceId     , resParents     :: ResourceId     , resLink        :: Link-    , resIdents      :: [Link]+    , resAccessors   :: [Accessor]     , resPrivate     :: Bool     , resItems       :: [ApiAction]     , resDescription :: String     , subResources   :: [ApiResource]     } deriving (Show, Eq) +resIdents :: ApiResource -> [Link]+resIdents = return . accessLink . resAccessors+ apiSubtrees :: Router m s -> ApiResource apiSubtrees (Embed _ routes) = defaultTree { subResources = map (\(Some1 r) -> apiTree r) routes } @@ -41,30 +43,20 @@  apiTree' :: ResourceId -> Link -> Router m s -> ApiResource apiTree' rid lnk (Embed r routes) =-    let myId        = rid ++ [Res.name r]-        myLnk       = lnk ++ [LResource (Res.name r)]-        accessLinks = [ actionInfoToLink [] ai | ai <- resourceToActionInfo r, isAccessor ai ]+    let myId  = rid ++ [Res.name r]+        myLnk = lnk ++ [LResource (Res.name r)]+        as    = resourceToAccessors r     in TreeItem         { resName        = Res.name r         , resId          = myId         , resParents     = rid         , resLink        = myLnk-        , resIdents      = accessLinks+        , resAccessors   = as         , resPrivate     = Res.private r-        , resItems       = [ ApiAction myId (myLnk ++ actionInfoToLink [LAccess accessLinks] ai) ai | ai <- resourceToActionInfo r ]+        , resItems       = [ ApiAction myId (myLnk ++ link ai) ai | ai <- resourceToActionInfo r ]         , resDescription = Res.description r-        , subResources   = map (\(Some1 chd) -> apiTree' myId (myLnk ++ [LAccess accessLinks]) chd) routes+        , subResources   = map (\(Some1 chd) -> apiTree' myId (myLnk ++ [LAccess [accessLink as]]) chd) routes         }---- | Create urls from an action-actionInfoToLink :: Link -> ActionInfo -> Link-actionInfoToLink ac ai-  | postAction ai = ac ++ dirPart ++ identPart-  | otherwise     = dirPart ++ identPart-  where dirPart   = if resDir ai /= ""-                      then [LAction $ resDir ai]-                      else []-        identPart = maybe [] ((:[]) . LParam . description) (ident ai)  defaultTree :: ApiResource defaultTree = TreeItem "" [] [] [] [] False [] "" []

@@ -173,7 +173,7 @@   case lnk of     [] -> ac     (LResource r : a@(LAccess _) : xs) | not (hasParam a) -> urlParts res xs (rlnk ++ [hsArray [string r]], pars)-                                   | otherwise ->+                                       | otherwise ->       urlParts res xs             ( rlnk ++ [ hsArray [string r]                       , (if r == res then noCode else modName r <+> ".") <+> "readId" <++> hsName (cleanName r)@@ -185,28 +185,29 @@  idData :: ApiResource -> Code idData node =-  let items  = filter isAccessor $ map itemInfo $ resItems node-      mkCons = dataName . resDir-  in case items of-      []  -> noCode-      [x] -> maybe noCode-             (\i -> mkStack-              [ code "type Identifier = " <++> Ident.haskellType i-              , function "readId" "Identifier -> [String]"-              , hsDecl "readId" ["x"] (hsArray $ if resDir x /= "" then [string $ resDir x, code "showUrl x"] else [code "showUrl x"])-              ]-             )-             (ident x)-      ls  -> mkStack $-              [ hsData "Identifier" $ map (\i -> mkCons i ++ maybe "" (\x -> " (" ++ Ident.haskellType x ++ ")") (ident i)) ls-              , function "readId" "Identifier -> [String]"-              , mkStack $-                  map (\i ->-                          if isJust (ident i)-                            then hsDecl "readId" ["(" ++ mkCons i ++ " x" ++ ")"] $ hsArray [string (resDir i), code "showUrl x"]-                            else hsDecl "readId" [mkCons i] $ hsArray [string (resDir i)]-                      ) ls-              ]+  case resAccessors node of+    []  -> noCode+    [(pth,mi)] -> maybe noCode+           (\i -> mkStack+            [ code "type Identifier = " <++> Ident.haskellType i+            , function "readId" "Identifier -> [String]"+            , hsDecl "readId" ["x"] (hsArray $ if pth /= ""+                                               then [string pth, code "showUrl x"]+                                               else [code "showUrl x"]+                                    )+            ]+           )+           mi+    ls  -> mkStack $+            [ hsData "Identifier" $ map (\(pth,mi) -> dataName pth ++ maybe "" (\x -> " (" ++ Ident.haskellType x ++ ")") mi) ls+            , function "readId" "Identifier -> [String]"+            , mkStack $+                map (\(pth,mi) ->+                        if isJust mi+                          then hsDecl "readId" ["(" ++ dataName pth ++ " x" ++ ")"] $ hsArray [string pth, code "showUrl x"]+                          else hsDecl "readId" [dataName pth] $ hsArray [string pth]+                    ) ls+            ]  mkHsName :: ActionInfo -> String mkHsName ai = hsName $ concatMap cleanName parts