rest-gen 0.16.1.8 → 0.17.0.0

raw patch · 7 files changed

+108/−24 lines, 7 filesdep ~rest-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: rest-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• rest-gen.cabal +3/−3
• src/Rest/Gen/Base/ActionInfo.hs +18/−16
• src/Rest/Gen/Base/JSON.hs +72/−1
• src/Rest/Gen/Docs.hs +4/−2
• src/Rest/Gen/Haskell.hs +2/−2
• src/Rest/Gen/Types.hs +4/−0

@@ -1,5 +1,10 @@ # Changelog +#### 0.17.0.0++* Docs: More exhaustive examples of JSON messages showing each possible node in the schema at least once.+* Docs: Make example popup scrollable.+ #### 0.16.1.8  * Remove dependency on hslogger.

@@ -1,5 +1,5 @@ name:                rest-gen-version:             0.16.1.8+version:             0.17.0.0 description:         Documentation and client generation from rest definition. synopsis:            Documentation and client generation from rest definition. maintainer:          code@silk.co@@ -62,7 +62,7 @@     , json-schema >= 0.6 && < 0.8     , pretty >= 1.0 && < 1.2     , process >= 1.0 && < 1.3-    , rest-core >= 0.31 && < 0.35+    , rest-core >= 0.31 && < 0.36     , safe >= 0.2 && < 0.4     , semigroups >= 0.5.0 && < 0.17     , scientific >= 0.3.2 && < 0.4@@ -83,7 +83,7 @@     , HUnit == 1.2.*     , fclabels >= 1.0.4 && < 2.1     , haskell-src-exts >= 1.15.0 && < 1.17-    , rest-core >= 0.31 && < 0.35+    , rest-core >= 0.31 && < 0.36     , rest-gen     , test-framework == 0.8.*     , test-framework-hunit == 0.3.*

