jordan-openapi 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+285/−165 lines, 6 filesdep +http-typesdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: http-types

Dependency ranges changed: aeson, base, bytestring, insert-ordered-containers, jordan, openapi3

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• jordan-openapi.cabal +12/−10
• lib/Jordan/OpenAPI.hs +22/−15
• lib/Jordan/OpenAPI/Internal.hs +216/−101
• test/Jordan/OpenAPI/SpecDefs.hs +1/−1
• test/JordanOpenApiSpec.hs +29/−38

@@ -1,5 +1,10 @@ # Revision history for jordan-openapi +## 0.2.0.0 -- 2022-07-04++* Updated library to be compatible with `jordan` version `0.2.0.0`+* Added *lots* of documenation.+ ## 0.1.0.0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -1,10 +1,11 @@ cabal-version:      3.0 name:               jordan-openapi-version:            0.1.0.0+version:            0.2.0.0 synopsis:           OpenAPI Definitions for Jordan, Automatically  -- A longer description of the package.--- description:+description:+  Automatic generation of documentation for Jordan-powered types. homepage:  -- A URL where users can report bugs.@@ -21,15 +22,18 @@  common build-deps   build-depends:-      aeson  >= 1.5.6 && <1.6-    , bytestring >= 0.10.12 && <0.11+      aeson  >= 1.5.6 && <2.3+    , bytestring >= 0.10.12 && <0.12     , containers >= 0.6.2 && <0.7     , contravariant >= 1.5.5 && <1.6     , insert-ordered-containers >= 0.2.5 && <0.3-    , jordan >= 0.1.0.0 && <0.2-    , openapi3 >= 3.1.0 && <3.2+    , jordan >= 0.2.0.0 && <0.3+    , openapi3 >= 3.1.0 && <3.3     , optics-core >= 0.4 && <0.5     , text >= 1.2.4 && <1.3+    , insert-ordered-containers >=0.2.3 && <0.3+    , http-types >= 0.12.2 && <0.13+    , base >= 4.14.1 && <4.17  library     import: build-deps@@ -42,7 +46,6 @@      -- LANGUAGE extensions used by modules in this package.     -- other-extensions:-    build-depends:    base ^>=4.14.1.0     hs-source-dirs:   lib     default-language: Haskell2010 @@ -52,9 +55,8 @@     default-language: Haskell2010     type:             exitcode-stdio-1.0     hs-source-dirs:   test-    main-is:          JordanOpenApiSpec.hs +    main-is:          JordanOpenApiSpec.hs     other-modules:         Jordan.OpenAPI.SpecDefs     build-depends:-        base ^>=4.14.1.0-      , hspec+        hspec

@@ -1,25 +1,33 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}+ module Jordan.OpenAPI-    ( getFromNamed-    , getToNamed-    , JordanFromJSONSchema (..)-    ) where+  ( -- * Documenting FromJSON Schemas+    getFromNamed,+    getToNamed, +    -- * Documenting ToJSON schemas+    getFromRef,+    getToRef,++    -- * Newtype wrappers for DerivingVia+    JordanFromJSONSchema (..),+    JordanToJSONSchema (..),+  )+where+ import Data.Functor.Contravariant (contramap)-import Data.OpenApi.Schema (ToSchema(..))-import Data.Proxy (Proxy(..))-import Data.Typeable (Typeable(..))-import Jordan.FromJSON.Class (FromJSON(..))-import Jordan.OpenAPI.Internal (getFromNamed, getToNamed)-import Jordan.ToJSON.Class (ToJSON(..))+import Data.OpenApi.Schema (ToSchema (..))+import Data.Proxy (Proxy (..))+import Data.Typeable (Typeable (..))+import Jordan.FromJSON.Class (FromJSON (..))+import Jordan.OpenAPI.Internal (getFromNamed, getFromRef, getToNamed, getToRef)+import Jordan.ToJSON.Class (ToJSON (..))  -- | Newtype for use with DerivingVia. -- -- Allows deriving 'Data.OpenApi.Schema.ToSchema' via DerivingVia, using the Jordan -- defintion of 'Jordan.ToJSON.Class.ToJSON'.-newtype JordanFromJSONSchema a-  = JordanFromJSONSchema { getJordanFromJSONSchema :: a }+newtype JordanFromJSONSchema a = JordanFromJSONSchema {getJordanFromJSONSchema :: a}  instance (FromJSON a) => FromJSON (JordanFromJSONSchema a) where   fromJSON = JordanFromJSONSchema <$> fromJSON@@ -31,8 +39,7 @@ -- -- Allows deriving 'Data.OpenApi.Schema.ToSchema' via DerivingVia, using the Jordan -- defintion of 'Jordan.ToJSON.Class.ToJSON'.-newtype JordanToJSONSchema a-  = JordanToJSONSchema { getJordanToJSONSchema :: a }+newtype JordanToJSONSchema a = JordanToJSONSchema {getJordanToJSONSchema :: a}  instance (ToJSON a) => ToJSON (JordanToJSONSchema a) where   toJSON = contramap getJordanToJSONSchema toJSON

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE InstanceSigs #-}@@ -5,37 +6,47 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-module Jordan.OpenAPI.Internal-    where -import Control.Applicative (Alternative(..))-import Control.Monad (unless)+-- | Internal module that provides JSON parser and serializers that convert to OpenAPI documentation.+--+-- Note that this module is full of internal-use-only functions and should probably n ever actually be imported.+module Jordan.OpenAPI.Internal where++import Control.Applicative (Alternative (..))+import Control.Monad (unless, when) import qualified Data.Aeson.Types as Aeson+import Data.Function (on) import Data.Functor (void)-import Data.Functor.Const-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Divisible+import Data.Functor.Contravariant (Contravariant (contramap))+import Data.Functor.Contravariant.Divisible (Divisible (..)) import qualified Data.HashMap.Strict.InsOrd as InsOrd import Data.Maybe (fromMaybe) import Data.OpenApi.Declare import Data.OpenApi.Internal import Data.OpenApi.Internal.Schema (rename, unname, unnamed) import Data.OpenApi.Optics-import Data.Proxy (Proxy(..))+import Data.Proxy (Proxy (..)) import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Debug.Trace (trace, traceM, traceShowId)+import GHC.Generics+import GHC.Stack (HasCallStack) import Jordan.FromJSON.Class import Jordan.ToJSON.Class+import Network.HTTP.Types.URI (urlEncode) import Optics.At.Core+import Optics.Iso (non) import Optics.Operators-import Optics.Optic ((%))+import Optics.Optic ((%), (&)) -newtype ConstDeclare env r a-  = ConstDeclare { runConstDeclare :: Declare env r }+-- | Declare with a phantom type parameter.+newtype ConstDeclare env r a = ConstDeclare {runConstDeclare :: Declare env r} +-- | Fmap ignores argument instance Functor (ConstDeclare env r) where   fmap _ (ConstDeclare d) = ConstDeclare d +-- | Applicative combines declarations. instance (Monoid r, Monoid env) => Applicative (ConstDeclare env r) where   pure _ = ConstDeclare $ pure mempty   (ConstDeclare f) <*> (ConstDeclare a) = ConstDeclare $ do@@ -43,6 +54,7 @@     a' <- a     pure $ f' <> a' +-- | Contravariant ignores argument. instance Contravariant (ConstDeclare env r) where   contramap _ (ConstDeclare d) = ConstDeclare d @@ -53,179 +65,282 @@     pure $ l' <> r'   conquer = ConstDeclare $ pure mempty -newtype ObjectSchema a-  = ObjectSchema-  { getObjectSchema-    :: Declare (Definitions Schema) Schema-  } deriving (Functor, Applicative, Contravariant, Divisible) via (ConstDeclare (Definitions Schema) Schema)+data PropertyDeclare = PropertyDeclare+  { requiredProperties :: [T.Text],+    propertyTypes :: InsOrd.InsOrdHashMap T.Text (Referenced Schema)+  }+  deriving (Show, Generic) +instance Semigroup PropertyDeclare where+  (PropertyDeclare r t) <> (PropertyDeclare r' t') =+    PropertyDeclare+      (r <> r')+      (t <> t')++instance Monoid PropertyDeclare where+  mempty = PropertyDeclare mempty mempty++addDescription ::+  T.Text ->+  Referenced Schema ->+  Referenced Schema+addDescription text = \case+  Ref ref ->+    Inline $+      #_schemaDescription ?~ text $+        #_schemaOneOf ?~ [Ref ref] $+          mempty+  Inline sc -> Inline $ case sc ^. #_schemaDescription of+    Nothing -> #_schemaDescription ?~ text $ sc+    Just txt ->+      #_schemaDescription ?~ text $+        #_schemaOneOf ?~ [Inline sc] $+          mempty++newtype ObjectSchema a = ObjectSchema+  { getObjectSchema ::+      Declare (Definitions Schema) PropertyDeclare+  }+  deriving (Functor, Applicative, Contravariant, Divisible) via (ConstDeclare (Definitions Schema) PropertyDeclare)+ instance JSONObjectParser ObjectSchema where+  parseFieldWithDefault key = \prop _ -> ObjectSchema $ do+    r <- getRefDef $ getJSONSchema prop+    pure $ PropertyDeclare mempty $ InsOrd.singleton key r+  parseDescribeFieldWithDefault key description = \prop _ -> ObjectSchema $ do+    r <- getRefDef $ getJSONSchema prop+    pure $ PropertyDeclare mempty $ InsOrd.singleton key (addDescription description r)+  parseDescribeFieldWith key description = \prop -> ObjectSchema $ do+    r <- getRefDef $ getJSONSchema prop+    pure $ PropertyDeclare [key] $ InsOrd.singleton key (addDescription description r)   parseFieldWith t p = ObjectSchema $ do     r <- getRefDef (getJSONSchema p)-    pure $ (#_schemaProperties % at t ?~ r) mempty-  parseField-    :: forall a. FromJSON a-    => T.Text-    -> ObjectSchema a-  parseField label = ObjectSchema $ do-    ref <- getJSONRef (Proxy :: Proxy a)-    pure $ (#_schemaProperties % at label ?~ ref) mempty+    pure $ PropertyDeclare [t] $ InsOrd.singleton t r  instance JSONObjectSerializer ObjectSchema where-  writeField f w = ObjectSchema $ do+  serializeFieldWith f w = ObjectSchema $ do     r <- getRefDef (getJSONSchema w)-    pure $ (#_schemaProperties % at f ?~ r) mempty+    pure $ PropertyDeclare [f] $ InsOrd.singleton f r+  serializeJust f w = ObjectSchema $ do+    r <- getRefDef (getJSONSchema w)+    pure $ PropertyDeclare [] $ InsOrd.singleton f r -newtype TupleSchema a-  = TupleSchema-    { getTupleSchema-        :: Declare (Definitions Schema) [Referenced Schema]-    } deriving (Functor, Applicative, Contravariant, Divisible) via (ConstDeclare (Definitions Schema) [Referenced Schema])+newtype TupleSchema a = TupleSchema+  { getTupleSchema ::+      Declare (Definitions Schema) [Referenced Schema]+  }+  deriving (Functor, Applicative, Contravariant, Divisible) via (ConstDeclare (Definitions Schema) [Referenced Schema])  instance JSONTupleParser TupleSchema where   consumeItemWith p = TupleSchema $ do     r <- getRefDef $ getJSONSchema p     pure [r] -newtype JSONSchema a-  = JSONSchema+newtype JSONSchema a = JSONSchema   { getJSONSchema :: Declare (Definitions Schema) NamedSchema-  } deriving (Functor, Contravariant) via (ConstDeclare (Definitions Schema) NamedSchema)+  }+  deriving (Functor, Contravariant) via (ConstDeclare (Definitions Schema) NamedSchema)  instance Semigroup (JSONSchema a) where-  a <> b = JSONSchema . fmap unnamed $-    combineSchemas <$> getRefDef (getJSONSchema a) <*> getRefDef (getJSONSchema b)+  a <> b =+    JSONSchema . fmap unnamed $+      combineSchemas <$> getRefDef (getJSONSchema a) <*> getRefDef (getJSONSchema b)  instance Selectable JSONSchema where   giveUp = mempty   select _ (JSONSchema lhs) (JSONSchema rhs) = JSONSchema lhs <> JSONSchema rhs +-- | Empty instance: must be both a boolean and a text value, which is not possible (obviously!)+instance Monoid (JSONSchema a) where+  mempty = JSONSchema $ do+    t <- getJSONSchema parseText+    b <- getJSONSchema parseBool+    pure $ unnamed $ (#_schemaAllOf ?~ [Inline $ _namedSchemaSchema t, Inline $ _namedSchemaSchema b]) mempty++sameTypes :: Schema -> Schema -> Bool+sameTypes = (==) `on` (^. #_schemaType)++bothHaveEnum :: Schema -> Schema -> Bool+bothHaveEnum a b = enumValues a /= [] && enumValues b /= []++enumValues = (^. #_schemaEnum % non [])++combineInline :: Schema -> Schema -> Schema+combineInline a b+  | sameTypes a b && bothHaveEnum a b = (#_schemaEnum ?~ (enumValues a <> enumValues b)) a+  | otherwise =+    (#_schemaOneOf ?~ fromMaybe [Inline a] (_schemaOneOf a) <> fromMaybe [Inline b] (_schemaOneOf b)) mempty+ combineSchemas :: Referenced Schema -> Referenced Schema -> Schema combineSchemas = curry $ \case-  (Inline a, Inline b) ->-    (#_schemaOneOf ?~ fromMaybe [Inline a] (_schemaOneOf a) <> fromMaybe [Inline b] (_schemaOneOf b)) mempty+  (Inline a, Inline b) -> combineInline a b   (Inline a, Ref b) ->     (#_schemaOneOf ?~ fromMaybe [Inline a] (_schemaOneOf a) <> [Ref b]) mempty   (Ref a, Inline b) ->     (#_schemaOneOf ?~ [Ref a] <> fromMaybe [Inline b] (_schemaOneOf b)) mempty   (Ref a, Ref b) -> (#_schemaOneOf ?~ [Ref a, Ref b]) mempty --- | Empty instance: must be both a boolean and a text value, which is not possible (obviously!)-instance Monoid (JSONSchema a) where-  mempty = JSONSchema $ do-    t <- getJSONSchema parseText-    b <- getJSONSchema parseBool-    pure $ unnamed $ (#_schemaAllOf ?~ [Inline $ _namedSchemaSchema t, Inline $ _namedSchemaSchema b]) mempty--getJSONRef-  :: forall a. FromJSON a-  => Proxy a-  -> Declare (Definitions Schema) (Referenced Schema)+getJSONRef ::+  forall a.+  FromJSON a =>+  Proxy a ->+  Declare (Definitions Schema) (Referenced Schema) getJSONRef = getRefDef . getFromNamed -getRefDef-  :: Declare (Definitions Schema) NamedSchema-  -> Declare (Definitions Schema) (Referenced Schema)+getRefDef ::+  Declare (Definitions Schema) NamedSchema ->+  Declare (Definitions Schema) (Referenced Schema) getRefDef decl = case undeclare decl of-    NamedSchema (Just name) schema -> do-      known <- looks (InsOrd.member name)-      unless known $ do-        declare [(name, schema)]-        void decl-      return $ Ref (Reference name)-    _ -> Inline . _namedSchemaSchema <$> decl+  NamedSchema (Just name) schema -> do+    known <- looks (InsOrd.member name)+    unless known $ do+      declare [(name, schema)]+      void decl+    return $ Ref (Reference name)+  _ -> Inline . (^. #_namedSchemaSchema) <$> decl  onlyUnnamed :: Schema -> JSONSchema a onlyUnnamed a = JSONSchema $ pure $ NamedSchema Nothing a +encodeRefName :: T.Text -> T.Text+encodeRefName = decodeUtf8 . urlEncode False . encodeUtf8+ instance JSONTupleSerializer TupleSchema where-  writeItem s = TupleSchema $ do+  serializeItemWith s = TupleSchema $ do     r <- getRefDef $ getJSONSchema s     pure [r]  instance JSONParser JSONSchema where-  parseObject n f = JSONSchema $ do+  parseObject f = JSONSchema $ do     d <- getObjectSchema f-    pure $ NamedSchema (Just n) d+    pure $+      NamedSchema Nothing $+        mempty+          & (#_schemaType ?~ OpenApiObject)+            . (#_schemaProperties .~ (d ^. #propertyTypes))+            . (#_schemaRequired .~ (d ^. #requiredProperties))   parseDictionary inner = JSONSchema $ do     r <- getRefDef (getJSONSchema inner)-    pure $ unnamed $-      ( (#_schemaType ?~ OpenApiObject)-      . (#_schemaAdditionalProperties ?~ AdditionalPropertiesSchema r)-      ) mempty+    pure $+      unnamed $+        ( (#_schemaType ?~ OpenApiObject)+            . (#_schemaAdditionalProperties ?~ AdditionalPropertiesSchema r)+        )+          mempty   parseTuple parser = JSONSchema $ do     items <- getTupleSchema parser     pure $-      ( unnamed-      . (#_schemaType ?~ OpenApiArray)-      . (#_schemaItems ?~ OpenApiItemsArray items)-      ) mempty+      mempty+        & ( unnamed+              . (#_schemaType ?~ OpenApiArray)+              . (#_schemaItems ?~ OpenApiItemsArray items)+          )   parseArrayWith p = JSONSchema $ do     itemRef <- getRefDef (getJSONSchema p)     pure $       ( unnamed-      . (#_schemaType ?~ OpenApiArray)-      . (#_schemaItems ?~ OpenApiItemsObject itemRef)-      ) mempty-  parseArray-    :: forall a. (FromJSON a)-    => JSONSchema [a]+          . (#_schemaType ?~ OpenApiArray)+          . (#_schemaItems ?~ OpenApiItemsObject itemRef)+      )+        mempty+  parseArray ::+    forall a.+    (FromJSON a) =>+    JSONSchema [a]   parseArray = JSONSchema $ do     itemRef <- getRefDef $ getFromNamed (Proxy :: Proxy a)     pure $       ( unnamed-      . (#_schemaType ?~ OpenApiArray)-      . (#_schemaItems ?~ OpenApiItemsObject itemRef)-      ) mempty+          . (#_schemaType ?~ OpenApiArray)+          . (#_schemaItems ?~ OpenApiItemsObject itemRef)+      )+        mempty   parseNumber = onlyUnnamed $ (#_schemaType ?~ OpenApiNumber) mempty-  parseTextConstant t-    = void-    . onlyUnnamed-    . (#_schemaType ?~ OpenApiString)-    . (#_schemaEnum ?~ [Aeson.String t])-    $ mempty+  parseInteger = onlyUnnamed $ (#_schemaType ?~ OpenApiInteger) mempty+  parseTextConstant t =+    void+      . onlyUnnamed+      . (#_schemaType ?~ OpenApiString)+      . (#_schemaEnum ?~ [Aeson.String t])+      $ mempty   parseNull = onlyUnnamed $ (#_schemaType ?~ OpenApiNull) mempty-  parseText = onlyUnnamed $  (#_schemaType ?~ OpenApiString) mempty+  parseText = onlyUnnamed $ (#_schemaType ?~ OpenApiString) mempty   parseBool = onlyUnnamed $ (#_schemaType ?~ OpenApiBoolean) mempty   validateJSON (JSONSchema d) = JSONSchema d+  nameParser name = \schema -> JSONSchema $ do+    (NamedSchema _ schema) <- getJSONSchema schema+    pure $ NamedSchema (Just $ encodeRefName name) schema+  addFormat format =+    JSONSchema+      . fmap+        (#_namedSchemaSchema % #_schemaFormat ?~ format)+      . getJSONSchema  instance JSONSerializer JSONSchema where-  serializeObject t f = JSONSchema $ do+  serializeObject f = JSONSchema $ do     d <- getObjectSchema f-    pure $ NamedSchema (Just t) d+    pure $+      NamedSchema Nothing $+        mempty+          & (#_schemaType ?~ OpenApiObject)+            . (#_schemaProperties .~ (d ^. #propertyTypes))+            . (#_schemaRequired .~ (d ^. #requiredProperties))   serializeTuple t = JSONSchema $ do     items <- getTupleSchema t     pure $       ( unnamed-      . (#_schemaType ?~ OpenApiArray)-      . (#_schemaItems ?~ OpenApiItemsArray items)-      ) mempty+          . (#_schemaType ?~ OpenApiArray)+          . (#_schemaItems ?~ OpenApiItemsArray items)+      )+        mempty   serializeArray :: forall a. (ToJSON a) => JSONSchema [a]   serializeArray = JSONSchema $ do     itemRef <- getRefDef $ getToNamed (Proxy :: Proxy a)     pure $       ( unnamed-      . (#_schemaType ?~ OpenApiArray)-      . (#_schemaItems ?~ OpenApiItemsObject itemRef)-      ) mempty+          . (#_schemaType ?~ OpenApiArray)+          . (#_schemaItems ?~ OpenApiItemsObject itemRef)+      )+        mempty   serializeText = parseText   serializeBool = parseBool   serializeNumber = parseNumber   serializeDictionary ser = JSONSchema $ do     r <- getRefDef (getJSONSchema ser)-    pure $ unnamed $-      ( (#_schemaType ?~ OpenApiObject)-      . (#_schemaAdditionalProperties ?~ AdditionalPropertiesSchema r)-      ) mempty+    pure $+      unnamed $+        ( (#_schemaType ?~ OpenApiObject)+            . (#_schemaAdditionalProperties ?~ AdditionalPropertiesSchema r)+        )+          mempty   serializeNull =     case parseNull of       JSONSchema a -> JSONSchema a   serializeTextConstant t = let (JSONSchema a) = parseTextConstant t in JSONSchema a+  nameSerializer t = \ser -> JSONSchema $ do+    (NamedSchema _ s) <- getJSONSchema ser+    pure $ NamedSchema (Just $ encodeRefName t) s --- | Get documentation for a type that implements FromJSON+-- | Get documentation for a type that implements 'Jordan.FromJSON.Class.FromJSON', in the @ Declare @ environment.+--+-- This will be inline documention, IE, it will be named but not stored in the schema definitions. getFromNamed :: forall a. (FromJSON a) => Proxy a -> Declare (Definitions Schema) NamedSchema getFromNamed p = getJSONSchema (fromJSON :: JSONSchema a) --- | Get documentation for a type that implements ToJSON+-- | Get documention for a type that implements 'Jordan.FromJSON.Class.FromJSON'.+--+-- This will store the type in the schemas key of the schema definitions, and give back a reference to it.+getFromRef :: forall a. (FromJSON a) => Proxy a -> Declare (Definitions Schema) (Referenced Schema)+getFromRef = getRefDef . getFromNamed++-- | Get documentation for a type that implements 'Jordan.ToJSON.Class.ToJSON'.+--+-- This will be inline documentation, IE, it will be named but not stored in the schema definitions. getToNamed :: forall a. (ToJSON a) => Proxy a -> Declare (Definitions Schema) NamedSchema getToNamed p = getJSONSchema (toJSON :: JSONSchema a)++-- | Get documentation for a type that implements 'Jordan.ToJSON.Class.ToJSON'.+--+-- This will store the type in the schemas key of the schemas definitions, then give back a reference to it.+getToRef :: forall a. (ToJSON a) => Proxy a -> Declare (Definitions Schema) (Referenced Schema)+getToRef = getRefDef . getToNamed

