diff options
Diffstat (limited to 'backend')
-rw-r--r-- | backend/app/Main.hs | 30 |
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 |