Makes DbGenerator responsible for movement of migrations dir (#420)

Closes #105
This commit is contained in:
Shayne Czyzewski 2022-01-12 11:28:21 -05:00 committed by GitHub
parent f463f75ab8
commit b74eb88ff0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 146 additions and 101 deletions

View File

@ -13,10 +13,6 @@ import Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
waspSaysC, waspSaysC,
) )
import Wasp.Cli.Command.Db.Migrate
( MigrationDirCopyDirection (..),
copyDbMigrationsDir,
)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage) import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage)
import Wasp.Common (WaspProjectDir) import Wasp.Common (WaspProjectDir)
@ -59,5 +55,3 @@ compileIOWithOptions options waspProjectDir outDir = runExceptT $ do
-- TODO: Use throwIO instead of Either to return exceptions? -- TODO: Use throwIO instead of Either to return exceptions?
liftIO (Wasp.Lib.compile waspProjectDir outDir options) liftIO (Wasp.Lib.compile waspProjectDir outDir options)
>>= either throwError return >>= either throwError return
liftIO (copyDbMigrationsDir CopyMigDirDown waspProjectDir outDir)
>>= maybe (return ()) (throwError . ("Copying migration folder failed: " ++))

View File

@ -1,19 +1,13 @@
module Wasp.Cli.Command.Db.Migrate module Wasp.Cli.Command.Db.Migrate
( migrateDev, ( migrateDev,
copyDbMigrationsDir,
MigrationDirCopyDirection (..),
) )
where where
import Control.Monad.Catch (catch)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
-- Wasp generator interface. -- Wasp generator interface.
import qualified Path as P import StrongPath ((</>))
import qualified Path.IO as PathIO
import StrongPath (Abs, Dir, Path', (</>))
import qualified StrongPath.Path as SP.Path
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Command.Common import Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
@ -21,11 +15,12 @@ import Wasp.Cli.Command.Common
) )
import qualified Wasp.Cli.Common as Cli.Common import qualified Wasp.Cli.Common as Cli.Common
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage) import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage)
import Wasp.Common (WaspProjectDir, dbMigrationsDirInWaspProjectDir) import qualified Wasp.Common
import Wasp.Generator.Common (ProjectRootDir)
import Wasp.Generator.DbGenerator (dbMigrationsDirInDbRootDir, dbRootDirInProjectRootDir)
import qualified Wasp.Generator.DbGenerator.Operations as DbOps import qualified Wasp.Generator.DbGenerator.Operations as DbOps
-- | NOTE(shayne): Performs database schema migration (based on current schema) in the generated project.
-- This assumes the wasp project migrations dir was copied from wasp source project by a previous compile.
-- The migrate function takes care of copying migrations from the generated project back to the source code.
migrateDev :: Command () migrateDev :: Command ()
migrateDev = do migrateDev = do
waspProjectDir <- findWaspProjectRootDirFromCwd waspProjectDir <- findWaspProjectRootDirFromCwd
@ -34,69 +29,13 @@ migrateDev = do
</> Cli.Common.dotWaspDirInWaspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
</> Cli.Common.generatedCodeDirInDotWaspDir </> Cli.Common.generatedCodeDirInDotWaspDir
-- TODO(matija): It might make sense that this (copying migrations folder from source to let waspDbMigrationsDir =
-- the generated proejct) is responsibility of the generator. Since migrations can also be waspProjectDir
-- considered part of a "source" code, then generator could take care of it and this command </> Wasp.Common.dbMigrationsDirInWaspProjectDir
-- wouldn't have to deal with it. We opened an issue on Github about this.
--
-- NOTE(matija): we need to copy migrations down before running "migrate dev" to make sure
-- all the latest migrations are in the generated project (e.g. Wasp dev checked out something
-- new) - otherwise "dev" would create a new migration for that and we would end up with two
-- migrations doing the same thing (which might result in conflict, e.g. during db creation).
waspSaysC $ asWaspStartMessage "Copying migrations folder from Wasp to Prisma project..."
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirDown
waspSaysC $ asWaspStartMessage "Performing migration..." waspSaysC $ asWaspStartMessage "Performing migration..."
migrateResult <- liftIO $ DbOps.migrateDev genProjectRootDir migrateResult <- liftIO $ DbOps.migrateDevAndCopyToSource waspDbMigrationsDir genProjectRootDir
case migrateResult of case migrateResult of
Left migrateError -> Left migrateError ->
throwError $ CommandError $ asWaspFailureMessage "Migrate dev failed:" ++ migrateError throwError $ CommandError $ asWaspFailureMessage "Migrate dev failed:" ++ migrateError
Right () -> waspSaysC $ asWaspSuccessMessage "Migration done." Right () -> waspSaysC $ asWaspSuccessMessage "Migration done."
waspSaysC $ asWaspStartMessage "Copying migrations folder from Prisma to Wasp project..."
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirUp
waspSaysC $ asWaspSuccessMessage "All done!"
where
copyDbMigrationDir waspProjectDir genProjectRootDir copyDirection = do
copyDbMigDirResult <-
liftIO $ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir
case copyDbMigDirResult of
Nothing -> waspSaysC $ asWaspSuccessMessage "Done copying migrations folder."
Just err -> throwError $ CommandError $ asWaspFailureMessage "Copying migration folder failed:" ++ err
data MigrationDirCopyDirection = CopyMigDirUp | CopyMigDirDown deriving (Eq)
-- | Copy migrations directory between Wasp source and the generated project.
copyDbMigrationsDir ::
-- | Copy direction (source -> gen or gen-> source)
MigrationDirCopyDirection ->
Path' Abs (Dir WaspProjectDir) ->
Path' Abs (Dir ProjectRootDir) ->
IO (Maybe String)
copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir = do
-- Migration folder in Wasp source (seen by Wasp dev and versioned).
let dbMigrationsDirInWaspProjectDirAbsPath = waspProjectDir </> dbMigrationsDirInWaspProjectDir
-- Migration folder in the generated code.
let dbMigrationsDirInGenProjectDirAbsPath =
genProjectRootDir </> dbRootDirInProjectRootDir
</> dbMigrationsDirInDbRootDir
let srcPathAbsDir =
if copyDirection == CopyMigDirUp
then SP.Path.toPathAbsDir dbMigrationsDirInGenProjectDirAbsPath
else SP.Path.toPathAbsDir dbMigrationsDirInWaspProjectDirAbsPath
let targetPathAbsDir =
if copyDirection == CopyMigDirUp
then SP.Path.toPathAbsDir dbMigrationsDirInWaspProjectDirAbsPath
else SP.Path.toPathAbsDir dbMigrationsDirInGenProjectDirAbsPath
doesSrcDirExist <- PathIO.doesDirExist srcPathAbsDir
if doesSrcDirExist
then
PathIO.copyDirRecur srcPathAbsDir targetPathAbsDir >> return Nothing
`catch` (\e -> return $ Just $ show (e :: P.PathException))
`catch` (\e -> return $ Just $ show (e :: IOError))
else return Nothing

