{-# 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 ((forall x. YggdrasilEngine -> Rep YggdrasilEngine x)
-> (forall x. Rep YggdrasilEngine x -> YggdrasilEngine)
-> Generic YggdrasilEngine
forall x. Rep YggdrasilEngine x -> YggdrasilEngine
forall x. YggdrasilEngine -> Rep YggdrasilEngine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. YggdrasilEngine -> Rep YggdrasilEngine x
from :: forall x. YggdrasilEngine -> Rep YggdrasilEngine x
$cto :: forall x. Rep YggdrasilEngine x -> YggdrasilEngine
to :: forall x. Rep YggdrasilEngine x -> YggdrasilEngine
Generic, YggdrasilEngine -> YggdrasilEngine -> Bool
(YggdrasilEngine -> YggdrasilEngine -> Bool)
-> (YggdrasilEngine -> YggdrasilEngine -> Bool)
-> Eq YggdrasilEngine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YggdrasilEngine -> YggdrasilEngine -> Bool
== :: YggdrasilEngine -> YggdrasilEngine -> Bool
$c/= :: YggdrasilEngine -> YggdrasilEngine -> Bool
/= :: YggdrasilEngine -> YggdrasilEngine -> Bool
Eq, Int -> YggdrasilEngine -> ShowS
[YggdrasilEngine] -> ShowS
YggdrasilEngine -> String
(Int -> YggdrasilEngine -> ShowS)
-> (YggdrasilEngine -> String)
-> ([YggdrasilEngine] -> ShowS)
-> Show YggdrasilEngine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YggdrasilEngine -> ShowS
showsPrec :: Int -> YggdrasilEngine -> ShowS
$cshow :: YggdrasilEngine -> String
show :: YggdrasilEngine -> String
$cshowList :: [YggdrasilEngine] -> ShowS
showList :: [YggdrasilEngine] -> ShowS
Show)

