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/Unify.hs44
2 files changed, 34 insertions, 11 deletions
diff --git a/autotypes/autotypes.cabal b/autotypes/autotypes.cabal
index c81abd0..d7d60b6 100644
--- a/autotypes/autotypes.cabal
+++ b/autotypes/autotypes.cabal
@@ -39,6 +39,7 @@ library
containers,
filepath,
text,
+ time,
vector
hs-source-dirs: src
default-language: Haskell2010
diff --git a/autotypes/src/AutoTypes/Unify.hs b/autotypes/src/AutoTypes/Unify.hs
index 3622cba..5d611d3 100644
--- a/autotypes/src/AutoTypes/Unify.hs
+++ b/autotypes/src/AutoTypes/Unify.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TypeApplications #-}
module AutoTypes.Unify
( T (..),
@@ -20,26 +21,44 @@ 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 Data.Time.Clock
+import Data.Time.Format.ISO8601
import qualified Data.Vector as V
import Debug.Trace
import System.FilePath (takeDirectory)
import Prelude hiding (null)
+data ScalarType
+ = String
+ | Number
+ | DateTime
+ | Bool
+ deriving (Eq, Show)
+
+scalarTypeString :: ScalarType -> String
+scalarTypeString String = "string"
+scalarTypeString Number = "number"
+scalarTypeString DateTime = "datetime"
+scalarTypeString Bool = "bool"
+
data T
= List (Maybe T)
| Object (Map String T)
| Option (Maybe T)
- | Scalar String
+ | Scalar ScalarType
| Union [T]
| Reference String
deriving (Eq, Show)
instance A.ToJSON T where
- toJSON (List t) = A.toJSON t
- toJSON (Object ts) = A.toJSON ts
+ toJSON (List t) = A.object [K.fromString "type" A..= "array", K.fromString "items" A..= A.toJSON t]
+ toJSON (Object ts) = A.object [K.fromString "type" A..= "object", K.fromString "properties" A..= A.toJSON ts]
toJSON (Option t) = A.toJSON t
- toJSON (Scalar s) = A.toJSON s
- toJSON (Union ts) = A.toJSON ts
+ toJSON (Scalar DateTime) = A.object [K.fromString "type" A..= "string", K.fromString "format" A..= "date-time"]
+ toJSON (Scalar String) = A.object [K.fromString "type" A..= "string"]
+ toJSON (Scalar Bool) = A.object [K.fromString "type" A..= "bool"]
+ toJSON (Scalar Number) = A.object [K.fromString "type" A..= "number"]
+ toJSON (Union ts) = A.object [K.fromString "oneOf" A..= A.toJSON ts]
toJSON (Reference i) = A.object [K.fromString "$ref" A..= A.String (T.pack i)]
toString :: T -> String
@@ -53,7 +72,7 @@ toString_ n (Object kvs) =
M.mapWithKey (\s t -> (n + 1, s) : toString_ (n + 2) t) kvs,
[(n, "}")]
]
-toString_ n (Scalar s) = [(n, s)]
+toString_ n (Scalar s) = [(n, scalarTypeString s)]
toString_ n (Union ts) = concatMap (toString_ n) ts
toString_ n (Option Nothing) = [(n, "null")]
toString_ n (Option (Just t)) = map (second (++ "?")) (toString_ n t)
@@ -175,10 +194,11 @@ object = Object
list :: Maybe T -> T
list = List
-string, number, bool, null :: T
-string = Scalar "string"
-number = Scalar "number"
-bool = Scalar "bool"
+string, number, bool, dateTime, null :: T
+string = Scalar String
+number = Scalar Number
+bool = Scalar Bool
+dateTime = Scalar DateTime
null = Option Nothing
data InferException = InferException [T]
@@ -197,7 +217,9 @@ fromJson t@(A.Array vs) =
[] -> list Nothing
[t] -> list (Just t)
_ -> throw (InferException ts)
-fromJson (A.String _) = string
+fromJson (A.String s)
+ | Just _ <- iso8601ParseM @Maybe @UTCTime (T.unpack s) = dateTime
+ | otherwise = string
fromJson (A.Number _) = number
fromJson (A.Bool _) = bool
fromJson A.Null = null