View File

@ -78,6 +78,7 @@ library:
- mtl - mtl
- strong-path - strong-path
- template-haskell - template-haskell
- path-io
executables: executables:
wasp-cli: wasp-cli:

View File

@ -9,13 +9,14 @@ where
import Control.Monad (when) import Control.Monad (when)
import Data.Aeson (object, (.=)) import Data.Aeson (object, (.=))
import Data.Maybe (isNothing) import Data.Maybe (isNothing, maybeToList)
import StrongPath (Abs, Dir, File', Path', Rel, reldir, relfile, (</>)) import StrongPath (Abs, Dir, File', Path', Rel, reldir, relfile, (</>))
import qualified StrongPath as SP import qualified StrongPath as SP
import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
import Wasp.Common (DbMigrationsDir)
import Wasp.CompileOptions (CompileOptions) import Wasp.CompileOptions (CompileOptions)
import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.Common (ProjectRootDir)
import Wasp.Generator.FileDraft (FileDraft, createTemplateFileDraft) import Wasp.Generator.FileDraft (FileDraft, createCopyDirFileDraft, createTemplateFileDraft)
import Wasp.Generator.Templates (TemplatesDir) import Wasp.Generator.Templates (TemplatesDir)
import qualified Wasp.Psl.Ast.Model as Psl.Ast.Model import qualified Wasp.Psl.Ast.Model as Psl.Ast.Model
import qualified Wasp.Psl.Generator.Model as Psl.Generator.Model import qualified Wasp.Psl.Generator.Model as Psl.Generator.Model
@ -25,14 +26,10 @@ import qualified Wasp.Wasp.Db as Wasp.Db
import Wasp.Wasp.Entity (Entity) import Wasp.Wasp.Entity (Entity)
import qualified Wasp.Wasp.Entity as Wasp.Entity import qualified Wasp.Wasp.Entity as Wasp.Entity
-- * Path definitions
data DbRootDir data DbRootDir
data DbTemplatesDir data DbTemplatesDir
data DbMigrationsDir
dbRootDirInProjectRootDir :: Path' (Rel ProjectRootDir) (Dir DbRootDir) dbRootDirInProjectRootDir :: Path' (Rel ProjectRootDir) (Dir DbRootDir)
dbRootDirInProjectRootDir = [reldir|db|] dbRootDirInProjectRootDir = [reldir|db|]
@ -53,13 +50,6 @@ dbSchemaFileInProjectRootDir = dbRootDirInProjectRootDir </> dbSchemaFileInDbRoo
dbMigrationsDirInDbRootDir :: Path' (Rel DbRootDir) (Dir DbMigrationsDir) dbMigrationsDirInDbRootDir :: Path' (Rel DbRootDir) (Dir DbMigrationsDir)
dbMigrationsDirInDbRootDir = [reldir|migrations|] dbMigrationsDirInDbRootDir = [reldir|migrations|]
-- * Db generator
genDb :: Wasp -> CompileOptions -> [FileDraft]
genDb wasp _ =
[ genPrismaSchema wasp
]
preCleanup :: Wasp -> Path' Abs (Dir ProjectRootDir) -> CompileOptions -> IO () preCleanup :: Wasp -> Path' Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
preCleanup wasp projectRootDir _ = do preCleanup wasp projectRootDir _ = do
deleteGeneratedMigrationsDirIfRedundant wasp projectRootDir deleteGeneratedMigrationsDirIfRedundant wasp projectRootDir
@ -76,6 +66,10 @@ deleteGeneratedMigrationsDirIfRedundant wasp projectRootDir = do
where where
projectMigrationsDirAbsFilePath = SP.fromAbsDir $ projectRootDir </> dbRootDirInProjectRootDir </> dbMigrationsDirInDbRootDir projectMigrationsDirAbsFilePath = SP.fromAbsDir $ projectRootDir </> dbRootDirInProjectRootDir </> dbMigrationsDirInDbRootDir
genDb :: Wasp -> CompileOptions -> [FileDraft]
genDb wasp _ =
genPrismaSchema wasp : maybeToList (genMigrationsDir wasp)
genPrismaSchema :: Wasp -> FileDraft genPrismaSchema :: Wasp -> FileDraft
genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templateData) genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templateData)
where where
@ -102,3 +96,10 @@ genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templat
entityToPslModelSchema entity = entityToPslModelSchema entity =
Psl.Generator.Model.generateModel $ Psl.Generator.Model.generateModel $
Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody entity) Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody entity)
genMigrationsDir :: Wasp -> Maybe FileDraft
genMigrationsDir wasp =
(getMigrationsDir wasp) >>= \waspMigrationsDir ->
Just $ createCopyDirFileDraft (SP.castDir genProjectMigrationsDir) (SP.castDir waspMigrationsDir)
where
genProjectMigrationsDir = dbRootDirInProjectRootDir </> dbMigrationsDirInDbRootDir

