diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. 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.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.* 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,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) 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 @@ -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 $ "" + 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 ""],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)) 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 @@ -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") 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 @@ -423,6 +423,6 @@ defaultErrorDataDesc dt = DataDesc { _dataType = dt - , _haskellType = haskellUnitType - , _haskellModules = [] + , _haskellType = haskellVoidType + , _haskellModules = [ModuleName "Rest.Types.Void"] } diff --git a/src/Rest/Gen/Types.hs b/src/Rest/Gen/Types.hs --- a/src/Rest/Gen/Types.hs +++ b/src/Rest/Gen/Types.hs @@ -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"))