data Yggdrasil = Yggdrasil
  { Yggdrasil -> Text
databaseFilePath :: Text,
    Yggdrasil -> Text
migrationsDirectoryPath :: Text,
    Yggdrasil -> Bool
runMigrations :: Bool,
    Yggdrasil -> YggdrasilEngine
engine :: YggdrasilEngine
  }
  deriving ((forall x. Yggdrasil -> Rep Yggdrasil x)
-> (forall x. Rep Yggdrasil x -> Yggdrasil) -> Generic Yggdrasil
forall x. Rep Yggdrasil x -> Yggdrasil
forall x. Yggdrasil -> Rep Yggdrasil x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Yggdrasil -> Rep Yggdrasil x
from :: forall x. Yggdrasil -> Rep Yggdrasil x
$cto :: forall x. Rep Yggdrasil x -> Yggdrasil
to :: forall x. Rep Yggdrasil x -> Yggdrasil
Generic, Yggdrasil -> Yggdrasil -> Bool
(Yggdrasil -> Yggdrasil -> Bool)
-> (Yggdrasil -> Yggdrasil -> Bool) -> Eq Yggdrasil
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Yggdrasil -> Yggdrasil -> Bool
== :: Yggdrasil -> Yggdrasil -> Bool
$c/= :: Yggdrasil -> Yggdrasil -> Bool
/= :: Yggdrasil -> Yggdrasil -> Bool
Eq, Int -> Yggdrasil -> ShowS
[Yggdrasil] -> ShowS
Yggdrasil -> String
(Int -> Yggdrasil -> ShowS)
-> (Yggdrasil -> String)
-> ([Yggdrasil] -> ShowS)
-> Show Yggdrasil
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Yggdrasil -> ShowS
showsPrec :: Int -> Yggdrasil -> ShowS
$cshow :: Yggdrasil -> String
show :: Yggdrasil -> String
$cshowList :: [Yggdrasil] -> ShowS
showList :: [Yggdrasil] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Yggdrasil

data RanMigration = RanMigration Text Int Text UTCTime
  deriving ((forall x. RanMigration -> Rep RanMigration x)
-> (forall x. Rep RanMigration x -> RanMigration)
-> Generic RanMigration
forall x. Rep RanMigration x -> RanMigration
forall x. RanMigration -> Rep RanMigration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RanMigration -> Rep RanMigration x
from :: forall x. RanMigration -> Rep RanMigration x
$cto :: forall x. Rep RanMigration x -> RanMigration
to :: forall x. Rep RanMigration x -> RanMigration
Generic, RanMigration -> RanMigration -> Bool
(RanMigration -> RanMigration -> Bool)
-> (RanMigration -> RanMigration -> Bool) -> Eq RanMigration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RanMigration -> RanMigration -> Bool
== :: RanMigration -> RanMigration -> Bool
$c/= :: RanMigration -> RanMigration -> Bool
/= :: RanMigration -> RanMigration -> Bool
Eq, Int -> RanMigration -> ShowS
[RanMigration] -> ShowS
RanMigration -> String
(Int -> RanMigration -> ShowS)
-> (RanMigration -> String)
-> ([RanMigration] -> ShowS)
-> Show RanMigration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RanMigration -> ShowS
showsPrec :: Int -> RanMigration -> ShowS
$cshow :: RanMigration -> String
show :: RanMigration -> String
$cshowList :: [RanMigration] -> ShowS
showList :: [RanMigration] -> ShowS
Show)

instance FromRow RanMigration where
  fromRow :: RowParser RanMigration
fromRow = Text -> Int -> Text -> UTCTime -> RanMigration
RanMigration (Text -> Int -> Text -> UTCTime -> RanMigration)
-> RowParser Text
-> RowParser (Int -> Text -> UTCTime -> RanMigration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Text
forall a. FromField a => RowParser a
field RowParser (Int -> Text -> UTCTime -> RanMigration)
-> RowParser Int -> RowParser (Text -> UTCTime -> RanMigration)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Text -> UTCTime -> RanMigration)
-> RowParser Text -> RowParser (UTCTime -> RanMigration)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
field RowParser (UTCTime -> RanMigration)
-> RowParser UTCTime -> RowParser RanMigration
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser UTCTime
forall a. FromField a => RowParser a
field

defaultYggdrasil :: Yggdrasil
defaultYggdrasil :: Yggdrasil
defaultYggdrasil =
  Yggdrasil
    { $sel:databaseFilePath:Yggdrasil :: Text
databaseFilePath = Text
"./resources/test/db.sqlite",
      $sel:migrationsDirectoryPath:Yggdrasil :: Text
migrationsDirectoryPath = Text
"./resources/migrations/sqlite/",
      $sel:runMigrations:Yggdrasil :: Bool
runMigrations = Bool
True,
      $sel:engine:Yggdrasil :: YggdrasilEngine
engine = YggdrasilEngine
SQLite
    }

runYggdrasil :: (MonadIO m) => Yggdrasil -> m ()
runYggdrasil :: forall (m :: * -> *). MonadIO m => Yggdrasil -> m ()
runYggdrasil Yggdrasil
yggdrasil = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Yggdrasil
yggdrasil Yggdrasil -> Optic' A_Lens NoIx Yggdrasil Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Yggdrasil Bool
#runMigrations) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  [(Int, Text)]
sortedFiles <- Yggdrasil -> m [(Int, Text)]
forall (m :: * -> *). MonadIO m => Yggdrasil -> m [(Int, Text)]
getSortedMigrationFiles Yggdrasil
yggdrasil
  case [(Int, Text)] -> Maybe (NonEmpty (Int, Text))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Int, Text)]
sortedFiles of
    Maybe (NonEmpty (Int, Text))
Nothing -> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"No valid migration files found!"
    Just NonEmpty (Int, Text)
ordersAndFiles -> do
      [(Int, Text)]
ranMigrations <- IO [(Int, Text)] -> m [(Int, Text)]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Int, Text)] -> m [(Int, Text)])
-> IO [(Int, Text)] -> m [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ IO [(Int, Text)]
-> (SQLError -> IO [(Int, Text)]) -> IO [(Int, Text)]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Yggdrasil -> IO [(Int, Text)]
forall (m :: * -> *). MonadIO m => Yggdrasil -> m [(Int, Text)]
getRanMigrations Yggdrasil
yggdrasil) SQLError -> IO [(Int, Text)]
handler

      let execReqHighest :: Int
execReqHighest = (Int -> Int -> Ordering) -> NonEmpty Int -> Int
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((Int -> Down Int) -> Int -> Int -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Int -> Down Int
forall a. a -> Down a
Down) (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Int) -> NonEmpty (Int, Text) -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int, Text) -> Int
forall a b. (a, b) -> a
fst NonEmpty (Int, Text)
ordersAndFiles
          isThereHigher :: Bool
isThereHigher = Maybe (Int, Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int, Text) -> Bool)
-> ([(Int, Text)] -> Maybe (Int, Text)) -> [(Int, Text)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Text) -> Bool) -> [(Int, Text)] -> Maybe (Int, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int, Text)
p -> (Int, Text) -> Int
forall a b. (a, b) -> a
fst (Int, Text)
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
execReqHighest) ([(Int, Text)] -> Bool) -> [(Int, Text)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, Text)]
ranMigrations
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isThereHigher (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Detected a migration order mismatch! History contains newer items than in migrations folder!"

      let toRun :: [(Int, Text)]
toRun = ((Int, Text) -> Bool) -> NonEmpty (Int, Text) -> [(Int, Text)]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (\(Int, Text)
t -> Maybe (Int, Text) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Int, Text) -> Bool) -> Maybe (Int, Text) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Int, Text) -> Bool) -> [(Int, Text)] -> Maybe (Int, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Int, Text) -> (Int, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Text)
t) [(Int, Text)]
ranMigrations) NonEmpty (Int, Text)
ordersAndFiles

      case [(Int, Text)] -> Maybe (NonEmpty (Int, Text))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Int, Text)]