View File

@ -1,14 +1,22 @@
module Wasp.Generator.DbGenerator.Operations module Wasp.Generator.DbGenerator.Operations
( migrateDev, ( migrateDevAndCopyToSource,
) )
where where
import Control.Concurrent (Chan, newChan, readChan) import Control.Concurrent (Chan, newChan, readChan)
import Control.Concurrent.Async (concurrently) import Control.Concurrent.Async (concurrently)
import Control.Monad.Catch (catch)
import qualified Path as P
import StrongPath (Abs, Dir, Path') import StrongPath (Abs, Dir, Path')
import qualified StrongPath as SP
import System.Exit (ExitCode (..)) import System.Exit (ExitCode (..))
import Wasp.Common (DbMigrationsDir)
import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.Common (ProjectRootDir)
import Wasp.Generator.DbGenerator (dbMigrationsDirInDbRootDir, dbRootDirInProjectRootDir)
import qualified Wasp.Generator.DbGenerator.Jobs as DbJobs import qualified Wasp.Generator.DbGenerator.Jobs as DbJobs
import Wasp.Generator.FileDraft.WriteableMonad
( WriteableMonad (copyDirectoryRecursive),
)
import Wasp.Generator.Job (JobMessage) import Wasp.Generator.Job (JobMessage)
import qualified Wasp.Generator.Job as J import qualified Wasp.Generator.Job as J
import Wasp.Generator.Job.IO (printJobMessage) import Wasp.Generator.Job.IO (printJobMessage)
@ -20,13 +28,26 @@ printJobMsgsUntilExitReceived chan = do
J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan
J.JobExit {} -> return () J.JobExit {} -> return ()
migrateDev :: Path' Abs (Dir ProjectRootDir) -> IO (Either String ()) -- | Migrates in the generated project context and then copies the migrations dir back
migrateDev projectDir = do -- up to the wasp project dir to ensure they remain in sync.
migrateDevAndCopyToSource :: Path' Abs (Dir DbMigrationsDir) -> Path' Abs (Dir ProjectRootDir) -> IO (Either String ())
migrateDevAndCopyToSource dbMigrationsDirInWaspProjectDirAbs genProjectRootDirAbs = do
chan <- newChan chan <- newChan
(_, dbExitCode) <- (_, dbExitCode) <-
concurrently concurrently
(printJobMsgsUntilExitReceived chan) (printJobMsgsUntilExitReceived chan)
(DbJobs.migrateDev projectDir chan) (DbJobs.migrateDev genProjectRootDirAbs chan)
case dbExitCode of case dbExitCode of
ExitSuccess -> return (Right ()) ExitSuccess -> copyMigrationsBackToSource genProjectRootDirAbs dbMigrationsDirInWaspProjectDirAbs
ExitFailure code -> return $ Left $ "Migrate (dev) failed with exit code: " ++ show code ExitFailure code -> return $ Left $ "Migrate (dev) failed with exit code: " ++ show code
-- | Copies the DB migrations from the generated project dir back up to theh wasp project dir
copyMigrationsBackToSource :: Path' Abs (Dir ProjectRootDir) -> Path' Abs (Dir DbMigrationsDir) -> IO (Either String ())
copyMigrationsBackToSource genProjectRootDirAbs dbMigrationsDirInWaspProjectDirAbs =
do
copyDirectoryRecursive genProjectMigrationsDir waspMigrationsDir >> return (Right ())
`catch` (\e -> return $ Left $ show (e :: P.PathException))
`catch` (\e -> return $ Left $ show (e :: IOError))
where
waspMigrationsDir = SP.castDir dbMigrationsDirInWaspProjectDirAbs
genProjectMigrationsDir = SP.castDir $ genProjectRootDirAbs SP.</> dbRootDirInProjectRootDir SP.</> dbMigrationsDirInDbRootDir

View File

@ -5,13 +5,15 @@ module Wasp.Generator.FileDraft
createCopyFileDraft, createCopyFileDraft,
createCopyFileDraftIfExists, createCopyFileDraftIfExists,
createTextFileDraft, createTextFileDraft,
createCopyDirFileDraft,
) )
where where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Text (Text) import Data.Text (Text)
import StrongPath (Abs, File', Path', Rel) import StrongPath (Abs, Dir', File', Path', Rel)
import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.Common (ProjectRootDir)
import qualified Wasp.Generator.FileDraft.CopyDirFileDraft as CopyDirFD
import qualified Wasp.Generator.FileDraft.CopyFileDraft as CopyFD import qualified Wasp.Generator.FileDraft.CopyFileDraft as CopyFD
import qualified Wasp.Generator.FileDraft.TemplateFileDraft as TmplFD import qualified Wasp.Generator.FileDraft.TemplateFileDraft as TmplFD
import qualified Wasp.Generator.FileDraft.TextFileDraft as TextFD import qualified Wasp.Generator.FileDraft.TextFileDraft as TextFD
@ -21,15 +23,21 @@ import Wasp.Generator.Templates (TemplatesDir)
-- | FileDraft unites different file draft types into a single type, -- | FileDraft unites different file draft types into a single type,
-- so that in the rest of the system they can be passed around as heterogeneous -- so that in the rest of the system they can be passed around as heterogeneous
-- collection when needed. -- collection when needed.
--
-- TODO: revisit the quick and dirty Linux interpretation of "everything is a file"
-- and treating a directory (`CopyDirFileDraft`) as a `FileDraft`. As is, this may be
-- a source of potential confusion and possibly tech debt to resolve later.
data FileDraft data FileDraft
= FileDraftTemplateFd TmplFD.TemplateFileDraft = FileDraftTemplateFd TmplFD.TemplateFileDraft
| FileDraftCopyFd CopyFD.CopyFileDraft | FileDraftCopyFd CopyFD.CopyFileDraft
| FileDraftCopyDirFd CopyDirFD.CopyDirFileDraft
| FileDraftTextFd TextFD.TextFileDraft | FileDraftTextFd TextFD.TextFileDraft
deriving (Show, Eq) deriving (Show, Eq)
instance Writeable FileDraft where instance Writeable FileDraft where
write dstDir (FileDraftTemplateFd draft) = write dstDir draft write dstDir (FileDraftTemplateFd draft) = write dstDir draft
write dstDir (FileDraftCopyFd draft) = write dstDir draft write dstDir (FileDraftCopyFd draft) = write dstDir draft
write dstDir (FileDraftCopyDirFd draft) = write dstDir draft
write dstDir (FileDraftTextFd draft) = write dstDir draft write dstDir (FileDraftTextFd draft) = write dstDir draft
createTemplateFileDraft :: createTemplateFileDraft ::
@ -63,6 +71,14 @@ createCopyFileDraftIfExists dstPath srcPath =
CopyFD._failIfSrcDoesNotExist = False CopyFD._failIfSrcDoesNotExist = False
} }
createCopyDirFileDraft :: Path' (Rel ProjectRootDir) Dir' -> Path' Abs Dir' -> FileDraft
createCopyDirFileDraft dstPath srcPath =
FileDraftCopyDirFd $
CopyDirFD.CopyDirFileDraft
{ CopyDirFD._dstPath = dstPath,
CopyDirFD._srcPath = srcPath
}
createTextFileDraft :: Path' (Rel ProjectRootDir) File' -> Text -> FileDraft createTextFileDraft :: Path' (Rel ProjectRootDir) File' -> Text -> FileDraft
createTextFileDraft dstPath content = createTextFileDraft dstPath content =
FileDraftTextFd $ TextFD.TextFileDraft {TextFD._dstPath = dstPath, TextFD._content = content} FileDraftTextFd $ TextFD.TextFileDraft {TextFD._dstPath = dstPath, TextFD._content = content}

