From 324ee5e50f88b5877f29164ca9c3e1c6c5161251 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kier=C3=A1n=20Meinhardt?= <kmein@posteo.de>
Date: Sat, 12 Oct 2024 11:56:25 +0200
Subject: add date-time scalars and conform further to json schema

---
 autotypes/autotypes.cabal        |  1 +
 autotypes/src/AutoTypes/Unify.hs | 44 ++++++++++++++++++++++++++++++----------
 2 files changed, 34 insertions(+), 11 deletions(-)

(limited to 'autotypes')

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
-- 
cgit v1.2.3