mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-12-25 18:13:52 +03:00
Makes DbGenerator responsible for movement of migrations dir (#420)
Closes #105
This commit is contained in:
parent
f463f75ab8
commit
b74eb88ff0
@ -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: " ++))
|
|
||||||
|
@ -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
|
|
||||||
|
@ -78,6 +78,7 @@ library:
|
|||||||
- mtl
|
- mtl
|
||||||
- strong-path
|
- strong-path
|
||||||
- template-haskell
|
- template-haskell
|
||||||
|
- path-io
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
wasp-cli:
|
wasp-cli:
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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}
|
||||||
|
40
waspc/src/Wasp/Generator/FileDraft/CopyDirFileDraft.hs
Normal file
40
waspc/src/Wasp/Generator/FileDraft/CopyDirFileDraft.hs
Normal 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
|
@ -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
|
||||||
|
@ -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 ->
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user