more cleanup

app/Lib/Common/Types.hs

@@ -1,12 +1,37 @@
 module Lib.Common.Types where
 
 import Data.Aeson
-import GHC.Generics (Generic)
-import Lib.OpenApi.Types
-import Lib.Path.Types
+import Data.Scientific
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Text.Read (decimal)
+import Network.HTTP.Types.Method
+import Network.HTTP.Types.Status
 
-data ServerConfig = PathConf Paths | OpenApiConf OpenApi
-  deriving (Generic, Show, Eq)
+newtype HTTPStatus = HTTPStatus {unStatus :: Status} deriving (Show, Eq, Ord)
 
-instance FromJSON ServerConfig where
-  parseJSON = genericParseJSON defaultOptions{sumEncoding = UntaggedValue}
+instance FromJSON HTTPStatus where
+  parseJSON = withScientific "Status" $ \s ->
+    case toBoundedInteger s of
+      Nothing -> fail "Bad status code"
+      Just i -> return (HTTPStatus . toEnum $ i)
+
+instance FromJSONKey HTTPStatus where
+  fromJSONKey = FromJSONKeyTextParser $ \s ->
+    case decimal s of
+      Left e -> fail e
+      Right (i, _) -> return (HTTPStatus . toEnum $ i)
+
+newtype HTTPMethod = HTTPMethod {unMethod :: StdMethod} deriving (Show, Eq, Ord)
+
+instance FromJSON HTTPMethod where
+  parseJSON = withText "Method" $ \s ->
+    case (parseMethod . T.encodeUtf8 . T.toUpper) s of
+      Left e -> fail $ (T.unpack . T.decodeUtf8) e
+      Right m -> return $ HTTPMethod m
+
+instance FromJSONKey HTTPMethod where
+  fromJSONKey = FromJSONKeyTextParser $ \s ->
+    case (parseMethod . T.encodeUtf8 . T.toUpper) s of
+      Left e -> fail $ (T.unpack . T.decodeUtf8) e
+      Right m -> return $ HTTPMethod m

app/Lib/OpenApi/Types.hs

@@ -14,7 +14,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Read (decimal)
 import GHC.Generics (Generic)
-import Lib.Types
+import Lib.Common.Types
 import Network.HTTP.Types (Status, ok200)
 
 data OpenApi = OpenApi
@@ -91,7 +91,7 @@ schemaLookup schemaContent (SchemaRef (Ref r)) =
       ref@(SchemaRef _) -> schemaLookup schemaContent ref
       s -> return s
 schemaLookup schemaContent (SchemaObject (Just props)) =
-  (sequenceA $ M.map (schemaLookup schemaContent) props)
+  traverse (schemaLookup schemaContent) props
     >>= return
       . SchemaObject
       . return

app/Lib/Path/Types.hs

@@ -6,7 +6,7 @@ import Data.Aeson
 import Data.Map.Strict (Map)
 import Data.Text.Lazy qualified as TL
 import GHC.Generics
-import Lib.Types
+import Lib.Common.Types
 
 type Paths = Map String PathConfig
 

app/Lib/Types.hs

@@ -3,37 +3,12 @@
 module Lib.Types where
 
 import Data.Aeson
-import Data.Scientific
-import Data.Text qualified as T
-import Data.Text.Encoding qualified as T
-import Data.Text.Read (decimal)
-import Network.HTTP.Types.Method
-import Network.HTTP.Types.Status
+import GHC.Generics (Generic)
+import Lib.OpenApi.Types
+import Lib.Path.Types
 
-newtype HTTPStatus = HTTPStatus {unStatus :: Status} deriving (Show, Eq, Ord)
+data ServerConfig = PathConf Paths | OpenApiConf OpenApi
+  deriving (Generic, Show, Eq)
 
-instance FromJSON HTTPStatus where
-  parseJSON = withScientific "Status" $ \s ->
-    case toBoundedInteger s of
-      Nothing -> fail "Bad status code"
-      Just i -> return (HTTPStatus . toEnum $ i)
-
-instance FromJSONKey HTTPStatus where
-  fromJSONKey = FromJSONKeyTextParser $ \s ->
-    case decimal s of
-      Left e -> fail e
-      Right (i, _) -> return (HTTPStatus . toEnum $ i)
-
-newtype HTTPMethod = HTTPMethod {unMethod :: StdMethod} deriving (Show, Eq, Ord)
-
-instance FromJSON HTTPMethod where
-  parseJSON = withText "Method" $ \s ->
-    case (parseMethod . T.encodeUtf8 . T.toUpper) s of
-      Left e -> fail $ (T.unpack . T.decodeUtf8) e
-      Right m -> return $ HTTPMethod m
-
-instance FromJSONKey HTTPMethod where
-  fromJSONKey = FromJSONKeyTextParser $ \s ->
-    case (parseMethod . T.encodeUtf8 . T.toUpper) s of
-      Left e -> fail $ (T.unpack . T.decodeUtf8) e
-      Right m -> return $ HTTPMethod m
+instance FromJSON ServerConfig where
+  parseJSON = genericParseJSON defaultOptions{sumEncoding = UntaggedValue}

app/Main.hs

@@ -180,8 +180,7 @@ jsonFromSchema (SchemaObject props) =
   fromMaybe (Object mempty)
     <$> traverse
       ( fmap (object . M.foldlWithKey (\a k v -> (fromText k, v) : a) [])
-          . sequenceA
-          . M.map jsonFromSchema
+          . traverse jsonFromSchema
       )
       props
 jsonFromSchema (SchemaArray item) =