View File

@ -0,0 +1,40 @@
module Wasp.Generator.FileDraft.CopyDirFileDraft
( CopyDirFileDraft (..),
)
where
import Control.Monad (when)
import StrongPath
( Abs,
Dir',
Path',
Rel,
(</>),
)
import qualified StrongPath as SP
import Wasp.Generator.Common (ProjectRootDir)
import Wasp.Generator.FileDraft.Writeable
import Wasp.Generator.FileDraft.WriteableMonad (WriteableMonad (copyDirectoryRecursive, createDirectoryIfMissing), doesDirectoryExist)
-- | File draft based on another dir that is to be recursively copied.
--
-- TODO: revisit the quick and dirty Linux interpretation of "everything is a file"
-- and treating a directory (`CopyDirFileDraft`) as a `FileDraft`. As is, this may be
-- a source of potential confusion and possibly tech debt to resolve later.
data CopyDirFileDraft = CopyDirFileDraft
{ -- | Path where the dir will be copied to.
_dstPath :: !(Path' (Rel ProjectRootDir) Dir'),
-- | Absolute path of source dir to copy.
_srcPath :: !(Path' Abs Dir')
}
deriving (Show, Eq)
instance Writeable CopyDirFileDraft where
write projectRootAbsPath draft = do
srcDirExists <- doesDirectoryExist $ SP.fromAbsDir srcPathAbsDir
when srcDirExists $ do
createDirectoryIfMissing True (SP.fromAbsDir dstPathAbsDir)
copyDirectoryRecursive srcPathAbsDir dstPathAbsDir
where
srcPathAbsDir = _srcPath draft
dstPathAbsDir = projectRootAbsPath </> _dstPath draft

