support references

2 files changed, 12 insertions, 2 deletions

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