aboutsummaryrefslogtreecommitdiffstats
path: root/autotypes
diff options
context:
space:
mode:
Diffstat (limited to 'autotypes')
-rw-r--r--autotypes/autotypes.cabal1
-rw-r--r--autotypes/src/AutoTypes.hs3
-rw-r--r--autotypes/src/AutoTypes/Unify.hs11
3 files changed, 13 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