support references

4 files changed, 15 insertions, 2 deletions

diff --git a/autotypes/autotypes.cabal b/autotypes/autotypes.cabal
index 284ad0e..c81abd0 100644
--- a/autotypes/autotypes.cabal
+++ b/autotypes/autotypes.cabal
@@ -38,6 +38,7 @@ library
       bytestring,
       containers,
       filepath,
+      text,
       vector
     hs-source-dirs:   src
     default-language: Haskell2010
diff --git a/autotypes/src/AutoTypes.hs b/autotypes/src/AutoTypes.hs
index 826d6c6..ddc948c 100644
--- a/autotypes/src/AutoTypes.hs
+++ b/autotypes/src/AutoTypes.hs
@@ -12,7 +12,8 @@ import System.FilePath (takeFileName)
 
 autoTypes :: FilePath -> [FilePath] -> IO U.T
 autoTypes fp fps = autoTypes' <$> go fp <*> mapM go (fp : fps)
-  where go = fmap fromJust . decodeFileStrict'
+  where
+    go = fmap fromJust . decodeFileStrict'
 
 autoTypes' :: Value -> [Value] -> U.T
 autoTypes' t' ts' =
diff --git a/autotypes/src/AutoTypes/Unify.hs b/autotypes/src/AutoTypes/Unify.hs
index 1742c3a..3622cba 100644
--- a/autotypes/src/AutoTypes/Unify.hs
+++ b/autotypes/src/AutoTypes/Unify.hs
@@ -19,8 +19,10 @@ import Data.List (intercalate, nub)
 import Data.Map (Map)
 import qualified Data.Map as M
 import qualified Data.Map.Merge.Lazy as M
+import qualified Data.Text as T
 import qualified Data.Vector as V
 import Debug.Trace
+import System.FilePath (takeDirectory)
 import Prelude hiding (null)
 
 data T
@@ -29,6 +31,7 @@ data T
   | Option (Maybe T)
   | Scalar String
   | Union [T]
+  | Reference String
   deriving (Eq, Show)
 
 instance A.ToJSON T where
@@ -37,6 +40,7 @@ instance A.ToJSON T where
   toJSON (Option t) = A.toJSON t
   toJSON (Scalar s) = A.toJSON s
   toJSON (Union ts) = A.toJSON ts
+  toJSON (Reference i) = A.object [K.fromString "$ref" A..= A.String (T.pack i)]
 
 toString :: T -> String
 toString = intercalate "\n" . map (\(n, s) -> indent n s) . toString_ 0
@@ -66,6 +70,9 @@ unify1 :: T -> T -> [T]
 unify1 (Scalar n) (Scalar m)
   | n == m = [Scalar n]
   | otherwise = [union [Scalar n, Scalar m]]
+unify1 (Reference i) (Reference j)
+  | i == j = [Reference i]
+  | otherwise = [union [Reference i, Reference j]]
 unify1 l@(Object ls) r@(Object rs) =
   let os =
         ( map Object . traverse id $
@@ -181,7 +188,9 @@ instance Exception InferException
 
 fromJson :: A.Value -> T
 fromJson (A.Object kvs) =
-  object (M.mapKeys K.toString (M.map fromJson (KM.toMap kvs)))
+  case map (first K.toString) (KM.toList kvs) of
+    [("$ref", A.String i)] -> Reference (takeDirectory (T.unpack i))
+    _ -> object (M.mapKeys K.toString (M.map fromJson (KM.toMap kvs)))
 fromJson t@(A.Array vs) =
   let ts = map fromJson (V.toList vs)
    in case nub ts of
diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index 282ef6c..a81d769 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -99,6 +99,8 @@ fromAutoTypes path (U.Object ps) =
   where
     toProperty (U.Scalar "string") = "string" :: String
     toProperty (U.Option (Just (U.Scalar "string"))) = "string?" :: String
+    toProperty (U.Reference i) = "$ref:" <> i
+    toProperty x = error ("unhandled type: " <> show x)
 
 watch :: TMVar Repo -> FilePath -> G.RefName -> IO ()
 watch repoT root ref = do