packages feed

yggdrasil-schema (empty) → 1.0.0.0

raw patch · 6 files changed

+411/−0 lines, 6 filesdep +QuickCheckdep +aesondep +asyncsetup-changed

Dependencies added: QuickCheck, aeson, async, base, bytestring, containers, directory, filepath, hspec, keys, mtl, neat-interpolation, optics, optparse-applicative, random, relude, sqlite-simple, tasty, tasty-hspec, text, time, uuid, yggdrasil-schema

Files

+ README.org view
@@ -0,0 +1,67 @@+* Yggdrasil Schema++#+begin_html+<div>+<img src="https://img.shields.io/badge/Haskell-5D4F85?logo=haskell&logoColor=fff&style=plastic" alt="Haskell"/>+<img src="https://img.shields.io/badge/SQLite-4169E1?logo=sqlite&logoColor=fff&style=plastic" alt="SQLite"/>+<img src="https://img.shields.io/badge/Nix-5277C3?logo=nixos&logoColor=fff&style=plastic" alt="Nix"/>+</div>+#+end_html++Yggdrasil Schema is a Haskell-based tool for managing database migrations.+Inspired by tools like Flyway, or Liquibase, it automates the process of applying migrations, keeping track of which migrations have been executed, and ensuring they only run once.++Yggdrasil Schema is designed to be simple, extensible, and adaptable to various storage engines.++Initially, it supports SQLite, but its architecture is open for future extensions to support additional storage engines.+As of now available as library only, in the future also as CLI standalone tool (with optparse-applicative).++#+begin_html+<div>+<img src="./resources/img/yggdrasil.webp"/>+</div>+#+end_html++** Features++- Automatically applies missing migrations to your database+- Tracks migration history to ensure each migration is run exactly once+- Written in Haskell with a focus on functional programming principles+- Supports SQLite out of the box, other storage engines should be easy to add, and we are open for contributions++** Usage++Once installed, you can use Yggdrasil to apply migrations to your database.++By default, Yggdrasil SQLite branch looks for migration files in the ~./resources/migrations/sqlite/~ directory.++*NOTE* : Keep in mind this slash ( / ) at the end is very important.++All you need is a directory with migration files.+The only requirement in naming the files is that they start with a number and a dash, so that the order can be determined.++Examples of valid files: ~0-init-my-database.sql~ , ~100-another migration with spaces.txt~++To get things working properly, please ensure that your first migration, called something like ~0-yggdrasil.sql~ contains the following:+#+begin_src sql+CREATE TABLE yggdrasil (+  identifier TEXT NOT NULL PRIMARY KEY,+  order_value INTEGER NOT NULl,+  file_name TEXT NOT NULL,+  ran_at TEXT NOT NULL+);++#+end_src++** Extending Yggdrasil++Yggdrasil is built with extension in mind. You can easily add support for other databases by implementing a new storage engine backend. ++** Contributing++We welcome contributions from the community. Whether it's bug fixes, new features, or documentation improvements, feel free to open a pull request or an issue.++** License++This project is licensed under the GNU Lesser GPL License v3. See the COPYING file for more details.+
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ src/Yggdrasil.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++module Yggdrasil where++import Control.Exception+import Data.List (minimumBy)+import Data.List.NonEmpty qualified as NE+import Data.Text qualified as T+import Data.Time+import Data.UUID.V4+import Database.SQLite.Simple+import NeatInterpolation+import Optics+import Relude+import System.Directory++data YggdrasilEngine = SQLite | PostgreSQL | MySQL deriving (Generic, Eq, Show)++data Yggdrasil = Yggdrasil+  { databaseFilePath :: Text,+    migrationsDirectoryPath :: Text,+    runMigrations :: Bool,+    engine :: YggdrasilEngine+  }+  deriving (Generic, Eq, Show)++makeFieldLabelsNoPrefix ''Yggdrasil++data RanMigration = RanMigration Text Int Text UTCTime+  deriving (Generic, Eq, Show)++instance FromRow RanMigration where+  fromRow = RanMigration <$> field <*> field <*> field <*> field++defaultYggdrasil :: Yggdrasil+defaultYggdrasil =+  Yggdrasil+    { databaseFilePath = "./resources/test/db.sqlite",+      migrationsDirectoryPath = "./resources/migrations/sqlite/",+      runMigrations = True,+      engine = SQLite+    }++runYggdrasil :: (MonadIO m) => Yggdrasil -> m ()+runYggdrasil yggdrasil = when (yggdrasil ^. #runMigrations) $ do+  sortedFiles <- getSortedMigrationFiles yggdrasil+  case nonEmpty sortedFiles of+    Nothing -> error "No valid migration files found!"+    Just ordersAndFiles -> do+      ranMigrations <- liftIO $ catch (getRanMigrations yggdrasil) handler++      let execReqHighest = minimumBy (comparing Down) $ NE.map fst ordersAndFiles+          isThereHigher = isJust . find (\p -> fst p > execReqHighest) $ ranMigrations+      when isThereHigher $ error "Detected a migration order mismatch! History contains newer items than in migrations folder!"++      let toRun = NE.filter (\t -> isNothing $ find (== t) ranMigrations) ordersAndFiles++      case nonEmpty toRun of+        Nothing -> print ("All migrations up to date!" :: String)+        Just toRun' -> do+          _ <- print ("About to run migrations!" :: String)+          _ <- print toRun'+          mapM_ (runMigration yggdrasil) toRun'+  where+    handler :: SQLError -> IO [(Int, Text)]+    handler _ = pure []++getSortedMigrationFiles :: (MonadIO m) => Yggdrasil -> m [(Int, Text)]+getSortedMigrationFiles yggdrasil = do+  files <- liftIO $ listDirectory (fromString . T.unpack $ yggdrasil ^. #migrationsDirectoryPath)+  let rawFs = mapMaybe (explodeMigrationPath . T.pack) files+      rawFilesWithOrder = mapMaybe (liftTupleMaybeFromFst . toIntOrder) rawFs+      sortedFiles = sortOn fst rawFilesWithOrder+  pure sortedFiles++toIntOrder :: (Text, Text) -> (Maybe Int, Text)+toIntOrder = first (readMaybe . T.unpack)++explodeMigrationPath :: Text -> Maybe (Text, Text)+explodeMigrationPath filePath =+  let k = (fmap head . nonEmpty . T.split (== '-')) filePath+   in liftTupleMaybeFromFst (k, filePath)++liftTupleMaybeFromFst :: (Maybe a, b) -> Maybe (a, b)+liftTupleMaybeFromFst (Nothing, _) = Nothing+liftTupleMaybeFromFst (Just j, x) = Just (j, x)++parseTextToSqlStatements :: Text -> [Text]+parseTextToSqlStatements = filter (/= "") . map T.strip . T.split (== ';')++runMigration :: (MonadIO m) => Yggdrasil -> (Int, Text) -> m ()+runMigration yggdrasil (ord', fPath) = do+  f <- readFileBS (T.unpack (yggdrasil ^. #migrationsDirectoryPath <> fPath))+  let maybeFileContents = decodeUtf8' f+  case maybeFileContents of+    Left e -> print e >> error (show e) -- migration errors should be critical+    Right fileContents' -> do+      conn <- liftIO $ open (T.unpack $ yggdrasil ^. #databaseFilePath)+      -- run statements from parsed file  in order+      _ <-+        liftIO+          $ mapM+            (\qqq -> execute_ conn (fromString . T.unpack $ qqq))+            (parseTextToSqlStatements fileContents')+      -- record in migrations table that we ran migration so as to not run again+      someUUID <- liftIO nextRandom+      now <- liftIO getCurrentTime+      -- TODO: add the Yggdrasil versio number when as library+      _ <- liftIO $ execute conn (fromString . T.unpack $ insertYggdrasilMigrationQuery) (T.pack . show $ someUUID, ord', fPath, now)+      _ <- liftIO $ close conn+      pure ()+  where+    insertYggdrasilMigrationQuery =+      [trimming|+      INSERT INTO yggdrasil (identifier, order_value, file_name, ran_at) VALUES (?,?,?,?)+      |]++getRanMigrations :: (MonadIO m) => Yggdrasil -> m [(Int, Text)]+getRanMigrations yggdrasil = do+  conn <- liftIO $ open (fromString . T.unpack $ yggdrasil ^. #databaseFilePath)+  (ms :: [RanMigration]) <- liftIO $ catch (query_ conn "SELECT identifier, order_value, file_name, ran_at from yggdrasil") handler+  pure . sortOn fst . map mapRanMigration $ ms+  where+    mapRanMigration (RanMigration _ orderValue fileName _) = (orderValue, fileName)+    handler :: SQLError -> IO [RanMigration]+    handler _ = pure []
+ test/Spec.hs view
@@ -0,0 +1,7 @@+import Relude+import Test.Hspec+import Yggdrasil.Test.Yggdrasil++main :: IO ()+main = hspec $ do+  yggdrasilSpec
+ test/Yggdrasil/Test/Yggdrasil.hs view
@@ -0,0 +1,71 @@+module Yggdrasil.Test.Yggdrasil where++import Data.Text qualified as T+import Data.UUID.V4+import Relude+import System.Directory+import Test.Hspec+import Yggdrasil++yggdrasilSpec :: SpecWith ()+yggdrasilSpec = describe "yggdrasil" $ do+  it "can parse sql DDL statements for SQLite" $ do+    f <- readFileBS "./resources/test/migration-files/1-some-valid-sql.sql"+    case decodeUtf8' f of+      Left e -> print e >> error (show e)+      Right t -> do+        let parsed = parseTextToSqlStatements t+        length parsed `shouldBe` 3+  it "can explode migration filename properly" $ do+    explodeMigrationPath "0-init.sql" `shouldBe` Just ("0", "0-init.sql")+    explodeMigrationPath "999999-init.sql" `shouldBe` Just ("999999", "999999-init.sql")+    explodeMigrationPath "1-init🔗❤️👍.sql" `shouldBe` Just ("1", "1-init🔗❤️👍.sql")+    explodeMigrationPath "23-init with spaces and weird symbols$.sql" `shouldBe` Just ("23", "23-init with spaces and weird symbols$.sql")+  it "gets files in the right order" $ do+    xs <- getSortedMigrationFiles defaultYggdrasil {migrationsDirectoryPath = "./resources/test/migration-files/"}+    xs `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")]+  it "does run migrations correctly on clean DB" $ do+    someUUID <- liftIO nextRandom+    let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite"+        yggdrasil =+          Yggdrasil+            { databaseFilePath = dbPath,+              migrationsDirectoryPath = "./resources/test/migration-files/",+              engine = SQLite,+              runMigrations = True+            }+    _ <- runYggdrasil yggdrasil+    ms <- getRanMigrations yggdrasil+    _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath)+    ms `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")]++  it "does skip migrations correctly on used DB" $ do+    someUUID <- liftIO nextRandom+    let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite"+        yggdrasil =+          Yggdrasil+            { databaseFilePath = dbPath,+              migrationsDirectoryPath = "./resources/test/migration-files/",+              engine = SQLite,+              runMigrations = True+            }+    _ <- runMigration yggdrasil (0, "0-yggdrasil.sql")+    _ <- runMigration yggdrasil (1, "1-some-valid-sql.sql")+    _ <- runYggdrasil yggdrasil+    ms <- getRanMigrations yggdrasil+    _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath)+    ms `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")]+  it "does not do anything when runMigrations is false" $ do+    someUUID <- liftIO nextRandom+    let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite"+        yggdrasil =+          Yggdrasil+            { databaseFilePath = dbPath,+              migrationsDirectoryPath = "./resources/test/migration-files/",+              engine = SQLite,+              runMigrations = False+            }+    _ <- runYggdrasil yggdrasil+    ms <- getRanMigrations yggdrasil+    _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath)+    ms `shouldBe` []
+ yggdrasil-schema.cabal view
@@ -0,0 +1,131 @@+cabal-version: 1.12++name:           yggdrasil-schema+version:        1.0.0.0+description:    Please see the README at <https://github.com/jjba23/yggdrasil-schema>+homepage:       https://github.com/jjba23/yggdrasil-schema+bug-reports:    https://github.com/jjba23/yggdrasil-schema/issues+author:         Josep Bigorra+maintainer:     Josep Bigorra <jjbigorra@gmail.com>+copyright:      2024 Josep Bigorra+license:        LGPL-3+build-type:     Simple+                +extra-source-files:+    README.org++source-repository head+  type: git+  location: https://github.com/jjba23/yggdrasil-schema++library+  exposed-modules:+      Yggdrasil+  other-modules:+      Paths_yggdrasil_schema+  hs-source-dirs:+      src+  ghc-options: -Wall -threaded+  default-extensions:+      DataKinds+      DefaultSignatures+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiWayIf+      NamedFieldPuns+      NoImplicitPrelude+      OverloadedStrings+      PartialTypeSignatures+      RecordWildCards+      TypeFamilies+      ViewPatterns++  build-depends:+      aeson+    , async+    , base < 5+    , bytestring+    , keys+    , mtl+    , optics+    , optparse-applicative+    , relude+    , time+    , text+    , containers+    , filepath+    , directory+    , random+    , uuid+    , neat-interpolation+    , sqlite-simple+  default-language: GHC2021+++test-suite yggdrasil-schema-spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs      +  other-modules:+      Paths_yggdrasil_schema+      Yggdrasil.Test.Yggdrasil+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-T -N"+  default-extensions:+      DataKinds+      DefaultSignatures+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiWayIf+      NamedFieldPuns+      NoImplicitPrelude+      OverloadedStrings+      PartialTypeSignatures+      RecordWildCards+      TypeFamilies+      ViewPatterns++  build-depends:+      aeson+    , async+    , base < 5+    , bytestring+    , keys+    , mtl+    , optics+    , optparse-applicative+    , relude+    , random+    , time+    , text+    , containers+    , filepath+    , directory+    , uuid+    , neat-interpolation+    , sqlite-simple+    , hspec+    , QuickCheck+    , tasty +    , tasty-hspec+    , yggdrasil-schema+  default-language: GHC2021+++