View File

@ -7,7 +7,9 @@ import Control.Monad.IO.Class (MonadIO)
import Data.Aeson as Aeson import Data.Aeson as Aeson
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.IO import qualified Data.Text.IO
import StrongPath (Abs, Dir, File', Path', Rel) import qualified Path.IO as PathIO
import StrongPath (Abs, Dir, Dir', File', Path', Rel)
import qualified StrongPath.Path as SP.Path
import qualified System.Directory import qualified System.Directory
import System.IO.Error (isDoesNotExistError) import System.IO.Error (isDoesNotExistError)
import UnliftIO.Exception (Exception, catch) import UnliftIO.Exception (Exception, catch)
@ -33,8 +35,19 @@ class (MonadIO m) => WriteableMonad m where
FilePath -> FilePath ->
m () m ()
-- | Copies a directory recursively.
-- It does not follow symbolic links and preserves permissions when possible.
copyDirectoryRecursive ::
-- | Src path.
Path' Abs Dir' ->
-- | Dst path.
Path' Abs Dir' ->
m ()
doesFileExist :: FilePath -> m Bool doesFileExist :: FilePath -> m Bool
doesDirectoryExist :: FilePath -> m Bool
writeFileFromText :: FilePath -> Text -> m () writeFileFromText :: FilePath -> Text -> m ()
getTemplateFileAbsPath :: getTemplateFileAbsPath ::
@ -69,7 +82,11 @@ instance WriteableMonad IO where
else throwIO e else throwIO e
) )
copyDirectoryRecursive src dst = do
PathIO.copyDirRecur (SP.Path.toPathAbsDir src) (SP.Path.toPathAbsDir dst)
doesFileExist = System.Directory.doesFileExist doesFileExist = System.Directory.doesFileExist
doesDirectoryExist = System.Directory.doesDirectoryExist
writeFileFromText = Data.Text.IO.writeFile writeFileFromText = Data.Text.IO.writeFile
getTemplateFileAbsPath = Templates.getTemplateFileAbsPath getTemplateFileAbsPath = Templates.getTemplateFileAbsPath
getTemplatesDirAbsPath = Templates.getTemplatesDirAbsPath getTemplatesDirAbsPath = Templates.getTemplatesDirAbsPath

