From 6d71fdba38294abb7e2641d1abf5d2be7a1d1067 Mon Sep 17 00:00:00 2001
From: Alex Biehl <alex@scarf.sh>
Date: Thu, 26 Jan 2023 19:07:47 +0100
Subject: [PATCH] Normalize input files such to allow cross file references

---
 src/Tie.hs | 52 +++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 49 insertions(+), 3 deletions(-)

diff --git a/src/Tie.hs b/src/Tie.hs
index 8f3c733..8469e87 100644
--- a/src/Tie.hs
+++ b/src/Tie.hs
@@ -10,13 +10,18 @@ module Tie
   )
 where
 
+import qualified Data.Aeson
+import qualified Data.Aeson.KeyMap
+import qualified Data.Aeson.Types as Data.Aeson
 import qualified Data.HashMap.Strict.InsOrd as InsOrd
 import qualified Data.HashSet as HashSet
 import qualified Data.OpenApi as OpenApi
 import qualified Data.Set as Set
+import qualified Data.Text as Text
 import Data.Yaml (decodeFileThrow)
 import Prettyprinter (Doc, vsep)
 import Prettyprinter.Internal (unsafeTextWithoutNewlines)
+import System.FilePath (takeDirectory, (</>))
 import Tie.Codegen.Cabal (codegenCabalFile)
 import Tie.Codegen.Imports
   ( codegenExternalHaskellDependencies,
@@ -83,11 +88,52 @@ nubOrd = Set.toList . Set.fromList
 -- | Read an OpenAPI spec. Throws in case it can not
 -- be read or deserialized.
 readOpenApiSpec ::
-  MonadIO m =>
+  (MonadIO m) =>
   FilePath ->
   m OpenApi.OpenApi
-readOpenApiSpec filePath =
-  liftIO (decodeFileThrow filePath)
+readOpenApiSpec filePath = do
+  value <- liftIO (decodeFileThrow filePath)
+  value <- resolveFileReferences (takeDirectory filePath) value
+  case Data.Aeson.parseMaybe Data.Aeson.parseJSON value of
+    Just openApi ->
+      pure openApi
+    Nothing ->
+      error "Could not decode OpenAPI specification"
+
+resolveFileReferences ::
+  (MonadIO m) =>
+  FilePath ->
+  Data.Aeson.Value ->
+  m Data.Aeson.Value
+resolveFileReferences cwd value = case value of
+  Data.Aeson.Object object
+    -- Relative references of the form
+    --   "$ref": "./dir/some-file.yaml"
+    | Just (Data.Aeson.String path) <- Data.Aeson.KeyMap.lookup "$ref" object,
+      "." `Text.isPrefixOf` path -> do
+        let fileName = cwd </> toString path
+        value <- liftIO (decodeFileThrow fileName)
+        resolveFileReferences (takeDirectory fileName) value
+
+    -- Relative references of the form
+    --   "$ref": "/dir/some-file.yaml"
+    | Just (Data.Aeson.String path) <- Data.Aeson.KeyMap.lookup "$ref" object,
+      "/" `Text.isPrefixOf` path -> do
+        let fileName = toString path
+        value <- liftIO (decodeFileThrow fileName)
+        resolveFileReferences (takeDirectory fileName) value
+    | otherwise ->
+        Data.Aeson.Object <$> forM object (resolveFileReferences cwd)
+  Data.Aeson.Array array ->
+    Data.Aeson.Array <$> forM array (resolveFileReferences cwd)
+  Data.Aeson.String {} ->
+    pure value
+  Data.Aeson.Number {} ->
+    pure value
+  Data.Aeson.Bool {} ->
+    pure value
+  Data.Aeson.Null ->
+    pure value
 
 -- | Extracts all the schemas form an 'OpenApi.OpenApi'.
 specSchemas :: OpenApi.OpenApi -> [(Text, OpenApi.Schema)]