aboutsummaryrefslogtreecommitdiffstats
path: root/backend/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'backend/app/Main.hs')
-rw-r--r--backend/app/Main.hs30
1 files changed, 18 insertions, 12 deletions
diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index 6742ad2..d26259b 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -69,7 +69,7 @@ data Commit = Commit
data Collection = Collection
{ path :: FilePath,
files :: [FilePath],
- schema :: Schema
+ schema :: U.T
}
deriving (Show)
@@ -130,10 +130,10 @@ initRepo root ref = do
(value : values) <- do
liftIO $ Q.withStore root ref do
mapM (Q.withCommit cid . Q.readFile) (file : files)
- let schema = fromAutoTypes path $ U.autoTypes' value values
+ let schema = U.autoTypes' value values
pure $ Collection path files schema
let schemaVersion =
- case lastMay cs of
+ case headMay cs of
Nothing -> Version 1 0 0
Just c' ->
let Version major' minor' patch' = c'.schemaVersion
@@ -159,8 +159,8 @@ initRepo root ref = do
cs
compareSchemas ::
- M.Map String Schema ->
- M.Map String Schema ->
+ M.Map String U.T ->
+ M.Map String U.T ->
Maybe SchemaDifference
compareSchemas schemas' schemas =
maximumMay
@@ -174,19 +174,24 @@ compareSchemas schemas' schemas =
schemas'
schemas
where
- compareSchemas' Nothing (Just _) = Just Patch
- compareSchemas' (Just _) Nothing = Just Patch
+ compareSchemas' Nothing Nothing = Nothing
+ compareSchemas' Nothing (Just _) = Just Minor
+ compareSchemas' (Just _) Nothing = Just Major
compareSchemas' (Just schema') (Just schema) = compareSchema schema' schema
--- TODO
-compareSchema :: Schema -> Schema -> Maybe SchemaDifference
-compareSchema schema' schema = Nothing
+compareSchema :: U.T -> U.T -> Maybe SchemaDifference
+compareSchema (U.Object kts') (U.Object kts) = compareSchemas kts' kts
+compareSchema t' t
+ | t' == t = Nothing
+ | t' `elem` (U.unify1 t' t) = Just Patch
+ | t `elem` U.unify1 t' t = Just Minor
+ | otherwise = Just Major
data SchemaDifference
= Major
| Minor
| Patch
- deriving (Eq, Ord)
+ deriving (Show, Eq, Ord)
main :: IO ()
main = do
@@ -202,7 +207,8 @@ main = do
Right (SchemaJson path) -> do
repo <- atomically (readTMVar repoT)
let [c] = filter ((== path) . (.path)) (last repo.commits).collections
- respond $ W.responseLBS W.status200 [] (J.encode c.schema)
+ respond . W.responseLBS W.status200 [] $
+ J.encode (fromAutoTypes path c.schema)
Right Query -> do
q <-
fromString @Q.Query . LB.toString