OpenAPI (#251): fetch file, parse schema

Pinafore/pinafore-webapi/lib/Pinafore/WebAPI/Fetch.hs

@@ -1 +1,13 @@
 module Pinafore.WebAPI.Fetch where
+
+import Network.URI
+import Shapes
+
+fetch :: Text -> IO LazyByteString
+fetch t =
+    case parseURIReference $ unpack t of
+        Just uri ->
+            case uriScheme uri of
+                "file" -> readFile $ uriPath uri
+                s -> fail $ "URI schema " <> show s <> " not supported"
+        Nothing -> fail $ show (unpack t) <> " is not a URI"

Pinafore/pinafore-webapi/lib/Pinafore/WebAPI/OpenAPI.hs

@@ -2,12 +2,25 @@ module Pinafore.WebAPI.OpenAPI
     ( openAPIImporter
     ) where
 
+import Data.Aeson
+import Data.OpenApi
 import Pinafore.Language
-import Pinafore.WebAPI.Fetch ()
+import Pinafore.Language.API
+import Pinafore.WebAPI.Fetch
 import Shapes
 
 importOpenAPI :: Text -> ResultT Text IO (LibraryContents ())
-importOpenAPI _t = liftInner $ FailureResult "NYI"
+importOpenAPI t = do
+    bs <- lift $ fetch t
+    jsonval <-
+        case eitherDecode bs of
+            Left err -> liftInner $ FailureResult $ "invalid JSON: " <> pack err
+            Right jsonval -> return jsonval
+    sc :: Schema <-
+        case fromJSON jsonval of
+            Error err -> liftInner $ FailureResult $ pack err
+            Success val -> return val
+    return $ valBDS "schema" "" $ (pack $ show sc :: Text)
 
 openAPIImporter :: Importer
 openAPIImporter = MkImporter "openapi" importOpenAPI

Pinafore/pinafore-webapi/package.yaml

@@ -9,6 +9,9 @@ library:
     source-dirs: lib
     dependencies:
       - base >= 4.16
+      - network-uri
+      - aeson
+      - openapi3
       - shapes
       - pinafore-language
     exposed-modules:

Pinafore/pinafore-webapi/pinafore-webapi.cabal

@@ -50,7 +50,10 @@ library
       ViewPatterns
   ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances -Wno-partial-type-signatures
   build-depends:
-      base >=4.16
+      aeson
+    , base >=4.16
+    , network-uri
+    , openapi3
     , pinafore-language
     , shapes
   default-language: GHC2021