View File

@ -15,7 +15,7 @@ import qualified Data.Aeson as Aeson
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Fixtures (systemSPRoot) import Fixtures (systemSPRoot)
import StrongPath (Abs, Dir, File', Path', Rel, reldir, (</>)) import StrongPath (Abs, Dir, Dir', File', Path', Rel, reldir, (</>))
import Wasp.Generator.FileDraft.WriteableMonad import Wasp.Generator.FileDraft.WriteableMonad
import Wasp.Generator.Templates (TemplatesDir) import Wasp.Generator.Templates (TemplatesDir)
@ -29,13 +29,14 @@ defaultMockConfig =
{ getTemplatesDirAbsPath_impl = systemSPRoot </> [reldir|mock/templates/dir|], { getTemplatesDirAbsPath_impl = systemSPRoot </> [reldir|mock/templates/dir|],
getTemplateFileAbsPath_impl = \path -> systemSPRoot </> [reldir|mock/templates/dir|] </> path, getTemplateFileAbsPath_impl = \path -> systemSPRoot </> [reldir|mock/templates/dir|] </> path,
compileAndRenderTemplate_impl = \_ _ -> pack "Mock template content", compileAndRenderTemplate_impl = \_ _ -> pack "Mock template content",
doesFileExist_impl = const True doesFileExist_impl = const True,
doesDirectoryExist_impl = const True
} }
getMockLogs :: MockWriteableMonad a -> MockWriteableMonadConfig -> MockWriteableMonadLogs getMockLogs :: MockWriteableMonad a -> MockWriteableMonadConfig -> MockWriteableMonadLogs
getMockLogs mock config = fst $ execState (unMockWriteableMonad mock) (emptyLogs, config) getMockLogs mock config = fst $ execState (unMockWriteableMonad mock) (emptyLogs, config)
where where
emptyLogs = MockWriteableMonadLogs [] [] [] [] [] [] emptyLogs = MockWriteableMonadLogs [] [] [] [] [] [] []
instance WriteableMonad MockWriteableMonad where instance WriteableMonad MockWriteableMonad where
writeFileFromText dstPath text = MockWriteableMonad $ do writeFileFromText dstPath text = MockWriteableMonad $ do
@ -66,6 +67,13 @@ instance WriteableMonad MockWriteableMonad where
(_, config) <- get (_, config) <- get
return $ doesFileExist_impl config path return $ doesFileExist_impl config path
doesDirectoryExist path = MockWriteableMonad $ do
(_, config) <- get
return $ doesDirectoryExist_impl config path
copyDirectoryRecursive srcPath dstPath = MockWriteableMonad $ do
modifyLogs (copyDirectoryRecursive_addCall srcPath dstPath)
throwIO = throwIO throwIO = throwIO
instance MonadIO MockWriteableMonad where instance MonadIO MockWriteableMonad where
@ -85,14 +93,16 @@ data MockWriteableMonadLogs = MockWriteableMonadLogs
createDirectoryIfMissing_calls :: [(Bool, FilePath)], createDirectoryIfMissing_calls :: [(Bool, FilePath)],
copyFile_calls :: [(FilePath, FilePath)], copyFile_calls :: [(FilePath, FilePath)],
getTemplateFileAbsPath_calls :: [Path' (Rel TemplatesDir) File'], getTemplateFileAbsPath_calls :: [Path' (Rel TemplatesDir) File'],
compileAndRenderTemplate_calls :: [(Path' (Rel TemplatesDir) File', Aeson.Value)] compileAndRenderTemplate_calls :: [(Path' (Rel TemplatesDir) File', Aeson.Value)],
copyDirectoryRecursive_calls :: [(Path' Abs Dir', Path' Abs Dir')]
} }
data MockWriteableMonadConfig = MockWriteableMonadConfig data MockWriteableMonadConfig = MockWriteableMonadConfig
{ getTemplatesDirAbsPath_impl :: Path' Abs (Dir TemplatesDir), { getTemplatesDirAbsPath_impl :: Path' Abs (Dir TemplatesDir),
getTemplateFileAbsPath_impl :: Path' (Rel TemplatesDir) File' -> Path' Abs File', getTemplateFileAbsPath_impl :: Path' (Rel TemplatesDir) File' -> Path' Abs File',
compileAndRenderTemplate_impl :: Path' (Rel TemplatesDir) File' -> Aeson.Value -> Text, compileAndRenderTemplate_impl :: Path' (Rel TemplatesDir) File' -> Aeson.Value -> Text,
doesFileExist_impl :: FilePath -> Bool doesFileExist_impl :: FilePath -> Bool,
doesDirectoryExist_impl :: FilePath -> Bool
} }
writeFileFromText_addCall :: FilePath -> Text -> MockWriteableMonadLogs -> MockWriteableMonadLogs writeFileFromText_addCall :: FilePath -> Text -> MockWriteableMonadLogs -> MockWriteableMonadLogs
@ -118,6 +128,10 @@ createDirectoryIfMissing_addCall createParents path logs =
(createParents, path) : createDirectoryIfMissing_calls logs (createParents, path) : createDirectoryIfMissing_calls logs
} }
copyDirectoryRecursive_addCall :: Path' Abs Dir' -> Path' Abs Dir' -> MockWriteableMonadLogs -> MockWriteableMonadLogs
copyDirectoryRecursive_addCall srcPath dstPath logs =
logs {copyDirectoryRecursive_calls = (srcPath, dstPath) : copyDirectoryRecursive_calls logs}
compileAndRenderTemplate_addCall :: compileAndRenderTemplate_addCall ::
Path' (Rel TemplatesDir) File' -> Path' (Rel TemplatesDir) File' ->
Aeson.Value -> Aeson.Value ->