@@ -14,9 +14,9 @@   = Person   { firstName :: T.Text   , lastName :: T.Text+  , age :: Int   } deriving (Show, Generic)   deriving anyclass (ToJSON, FromJSON)-  data Managership   = Managership

@@ -1,68 +1,59 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-}-module Main-    where +module Main where++import Data.Aeson (encode)+import qualified Data.ByteString.Lazy as BS import qualified Data.HashMap.Strict.InsOrd as I+import Data.OpenApi import Data.OpenApi.Declare (Declare, evalDeclare, execDeclare) import Data.OpenApi.Internal-import Data.Proxy (Proxy(..))+import Data.Proxy (Proxy (..)) import Data.Text (Text)-import Jordan (FromJSON(..), ToJSON(..))-import Jordan.OpenAPI (getFromNamed, getToNamed)+import Jordan (FromJSON (..), ToJSON (..))+import Jordan.OpenAPI (JordanToJSONSchema, getFromNamed, getToNamed) import Jordan.OpenAPI.SpecDefs import Optics.Operators ((^.)) import Test.Hspec (Expectation, SpecWith, before, describe, hspec, it, shouldBe, shouldContain) -main = hspec $ do-  fileScenarios-  entryScenarios-  recursiveScenarios-  topLevelScenarios+main = do+  hspec $ do+    fileScenarios+    entryScenarios+    recursiveScenarios -shouldMakeNamedTo-  :: (ToJSON a)-  => Proxy a-  -> Text-  -> Expectation+shouldMakeNamedTo ::+  (ToJSON a) =>+  Proxy a ->+  Text ->+  Expectation shouldMakeNamedTo p@Proxy name =   (evalDeclare (getToNamed p) mempty ^. #_namedSchemaName) `shouldBe` Just name -shouldMakeUnnamed-  :: (ToJSON a)-  => Proxy a-  -> Expectation-shouldMakeUnnamed p@Proxy =-  (evalDeclare (getToNamed p) mempty ^. #_namedSchemaName) `shouldBe` Nothing--shouldDeclareTo-  :: (ToJSON a)-  => Proxy a-  -> Text-  -> Expectation+shouldDeclareTo ::+  (ToJSON a) =>+  Proxy a ->+  Text ->+  Expectation shouldDeclareTo p@Proxy name =   I.keys (execDeclare (getToNamed p) mempty) `shouldContain` [name]  fileScenarios = describe "basic scenarios with file-like types" $ do   it "works with file" $ do-    (Proxy @File) `shouldMakeNamedTo` "Jordan.OpenAPI.SpecDefs.File.File.Output"+    (Proxy @File) `shouldMakeNamedTo` "Jordan.OpenAPI.SpecDefs.File"   it "works with directory" $ do-    (Proxy @Directory) `shouldMakeNamedTo` "Jordan.OpenAPI.SpecDefs.Directory.Directory.Output"+    (Proxy @Directory) `shouldMakeNamedTo` "Jordan.OpenAPI.SpecDefs.Directory"  entryScenarios = describe "bsaic scenarios with a directory-entry-like type" $ do   it "includes definition for a file" $ do-    (Proxy @FileEntry) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.File.File.Output"+    (Proxy @FileEntry) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.File"   it "includes definition for a directory" $ do-    (Proxy @FileEntry) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Directory.Directory.Output"+    (Proxy @FileEntry) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Directory"  recursiveScenarios = describe "scenarios with a recursive data type" $ do   it "contains the top-level type" $ do-    (Proxy @Managership) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Managership.Managership.Output"+    (Proxy @Managership) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Managership"   it "contains a nested type" $ do-    (Proxy @Managership) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Person.Person.Output"--topLevelScenarios = describe "scenarios with some top-level sum type" $ do-  it "is not named" $ do-    shouldMakeUnnamed (Proxy @Rank)-+    (Proxy @Managership) `shouldDeclareTo` "Jordan.OpenAPI.SpecDefs.Person"