@@ -1,5 +1,7 @@ {-# LANGUAGE-    GADTs+    DataKinds+  , GADTs+  , KindSignatures   , LambdaCase   , NoMonomorphismRestriction   , ScopedTypeVariables@@ -111,7 +113,7 @@ data DataMeta = DataMeta   { _dataTypeDesc :: String       -- ^ The name of the DataType, or a custom value if dataType is Other   , _dataSchema   :: Maybe String -- ^ Just if dataType is XML-  , _dataExample  :: Maybe String -- ^ Just if dataType is XML or JSON+  , _dataExample  :: [String]     -- ^ Non empty if dataType is XML or JSON   } deriving (Show, Eq)  mkLabel ''DataMeta@@ -153,7 +155,7 @@     , _meta = DataMeta         { _dataTypeDesc = typeDesc         , _dataSchema   = Nothing-        , _dataExample  = Nothing+        , _dataExample  = []         }     } @@ -424,52 +426,52 @@  -- | Extract input description from handlers handlerInputs :: Handler m -> [DataDescription]-handlerInputs (GenHandler dict _ _) = map (handlerInput Proxy) (L.get (Dict.dicts . Dict.inputs) dict)+handlerInputs (GenHandler dict _ _) = map (handlerInput Proxy) (Dict.getDicts_ . L.get Dict.inputs $ dict)   where-    handlerInput :: Proxy a -> Input a -> DataDescription+    handlerInput :: Proxy i -> Input i -> DataDescription     handlerInput d c = case c of       ReadI    -> L.set (haskellModules . desc) (modString d)                 $ defaultDescription Other (describe d) (toHaskellType d)       StringI  -> defaultDescription String "String" haskellStringType       XmlI     -> L.set (haskellModules . desc) (modString d)-                . L.set (dataSchema     . meta) (Just . X.showSchema  . X.getXmlSchema $ d)-                . L.set (dataExample    . meta) (Just . X.showExample . X.getXmlSchema $ d)+                . L.set (dataSchema     . meta) (pure . X.showSchema  . X.getXmlSchema $ d)+                . L.set (dataExample    . meta) (pure . X.showExample . X.getXmlSchema $ d)                 $ defaultDescription XML "XML" (toHaskellType d)       XmlTextI -> defaultDescription XML "XML" haskellStringType       RawXmlI  -> defaultDescription XML "XML" haskellStringType       JsonI    -> L.set (haskellModules . desc) (modString d)-                . L.set (dataExample    . meta) (Just . J.showExample . J.schema $ d)+                . L.set (dataExample    . meta) (J.showExamples . J.schema $ d)                 $ defaultDescription JSON "JSON" (toHaskellType d)       FileI    -> defaultDescription File "File" haskellByteStringType  -- | Extract output description from handlers handlerOutputs :: Handler m -> [DataDescription]-handlerOutputs (GenHandler dict _ _) = map (handlerOutput Proxy) (L.get (Dict.dicts . Dict.outputs) dict)+handlerOutputs (GenHandler dict _ _) = map (handlerOutput Proxy) (Dict.getDicts_ . L.get Dict.outputs $ dict)   where     handlerOutput :: Proxy a -> Output a -> DataDescription     handlerOutput d c = case c of       StringO -> defaultDescription String "String" haskellStringType       XmlO    -> L.set (haskellModules . desc) (modString d)-               . L.set (dataSchema     . meta) (Just . X.showSchema  . X.getXmlSchema $ d)-               . L.set (dataExample    . meta) (Just . X.showExample . X.getXmlSchema $ d)+               . L.set (dataSchema     . meta) (pure . X.showSchema  . X.getXmlSchema $ d)+               . L.set (dataExample    . meta) (pure . X.showExample . X.getXmlSchema $ d)                $ defaultDescription XML "XML" (toHaskellType d)       RawXmlO -> defaultDescription XML "XML" haskellStringType       JsonO   -> L.set (haskellModules . desc) (modString d)-               . L.set (dataExample    . meta) (Just . J.showExample . J.schema $ d)+               . L.set (dataExample    . meta) (J.showExamples . J.schema $ d)                $ defaultDescription JSON "JSON" (toHaskellType d)       FileO   -> defaultDescription File "File" haskellByteStringType  -- | Extract input description from handlers handlerErrors :: Handler m -> [DataDescription]-handlerErrors (GenHandler dict _ _) = map (handleError Proxy) (L.get (Dict.dicts . Dict.errors) dict)+handlerErrors (GenHandler dict _ _) = map (handleError Proxy) (Dict.getDicts_ . L.get Dict.errors $ dict)   where     handleError :: Proxy a -> Error a -> DataDescription     handleError d c = case c of-      XmlE  -> L.set (dataSchema     . meta) (Just . X.showSchema  . X.getXmlSchema $ d)-             . L.set (dataExample    . meta) (Just . X.showExample . X.getXmlSchema $ d)+      XmlE  -> L.set (dataSchema     . meta) (pure . X.showSchema  . X.getXmlSchema $ d)+             . L.set (dataExample    . meta) (pure . X.showExample . X.getXmlSchema $ d)              . L.set (haskellModules . desc) (modString d)              $ defaultDescription XML "XML" (toHaskellType d)-      JsonE -> L.set (dataExample    . meta) (Just . J.showExample . J.schema $ d)+      JsonE -> L.set (dataExample    . meta) (J.showExamples . J.schema $ d)              . L.set (haskellModules . desc) (modString d)              $ defaultDescription JSON "JSON" (toHaskellType d) 

@@ -2,13 +2,19 @@     CPP   , OverloadedStrings   #-}-module Rest.Gen.Base.JSON (showExample) where+module Rest.Gen.Base.JSON+  ( showExample+  , showExamples+  ) where  import Data.Aeson ((.=)) import Data.JSON.Schema+import Data.List (transpose)+import Data.List.Split (chunksOf) import Data.Maybe import Text.PrettyPrint.HughesPJ import qualified Data.Aeson  as A+import qualified Data.Text   as T import qualified Data.Vector as V  import Rest.Gen.Base.JSON.Pretty@@ -31,6 +37,71 @@ #if !MIN_VERSION_json_schema(0,7,0)       Null         -> A.Null #endif+++-- | Generate enough examples as to mention every possible field+--   at least once+showExamples :: Schema -> [String]+showExamples = map (render . pp_value) . showExamples'+  where+    -- Recursive types have infinite schemas, so we must ensure+    -- that we don't generate infinitely deep examples in that case.+    -- We thus impose a limit to the number of nestings+    showExamples' = fst . go (10 :: Int)++    -- Idea: @go n x == (showExamples' n x, length (showExamples' n x))@+    -- and note that @snd (go x) >= 1@+    go 0 _ = ([A.String "..."],1)+    go n s = case s of+      Choice []   -> ([A.Null], 1)++      Choice xs   -> let (examples, numExamples) = unzip $ map (go $ n-1) xs+                     in (concat examples, sum numExamples)++      Object []   -> ([A.object []], 1)++      Object fs   -> let (esByFld, numEsByFld) = unzip $ map (fieldExs n) fs+                         numExamples = maximum numEsByFld+                         examples = map A.object $ take numExamples $ transpose $ map cycle esByFld+                     in (examples, numExamples)++      Map v       -> let (examples, _) = go (n-1) v+                         mkKey i = T.pack $ "<key " ++ show (i :: Int) ++ ">"+                     in ([A.object [mkKey i .= e | (i,e) <- zip [1..] examples]], 1)++      Tuple []    -> ([A.Array V.empty], 1)++      Tuple vs    -> let (esByPos,numEsByPos) = unzip $ map (go $ n-1) vs+                         numExamples = maximum numEsByPos+                         examples = take numExamples $ transpose $ map cycle esByPos+                     in (map (A.Array . V.fromList) examples, numExamples)++      Array l _ v -> let minLen = fromMaybe 0 (lowerLength l)+                         maxLen = fromMaybe (numCases `max` minLen) (upperLength l)+                         (cases,numCases) = go (n-1) v+                         (q,r) = numCases `divMod` maxLen+                         numExamples = q + signum r+                         examples = chunksOf maxLen $ cases ++ take (minLen - r) cases+                     in if maxLen == 0 then ([A.Array V.empty], 1)+                        else (map (A.Array . V.fromList) examples, numExamples)++      Value _     -> ([A.String "value"], 1)++      Boolean     -> ([A.Bool True], 1)++      Number b    -> ([A.Number $ boundExample b], 1)++      Any         -> ([A.String "<value>"],1)++      Constant v  -> ([v], 1)++#if !MIN_VERSION_json_schema(0,7,0)+      Null        -> ([A.Null], 1)+#endif++    fieldExs n f = let (examples,num_examples) = go (n-1) (content f)+                   in (map (key f .=) examples, num_examples)+  boundExample :: Num a => Bound -> a boundExample b = fromIntegral $ fromMaybe 0 (maybe (lower b) Just (upper b))

@@ -32,7 +32,7 @@ import System.Directory import System.FilePath import Text.Blaze.Html-import Text.Blaze.Html5 hiding (map, meta)+import Text.Blaze.Html5 hiding (map, meta, style) import Text.Blaze.Html5.Attributes hiding (method, span, title) import Text.Blaze.Html.Renderer.String import Text.StringTemplate@@ -183,7 +183,9 @@           do cdiv "modal-header" $               do a ! href (toValue "#") ! cls "close" $ toHtml "x"                  h3 $ toHtml cap-             cdiv "modal-body" $ pre ! cls ("prettyprint lang-" ++ lng) $ toHtml $ cd+             cdiv "modal-body" $+               div ! style (toValue "overflow:auto; max-height:600px") $+                 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")

@@ -423,6 +423,6 @@ defaultErrorDataDesc dt =   DataDesc     { _dataType       = dt-    , _haskellType    = haskellUnitType-    , _haskellModules = []+    , _haskellType    = haskellVoidType+    , _haskellModules = [ModuleName "Rest.Types.Void"]     }

@@ -8,6 +8,7 @@   , haskellByteStringType   , haskellUnitType   , haskellSimpleType+  , haskellVoidType   , noLoc   , ModuleName (..)   , ImportDecl (..)@@ -53,3 +54,6 @@  haskellUnitType :: Type haskellUnitType = TyCon (Special UnitCon)++haskellVoidType :: Type+haskellVoidType = TyCon (Qual (ModuleName "Rest.Types.Void") (Ident "Void"))