View File

@ -6,6 +6,7 @@ import System.FilePath ((</>))
import Test.Tasty.Hspec import Test.Tasty.Hspec
import qualified Wasp.CompileOptions as CompileOptions import qualified Wasp.CompileOptions as CompileOptions
import Wasp.Generator.FileDraft import Wasp.Generator.FileDraft
import qualified Wasp.Generator.FileDraft.CopyDirFileDraft as CopyDirFD
import qualified Wasp.Generator.FileDraft.CopyFileDraft as CopyFD import qualified Wasp.Generator.FileDraft.CopyFileDraft as CopyFD
import qualified Wasp.Generator.FileDraft.TemplateFileDraft as TmplFD import qualified Wasp.Generator.FileDraft.TemplateFileDraft as TmplFD
import qualified Wasp.Generator.FileDraft.TextFileDraft as TextFD import qualified Wasp.Generator.FileDraft.TextFileDraft as TextFD
@ -73,4 +74,5 @@ existsFdWithDst fds dstPath = any ((== dstPath) . getFileDraftDstPath) fds
getFileDraftDstPath :: FileDraft -> FilePath getFileDraftDstPath :: FileDraft -> FilePath
getFileDraftDstPath (FileDraftTemplateFd fd) = SP.toFilePath $ TmplFD._dstPath fd getFileDraftDstPath (FileDraftTemplateFd fd) = SP.toFilePath $ TmplFD._dstPath fd
getFileDraftDstPath (FileDraftCopyFd fd) = SP.toFilePath $ CopyFD._dstPath fd getFileDraftDstPath (FileDraftCopyFd fd) = SP.toFilePath $ CopyFD._dstPath fd
getFileDraftDstPath (FileDraftCopyDirFd fd) = SP.toFilePath $ CopyDirFD._dstPath fd
getFileDraftDstPath (FileDraftTextFd fd) = SP.toFilePath $ TextFD._dstPath fd getFileDraftDstPath (FileDraftTextFd fd) = SP.toFilePath $ TextFD._dstPath fd