toRun of
        Maybe (NonEmpty (Int, Text))
Nothing -> String -> m ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print (String
"All migrations up to date!" :: String)
        Just NonEmpty (Int, Text)
toRun' -> do
          ()
_ <- String -> m ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print (String
"About to run migrations!" :: String)
          ()
_ <- NonEmpty (Int, Text) -> m ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print NonEmpty (Int, Text)
toRun'
          ((Int, Text) -> m ()) -> NonEmpty (Int, Text) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Yggdrasil -> (Int, Text) -> m ()
forall (m :: * -> *). MonadIO m => Yggdrasil -> (Int, Text) -> m ()
runMigration Yggdrasil
yggdrasil) NonEmpty (Int, Text)
toRun'
  where
    handler :: SQLError -> IO [(Int, Text)]
    handler :: SQLError -> IO [(Int, Text)]
handler SQLError
_ = [(Int, Text)] -> IO [(Int, Text)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

getSortedMigrationFiles :: (MonadIO m) => Yggdrasil -> m [(Int, Text)]
getSortedMigrationFiles :: forall (m :: * -> *). MonadIO m => Yggdrasil -> m [(Int, Text)]
getSortedMigrationFiles Yggdrasil
yggdrasil = do
  [String]
files <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
listDirectory (ShowS
forall a. IsString a => String -> a
fromString ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Yggdrasil
yggdrasil Yggdrasil -> Optic' A_Lens NoIx Yggdrasil Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Yggdrasil Text
#migrationsDirectoryPath)
  let rawFs :: [(Text, Text)]
rawFs = (String -> Maybe (Text, Text)) -> [String] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Maybe (Text, Text)
explodeMigrationPath (Text -> Maybe (Text, Text))
-> (String -> Text) -> String -> Maybe (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
files
      rawFilesWithOrder :: [(Int, Text)]
rawFilesWithOrder = ((Text, Text) -> Maybe (Int, Text))
-> [(Text, Text)] -> [(Int, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Maybe Int, Text) -> Maybe (Int, Text)
forall a b. (Maybe a, b) -> Maybe (a, b)
liftTupleMaybeFromFst ((Maybe Int, Text) -> Maybe (Int, Text))
-> ((Text, Text) -> (Maybe Int, Text))
-> (Text, Text)
-> Maybe (Int, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> (Maybe Int, Text)
toIntOrder) [(Text, Text)]
rawFs
      sortedFiles :: [(Int, Text)]
sortedFiles = ((Int, Text) -> Int) -> [(Int, Text)] -> [(Int, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
rawFilesWithOrder
  [(Int, Text)] -> m [(Int, Text)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Int, Text)]
sortedFiles

toIntOrder :: (Text, Text) -> (Maybe Int, Text)
toIntOrder :: (Text, Text) -> (Maybe Int, Text)
toIntOrder = (Text -> Maybe Int) -> (Text, Text) -> (Maybe Int, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

explodeMigrationPath :: Text -> Maybe (Text, Text)
explodeMigrationPath :: Text -> Maybe (Text, Text)
explodeMigrationPath Text
filePath =
  let k :: Maybe Text
k = ((NonEmpty Text -> Text) -> Maybe (NonEmpty Text) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head (Maybe (NonEmpty Text) -> Maybe Text)
-> (Text -> Maybe (NonEmpty Text)) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> (Text -> [Text]) -> Text -> Maybe (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')) Text
filePath
   in (Maybe Text, Text) -> Maybe (Text, Text)
forall a b. (Maybe a, b) -> Maybe (a, b)
liftTupleMaybeFromFst (Maybe Text
k, Text
filePath)

liftTupleMaybeFromFst :: (Maybe a, b) -> Maybe (a, b)
liftTupleMaybeFromFst :: forall a b. (Maybe a, b) -> Maybe (a, b)
liftTupleMaybeFromFst (Maybe a
Nothing, b
_) = Maybe (a, b)
forall a. Maybe a
Nothing
liftTupleMaybeFromFst (Just a
j, b
x) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
j, b
x)

parseTextToSqlStatements :: Text -> [Text]
parseTextToSqlStatements :: Text -> [Text]
parseTextToSqlStatements = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';')

runMigration :: (MonadIO m) => Yggdrasil -> (Int, Text) -> m ()
runMigration :: forall (m :: * -> *). MonadIO m => Yggdrasil -> (Int, Text) -> m ()
runMigration Yggdrasil
yggdrasil (Int
ord', Text
fPath) = do
  ByteString
f <- String -> m ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBS (Text -> String
T.unpack (Yggdrasil
yggdrasil Yggdrasil -> Optic' A_Lens NoIx Yggdrasil Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Yggdrasil Text
#migrationsDirectoryPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fPath))
  let maybeFileContents :: Either UnicodeException Text
maybeFileContents = ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
f
  case Either UnicodeException Text
maybeFileContents of
    Left UnicodeException
e -> UnicodeException -> m ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print UnicodeException
e m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> m ()
forall a t. (HasCallStack, IsText t) => t -> a
error (UnicodeException -> Text
forall b a. (Show a, IsString b) => a -> b
show UnicodeException
e) -- migration errors should be critical
    Right Text
fileContents' -> do
      Connection
conn <- IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ String -> IO Connection
open (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Yggdrasil
yggdrasil Yggdrasil -> Optic' A_Lens NoIx Yggdrasil Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Yggdrasil Text
#databaseFilePath)
      -- run statements from parsed file  in order
      [()]
_ <-
        IO [()] -> m [()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
          (IO [()] -> m [()]) -> IO [()] -> m [()]
forall a b. (a -> b) -> a -> b
$ (Text -> IO ()) -> [Text] -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
            (\Text
qqq -> Connection -> Query -> IO ()
execute_ Connection
conn (String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (Text -> String) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
qqq))
            (Text -> [Text]
parseTextToSqlStatements Text
fileContents')
      -- record in migrations table that we ran migration so as to not run again
      UUID
someUUID <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
      UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      -- TODO: add the Yggdrasil versio number when as library
      ()
_ <- IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> (Text, Int, Text, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn (String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (Text -> String) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
insertYggdrasilMigrationQuery) (String -> Text
T.pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
show (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ UUID
someUUID, Int
ord', Text
fPath, UTCTime
now)
      ()
_ <- IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
close Connection
conn
      () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    insertYggdrasilMigrationQuery :: Text
insertYggdrasilMigrationQuery =
      [trimming|
      INSERT INTO yggdrasil (identifier, order_value, file_name, ran_at) VALUES (?,?,?,?)
      |]

getRanMigrations :: (MonadIO m) => Yggdrasil -> m [(Int, Text)]
getRanMigrations :: forall (m :: * -> *). MonadIO m => Yggdrasil -> m [(Int, Text)]
getRanMigrations Yggdrasil
yggdrasil = do
  Connection
conn <- IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ String -> IO Connection
open (ShowS
forall a. IsString a => String -> a
fromString ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Yggdrasil
yggdrasil Yggdrasil -> Optic' A_Lens NoIx Yggdrasil Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Yggdrasil Text
#databaseFilePath)
  ([RanMigration]
ms :: [RanMigration]) <- IO [RanMigration] -> m [RanMigration]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RanMigration] -> m [RanMigration])
-> IO [RanMigration] -> m [RanMigration]
forall a b. (a -> b) -> a -> b
$ IO [RanMigration]
-> (SQLError -> IO [RanMigration]) -> IO [RanMigration]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Connection -> Query -> IO [RanMigration]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT identifier, order_value, file_name, ran_at from yggdrasil") SQLError -> IO [RanMigration]
handler
  [(Int, Text)] -> m [(Int, Text)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int, Text)] -> m [(Int, Text)])
-> ([RanMigration] -> [(Int, Text)])
-> [RanMigration]
-> m [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Text) -> Int) -> [(Int, Text)] -> [(Int, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Text) -> Int
forall a b. (a, b) -> a
fst ([(Int, Text)] -> [(Int, Text)])
-> ([RanMigration] -> [(Int, Text)])
-> [RanMigration]
-> [(Int, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RanMigration -> (Int, Text)) -> [RanMigration] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map RanMigration -> (Int, Text)
mapRanMigration ([RanMigration] -> m [(Int, Text)])
-> [RanMigration] -> m [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ [RanMigration]
ms
  where
    mapRanMigration :: RanMigration -> (Int, Text)
mapRanMigration (RanMigration Text
_ Int
orderValue Text
fileName UTCTime
_) = (Int
orderValue, Text
fileName)
    handler :: SQLError -> IO [RanMigration]
    handler :: SQLError -> IO [RanMigration]
handler SQLError
_ = [RanMigration] -> IO [RanMigration]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []