mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-08-17 11:10:37 +03:00
Formatted whole codebase with ormolu.
This commit is contained in:
parent
369ab16586
commit
1219a57bc9
@ -1,2 +1,3 @@
|
||||
import Distribution.Simple
|
||||
|
||||
main = defaultMain
|
||||
|
@ -1,28 +1,27 @@
|
||||
module Cli.Common
|
||||
( WaspProjectDir
|
||||
, DotWaspDir
|
||||
, CliTemplatesDir
|
||||
, dotWaspDirInWaspProjectDir
|
||||
, dotWaspRootFileInWaspProjectDir
|
||||
, extCodeDirInWaspProjectDir
|
||||
, generatedCodeDirInDotWaspDir
|
||||
, buildDirInDotWaspDir
|
||||
, waspSays
|
||||
) where
|
||||
( WaspProjectDir,
|
||||
DotWaspDir,
|
||||
CliTemplatesDir,
|
||||
dotWaspDirInWaspProjectDir,
|
||||
dotWaspRootFileInWaspProjectDir,
|
||||
extCodeDirInWaspProjectDir,
|
||||
generatedCodeDirInDotWaspDir,
|
||||
buildDirInDotWaspDir,
|
||||
waspSays,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
|
||||
import Common (WaspProjectDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import Common (WaspProjectDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import qualified Generator.Common
|
||||
import StrongPath (Dir, File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
data DotWaspDir -- Here we put everything that wasp generates.
|
||||
data CliTemplatesDir
|
||||
|
||||
data CliTemplatesDir
|
||||
|
||||
-- TODO: SHould this be renamed to include word "root"?
|
||||
dotWaspDirInWaspProjectDir :: Path (Rel WaspProjectDir) (Dir DotWaspDir)
|
||||
|
@ -1,24 +1,25 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Command
|
||||
( Command
|
||||
, runCommand
|
||||
, CommandError(..)
|
||||
) where
|
||||
( Command,
|
||||
runCommand,
|
||||
CommandError (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
|
||||
|
||||
newtype Command a = Command { _runCommand :: ExceptT CommandError IO a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
|
||||
newtype Command a = Command {_runCommand :: ExceptT CommandError IO a}
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
|
||||
|
||||
runCommand :: Command a -> IO ()
|
||||
runCommand cmd = do
|
||||
errorOrResult <- runExceptT $ _runCommand cmd
|
||||
case errorOrResult of
|
||||
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
||||
Right _ -> return ()
|
||||
errorOrResult <- runExceptT $ _runCommand cmd
|
||||
case errorOrResult of
|
||||
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
||||
Right _ -> return ()
|
||||
|
||||
-- TODO: What if we want to recognize errors in order to handle them?
|
||||
-- Should we add _commandErrorType? Should CommandError be parametrized by it, is that even possible?
|
||||
data CommandError = CommandError { _errorMsg :: !String }
|
||||
data CommandError = CommandError {_errorMsg :: !String}
|
||||
|
@ -1,38 +1,43 @@
|
||||
module Command.Build
|
||||
( build
|
||||
) where
|
||||
( build,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (alphaWarningMessage,
|
||||
findWaspProjectRootDirFromCwd)
|
||||
import Command.Compile (compileIOWithOptions)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common
|
||||
( alphaWarningMessage,
|
||||
findWaspProjectRootDirFromCwd,
|
||||
)
|
||||
import Command.Compile (compileIOWithOptions)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
build :: Command ()
|
||||
build = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.buildDirInDotWaspDir
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir =
|
||||
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.buildDirInDotWaspDir
|
||||
|
||||
liftIO $ putStrLn "Building wasp project..."
|
||||
buildResult <- liftIO $ buildIO waspProjectDir outDir
|
||||
case buildResult of
|
||||
Left compileError -> throwError $ CommandError $ "Build failed: " ++ compileError
|
||||
Right () -> liftIO $ putStrLn "Code has been successfully built! Check it out in .wasp/build directory.\n"
|
||||
liftIO $ putStrLn alphaWarningMessage
|
||||
liftIO $ putStrLn "Building wasp project..."
|
||||
buildResult <- liftIO $ buildIO waspProjectDir outDir
|
||||
case buildResult of
|
||||
Left compileError -> throwError $ CommandError $ "Build failed: " ++ compileError
|
||||
Right () -> liftIO $ putStrLn "Code has been successfully built! Check it out in .wasp/build directory.\n"
|
||||
liftIO $ putStrLn alphaWarningMessage
|
||||
|
||||
buildIO :: Path Abs (Dir Common.WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
buildIO ::
|
||||
Path Abs (Dir Common.WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
buildIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||
where
|
||||
options = CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir
|
||||
, isBuild = True
|
||||
}
|
||||
where
|
||||
options =
|
||||
CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir,
|
||||
isBuild = True
|
||||
}
|
||||
|
@ -1,11 +1,12 @@
|
||||
module Command.Call where
|
||||
|
||||
data Call = New String -- project name
|
||||
| Start
|
||||
| Clean
|
||||
| Compile
|
||||
| Db [String] -- db args
|
||||
| Build
|
||||
| Version
|
||||
| Telemetry
|
||||
| Unknown [String] -- all args
|
||||
data Call
|
||||
= New String -- project name
|
||||
| Start
|
||||
| Clean
|
||||
| Compile
|
||||
| Db [String] -- db args
|
||||
| Build
|
||||
| Version
|
||||
| Telemetry
|
||||
| Unknown [String] -- all args
|
||||
|
@ -1,25 +1,27 @@
|
||||
module Command.Clean
|
||||
( clean
|
||||
) where
|
||||
( clean,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.Directory (doesDirectoryExist,
|
||||
removeDirectoryRecursive)
|
||||
import System.IO (hFlush, stdout)
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import qualified StrongPath as SP
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory
|
||||
( doesDirectoryExist,
|
||||
removeDirectoryRecursive,
|
||||
)
|
||||
import System.IO (hFlush, stdout)
|
||||
|
||||
clean :: Command ()
|
||||
clean = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir
|
||||
liftIO $ putStrLn "Deleting .wasp/ directory..." >> hFlush stdout
|
||||
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
|
||||
if doesDotWaspDirExist
|
||||
then liftIO $ do removeDirectoryRecursive dotWaspDirFp
|
||||
putStrLn "Deleted .wasp/ directory."
|
||||
else liftIO $ putStrLn "Nothing to delete: .wasp directory does not exist."
|
||||
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir
|
||||
liftIO $ putStrLn "Deleting .wasp/ directory..." >> hFlush stdout
|
||||
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
|
||||
if doesDotWaspDirExist
|
||||
then liftIO $ do
|
||||
removeDirectoryRecursive dotWaspDirFp
|
||||
putStrLn "Deleted .wasp/ directory."
|
||||
else liftIO $ putStrLn "Nothing to delete: .wasp directory does not exist."
|
||||
|
@ -1,55 +1,62 @@
|
||||
module Command.Compile
|
||||
( compileIO
|
||||
, compile
|
||||
, compileIOWithOptions
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (runExceptT, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
( compileIO,
|
||||
compile,
|
||||
compileIOWithOptions,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Command.Db.Migrate (MigrationDirCopyDirection (..),
|
||||
copyDbMigrationsDir)
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Command.Db.Migrate
|
||||
( MigrationDirCopyDirection (..),
|
||||
copyDbMigrationsDir,
|
||||
)
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import Control.Monad.Except (runExceptT, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
compile :: Command ()
|
||||
compile = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir =
|
||||
waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
waspSaysC "Compiling wasp code..."
|
||||
compilationResult <- liftIO $ compileIO waspProjectDir outDir
|
||||
case compilationResult of
|
||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
||||
waspSaysC "Compiling wasp code..."
|
||||
compilationResult <- liftIO $ compileIO waspProjectDir outDir
|
||||
case compilationResult of
|
||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
||||
|
||||
-- | Compiles Wasp source code in waspProjectDir directory and generates a project
|
||||
-- in given outDir directory.
|
||||
compileIO :: Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
compileIO ::
|
||||
Path Abs (Dir WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
compileIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||
where
|
||||
options = CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir
|
||||
, isBuild = False
|
||||
options =
|
||||
CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir,
|
||||
isBuild = False
|
||||
}
|
||||
|
||||
compileIOWithOptions :: CompileOptions
|
||||
-> Path Abs (Dir Cli.Common.WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
compileIOWithOptions ::
|
||||
CompileOptions ->
|
||||
Path Abs (Dir Cli.Common.WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
compileIOWithOptions options waspProjectDir outDir = runExceptT $ do
|
||||
-- TODO: Use throwIO instead of Either to return exceptions?
|
||||
liftIO (Lib.compile waspProjectDir outDir options)
|
||||
>>= either throwError return
|
||||
liftIO (copyDbMigrationsDir CopyMigDirDown waspProjectDir outDir)
|
||||
>>= maybe (return ()) (throwError . ("Copying migration folder failed: " ++))
|
||||
-- TODO: Use throwIO instead of Either to return exceptions?
|
||||
liftIO (Lib.compile waspProjectDir outDir options)
|
||||
>>= either throwError return
|
||||
liftIO (copyDbMigrationsDir CopyMigDirDown waspProjectDir outDir)
|
||||
>>= maybe (return ()) (throwError . ("Copying migration folder failed: " ++))
|
||||
|
@ -1,22 +1,22 @@
|
||||
module Command.Db
|
||||
( runDbCommand
|
||||
, studio
|
||||
) where
|
||||
( runDbCommand,
|
||||
studio,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..), runCommand)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd, waspSaysC)
|
||||
import Command.Compile (compile)
|
||||
import Control.Concurrent (newChan)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import Control.Monad.Except (throwError)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import StrongPath ((</>))
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Generator.DbGenerator.Jobs (runStudio)
|
||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||
import Command (Command, CommandError(..), runCommand)
|
||||
import Command.Compile (compile)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd, waspSaysC)
|
||||
import qualified Cli.Common as Common
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import StrongPath ((</>))
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
runDbCommand :: Command a -> IO ()
|
||||
runDbCommand = runCommand . makeDbCommand
|
||||
@ -27,38 +27,40 @@ runDbCommand = runCommand . makeDbCommand
|
||||
-- All the commands that operate on db should be created using this function.
|
||||
makeDbCommand :: Command a -> Command a
|
||||
makeDbCommand cmd = do
|
||||
waspRoot <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </>
|
||||
Common.generatedCodeDirInDotWaspDir
|
||||
waspRoot <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir =
|
||||
waspRoot </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
-- NOTE(matija): First we need make sure the code is generated.
|
||||
compile
|
||||
-- NOTE(matija): First we need make sure the code is generated.
|
||||
compile
|
||||
|
||||
waspSaysC "\nSetting up database..."
|
||||
chan <- liftIO newChan
|
||||
-- NOTE(matija): What we do here is make sure that Prisma CLI is installed because db commands
|
||||
-- (e.g. migrate) depend on it. We run setupServer which does even more than that, so we could make
|
||||
-- this function more lightweight if needed.
|
||||
(_, dbSetupResult) <- liftIO (concurrently (readJobMessagesAndPrintThemPrefixed chan) (setupServer genProjectDir chan))
|
||||
case dbSetupResult of
|
||||
ExitSuccess -> waspSaysC "\nDatabase successfully set up!" >> cmd
|
||||
exitCode -> throwError $ CommandError $ dbSetupFailedMessage exitCode
|
||||
|
||||
where
|
||||
dbSetupFailedMessage exitCode = "\nDatabase setup failed" ++
|
||||
case exitCode of
|
||||
ExitFailure code -> ": " ++ show code
|
||||
_ -> ""
|
||||
waspSaysC "\nSetting up database..."
|
||||
chan <- liftIO newChan
|
||||
-- NOTE(matija): What we do here is make sure that Prisma CLI is installed because db commands
|
||||
-- (e.g. migrate) depend on it. We run setupServer which does even more than that, so we could make
|
||||
-- this function more lightweight if needed.
|
||||
(_, dbSetupResult) <- liftIO (concurrently (readJobMessagesAndPrintThemPrefixed chan) (setupServer genProjectDir chan))
|
||||
case dbSetupResult of
|
||||
ExitSuccess -> waspSaysC "\nDatabase successfully set up!" >> cmd
|
||||
exitCode -> throwError $ CommandError $ dbSetupFailedMessage exitCode
|
||||
where
|
||||
dbSetupFailedMessage exitCode =
|
||||
"\nDatabase setup failed"
|
||||
++ case exitCode of
|
||||
ExitFailure code -> ": " ++ show code
|
||||
_ -> ""
|
||||
|
||||
-- TODO(matija): should we extract this into a separate file, like we did for migrate?
|
||||
studio :: Command ()
|
||||
studio = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.generatedCodeDirInDotWaspDir
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir =
|
||||
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
waspSaysC "Running studio..."
|
||||
chan <- liftIO newChan
|
||||
waspSaysC "Running studio..."
|
||||
chan <- liftIO newChan
|
||||
|
||||
_ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan)
|
||||
error "This should never happen, studio should never stop."
|
||||
_ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan)
|
||||
error "This should never happen, studio should never stop."
|
||||
|
@ -1,100 +1,107 @@
|
||||
module Command.Db.Migrate
|
||||
( migrateDev
|
||||
, copyDbMigrationsDir
|
||||
, MigrationDirCopyDirection(..)
|
||||
) where
|
||||
( migrateDev,
|
||||
copyDbMigrationsDir,
|
||||
MigrationDirCopyDirection (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Catch (catch)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Path as P
|
||||
import qualified Path.IO as PathIO
|
||||
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Common (WaspProjectDir)
|
||||
import qualified Cli.Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Common (WaspProjectDir)
|
||||
import Control.Monad.Catch (catch)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
-- Wasp generator interface.
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (dbRootDirInProjectRootDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (dbRootDirInProjectRootDir)
|
||||
import qualified Generator.DbGenerator.Operations as DbOps
|
||||
|
||||
import qualified Path as P
|
||||
import qualified Path.IO as PathIO
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
migrateDev :: Command ()
|
||||
migrateDev = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectRootDir = waspProjectDir
|
||||
</> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectRootDir =
|
||||
waspProjectDir
|
||||
</> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
-- TODO(matija): It might make sense that this (copying migrations folder from source to
|
||||
-- the generated proejct) is responsibility of the generator. Since migrations can also be
|
||||
-- considered part of a "source" code, then generator could take care of it and this command
|
||||
-- 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 "Copying migrations folder from Wasp to Prisma project..."
|
||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirDown
|
||||
-- TODO(matija): It might make sense that this (copying migrations folder from source to
|
||||
-- the generated proejct) is responsibility of the generator. Since migrations can also be
|
||||
-- considered part of a "source" code, then generator could take care of it and this command
|
||||
-- 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 "Copying migrations folder from Wasp to Prisma project..."
|
||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirDown
|
||||
|
||||
waspSaysC "Performing migration..."
|
||||
migrateResult <- liftIO $ DbOps.migrateDev genProjectRootDir
|
||||
case migrateResult of
|
||||
Left migrateError ->
|
||||
throwError $ CommandError $ "Migrate dev failed: " <> migrateError
|
||||
Right () -> waspSaysC "Migration done."
|
||||
waspSaysC "Performing migration..."
|
||||
migrateResult <- liftIO $ DbOps.migrateDev genProjectRootDir
|
||||
case migrateResult of
|
||||
Left migrateError ->
|
||||
throwError $ CommandError $ "Migrate dev failed: " <> migrateError
|
||||
Right () -> waspSaysC "Migration done."
|
||||
|
||||
waspSaysC "Copying migrations folder from Prisma to Wasp project..."
|
||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirUp
|
||||
waspSaysC "Copying migrations folder from Prisma to Wasp project..."
|
||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirUp
|
||||
|
||||
waspSaysC "All done!"
|
||||
waspSaysC "All done!"
|
||||
where
|
||||
copyDbMigrationDir waspProjectDir genProjectRootDir copyDirection = do
|
||||
copyDbMigDirResult <-
|
||||
liftIO $ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir
|
||||
case copyDbMigDirResult of
|
||||
Nothing -> waspSaysC "Done copying migrations folder."
|
||||
Just err -> throwError $ CommandError $ "Copying migration folder failed: " ++ err
|
||||
|
||||
copyDbMigDirResult <-
|
||||
liftIO $ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir
|
||||
case copyDbMigDirResult of
|
||||
Nothing -> waspSaysC "Done copying migrations folder."
|
||||
Just err -> throwError $ CommandError $ "Copying migration folder failed: " ++ err
|
||||
|
||||
data MigrationDirCopyDirection = CopyMigDirUp | CopyMigDirDown deriving (Eq)
|
||||
|
||||
-- | Copy migrations directory between Wasp source and the generated project.
|
||||
copyDbMigrationsDir
|
||||
:: MigrationDirCopyDirection -- ^ Copy direction (source -> gen or gen-> source)
|
||||
-> Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir ProjectRootDir)
|
||||
-> IO (Maybe String)
|
||||
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
|
||||
let dbMigrationsDirInDbRootDir = SP.fromPathRelDir [P.reldir|migrations|]
|
||||
let dbMigrationsDirInDbRootDir = SP.fromPathRelDir [P.reldir|migrations|]
|
||||
|
||||
-- Migration folder in Wasp source (seen by Wasp dev and versioned).
|
||||
let dbMigrationsDirInWaspProjectDirAbs = waspProjectDir </> dbMigrationsDirInDbRootDir
|
||||
-- Migration folder in Wasp source (seen by Wasp dev and versioned).
|
||||
let dbMigrationsDirInWaspProjectDirAbs = waspProjectDir </> dbMigrationsDirInDbRootDir
|
||||
|
||||
-- Migration folder in the generated code.
|
||||
let dbMigrationsDirInGenProjectDirAbs = genProjectRootDir </> dbRootDirInProjectRootDir
|
||||
</> dbMigrationsDirInDbRootDir
|
||||
-- Migration folder in the generated code.
|
||||
let dbMigrationsDirInGenProjectDirAbs =
|
||||
genProjectRootDir </> dbRootDirInProjectRootDir
|
||||
</> dbMigrationsDirInDbRootDir
|
||||
|
||||
let src = if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInGenProjectDirAbs
|
||||
else dbMigrationsDirInWaspProjectDirAbs
|
||||
let src =
|
||||
if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInGenProjectDirAbs
|
||||
else dbMigrationsDirInWaspProjectDirAbs
|
||||
|
||||
let target = if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInWaspProjectDirAbs
|
||||
else dbMigrationsDirInGenProjectDirAbs
|
||||
|
||||
doesSrcDirExist <- PathIO.doesDirExist (SP.toPathAbsDir src)
|
||||
if doesSrcDirExist
|
||||
then ((PathIO.copyDirRecur (SP.toPathAbsDir src)
|
||||
(SP.toPathAbsDir target))
|
||||
>> return Nothing)
|
||||
`catch` (\e -> return $ Just $ show (e :: P.PathException))
|
||||
`catch` (\e -> return $ Just $ show (e :: IOError))
|
||||
else return Nothing
|
||||
let target =
|
||||
if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInWaspProjectDirAbs
|
||||
else dbMigrationsDirInGenProjectDirAbs
|
||||
|
||||
doesSrcDirExist <- PathIO.doesDirExist (SP.toPathAbsDir src)
|
||||
if doesSrcDirExist
|
||||
then
|
||||
( ( PathIO.copyDirRecur
|
||||
(SP.toPathAbsDir src)
|
||||
(SP.toPathAbsDir target)
|
||||
)
|
||||
>> return Nothing
|
||||
)
|
||||
`catch` (\e -> return $ Just $ show (e :: P.PathException))
|
||||
`catch` (\e -> return $ Just $ show (e :: IOError))
|
||||
else return Nothing
|
||||
|
@ -1,52 +1,53 @@
|
||||
module Command.Start
|
||||
( start
|
||||
) where
|
||||
( start,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (race)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Command.Compile (compileIO)
|
||||
import Command.Watch (watch)
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Command.Compile (compileIO)
|
||||
import Command.Watch (watch)
|
||||
import Control.Concurrent.Async (race)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath ((</>))
|
||||
|
||||
import StrongPath ((</>))
|
||||
|
||||
-- | Does initial compile of wasp code and then runs the generated project.
|
||||
-- It also listens for any file changes and recompiles and restarts generated project accordingly.
|
||||
start :: Command ()
|
||||
start = do
|
||||
waspRoot <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir
|
||||
waspRoot <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
waspSaysC "Compiling wasp code..."
|
||||
compilationResult <- liftIO $ compileIO waspRoot outDir
|
||||
case compilationResult of
|
||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
||||
waspSaysC "Compiling wasp code..."
|
||||
compilationResult <- liftIO $ compileIO waspRoot outDir
|
||||
case compilationResult of
|
||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
||||
|
||||
-- TODO: Do smart install -> if we need to install stuff, install it, otherwise don't.
|
||||
-- This should be responsibility of Generator, it should tell us how to install stuff.
|
||||
-- But who checks out if stuff needs to be installed at all? That should probably be
|
||||
-- Generator again. After installation, it should return some kind of data that describes that installation.
|
||||
-- Then, next time, we give it data we have about last installation, and it uses that
|
||||
-- to decide if installation needs to happen or not. If it happens, it returnes new data again.
|
||||
-- Right now we have setup/installation being called, but it has not support for being "smart" yet.
|
||||
waspSaysC "Setting up generated project..."
|
||||
setupResult <- liftIO $ Lib.setup outDir
|
||||
case setupResult of
|
||||
Left setupError -> throwError $ CommandError $ "\nSetup failed: " ++ setupError
|
||||
Right () -> waspSaysC "\nSetup successful.\n"
|
||||
-- TODO: Do smart install -> if we need to install stuff, install it, otherwise don't.
|
||||
-- This should be responsibility of Generator, it should tell us how to install stuff.
|
||||
-- But who checks out if stuff needs to be installed at all? That should probably be
|
||||
-- Generator again. After installation, it should return some kind of data that describes that installation.
|
||||
-- Then, next time, we give it data we have about last installation, and it uses that
|
||||
-- to decide if installation needs to happen or not. If it happens, it returnes new data again.
|
||||
-- Right now we have setup/installation being called, but it has not support for being "smart" yet.
|
||||
waspSaysC "Setting up generated project..."
|
||||
setupResult <- liftIO $ Lib.setup outDir
|
||||
case setupResult of
|
||||
Left setupError -> throwError $ CommandError $ "\nSetup failed: " ++ setupError
|
||||
Right () -> waspSaysC "\nSetup successful.\n"
|
||||
|
||||
waspSaysC "\nListening for file changes..."
|
||||
waspSaysC "Starting up generated project..."
|
||||
watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Lib.start outDir)
|
||||
case watchOrStartResult of
|
||||
Left () -> error "This should never happen, listening for file changes should never end but it did."
|
||||
Right startResult -> case startResult of
|
||||
Left startError -> throwError $ CommandError $ "Start failed: " ++ startError
|
||||
Right () -> error "This should never happen, start should never end but it did."
|
||||
waspSaysC "\nListening for file changes..."
|
||||
waspSaysC "Starting up generated project..."
|
||||
watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Lib.start outDir)
|
||||
case watchOrStartResult of
|
||||
Left () -> error "This should never happen, listening for file changes should never end but it did."
|
||||
Right startResult -> case startResult of
|
||||
Left startError -> throwError $ CommandError $ "Start failed: " ++ startError
|
||||
Right () -> error "This should never happen, start should never end but it did."
|
||||
|
@ -1,22 +1,22 @@
|
||||
module Command.Telemetry
|
||||
( considerSendingData
|
||||
, telemetry
|
||||
) where
|
||||
( considerSendingData,
|
||||
telemetry,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (when, unless)
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Foldable (for_)
|
||||
import qualified System.Environment as ENV
|
||||
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (waspSaysC)
|
||||
import Command (Command, CommandError (..))
|
||||
import qualified Command.Call
|
||||
import Command.Telemetry.Common (ensureTelemetryCacheDirExists)
|
||||
import Command.Common (waspSaysC)
|
||||
import Command.Telemetry.Common (ensureTelemetryCacheDirExists)
|
||||
import qualified Command.Telemetry.Project as TlmProject
|
||||
import qualified Command.Telemetry.User as TlmUser
|
||||
import qualified StrongPath as SP
|
||||
import qualified Command.Telemetry.User as TlmUser
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Maybe (isJust)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.Environment as ENV
|
||||
|
||||
isTelemetryDisabled :: IO Bool
|
||||
isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
|
||||
@ -24,24 +24,27 @@ isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
|
||||
-- | Prints basic information about the stauts of telemetry.
|
||||
telemetry :: Command ()
|
||||
telemetry = do
|
||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||
waspSaysC $ "Telemetry is currently: " <> (if telemetryDisabled
|
||||
then "DISABLED"
|
||||
else "ENABLED")
|
||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||
waspSaysC $
|
||||
"Telemetry is currently: "
|
||||
<> ( if telemetryDisabled
|
||||
then "DISABLED"
|
||||
else "ENABLED"
|
||||
)
|
||||
|
||||
unless telemetryDisabled $ do
|
||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||
waspSaysC $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath
|
||||
unless telemetryDisabled $ do
|
||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||
waspSaysC $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath
|
||||
|
||||
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||
for_ maybeProjectHash $ \projectHash -> do
|
||||
maybeProjectCache <- liftIO $ TlmProject.readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
for_ maybeProjectCache $ \projectCache -> do
|
||||
let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache
|
||||
for_ maybeTimeOfLastSending $ \timeOfLastSending -> do
|
||||
waspSaysC $ "Last time telemetry data was sent for this project: " ++ show timeOfLastSending
|
||||
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||
for_ maybeProjectHash $ \projectHash -> do
|
||||
maybeProjectCache <- liftIO $ TlmProject.readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
for_ maybeProjectCache $ \projectCache -> do
|
||||
let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache
|
||||
for_ maybeTimeOfLastSending $ \timeOfLastSending -> do
|
||||
waspSaysC $ "Last time telemetry data was sent for this project: " ++ show timeOfLastSending
|
||||
|
||||
waspSaysC "Our telemetry is anonymized and very limited in its scope: check https://wasp-lang.dev/docs/telemetry for more details."
|
||||
waspSaysC "Our telemetry is anonymized and very limited in its scope: check https://wasp-lang.dev/docs/telemetry for more details."
|
||||
|
||||
-- | Sends telemetry data about the current Wasp project, if conditions are met.
|
||||
-- If we are not in the Wasp project at the moment, nothing happens.
|
||||
@ -49,13 +52,13 @@ telemetry = do
|
||||
-- If env var WASP_TELEMETRY_DISABLE is set, nothing happens.
|
||||
considerSendingData :: Command.Call.Call -> Command ()
|
||||
considerSendingData cmdCall = (`catchError` const (return ())) $ do
|
||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||
when telemetryDisabled $ throwError $ CommandError "Telemetry disabled by user."
|
||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||
when telemetryDisabled $ throwError $ CommandError "Telemetry disabled by user."
|
||||
|
||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||
|
||||
userSignature <- liftIO $ TlmUser.readOrCreateUserSignatureFile telemetryCacheDirPath
|
||||
userSignature <- liftIO $ TlmUser.readOrCreateUserSignatureFile telemetryCacheDirPath
|
||||
|
||||
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||
for_ maybeProjectHash $ \projectHash -> do
|
||||
liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall
|
||||
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||
for_ maybeProjectHash $ \projectHash -> do
|
||||
liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall
|
||||
|
@ -1,15 +1,14 @@
|
||||
module Command.Telemetry.Common
|
||||
( TelemetryCacheDir
|
||||
, ensureTelemetryCacheDirExists
|
||||
, getTelemetryCacheDirPath
|
||||
) where
|
||||
|
||||
import Path (reldir)
|
||||
import qualified System.Directory as SD
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
( TelemetryCacheDir,
|
||||
ensureTelemetryCacheDirExists,
|
||||
getTelemetryCacheDirPath,
|
||||
)
|
||||
where
|
||||
|
||||
import Path (reldir)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.Directory as SD
|
||||
|
||||
data UserCacheDir
|
||||
|
||||
@ -20,11 +19,11 @@ data TelemetryCacheDir
|
||||
|
||||
ensureTelemetryCacheDirExists :: IO (Path Abs (Dir TelemetryCacheDir))
|
||||
ensureTelemetryCacheDirExists = do
|
||||
userCacheDirPath <- getUserCacheDirPath
|
||||
SD.createDirectoryIfMissing False $ SP.toFilePath userCacheDirPath
|
||||
let telemetryCacheDirPath = getTelemetryCacheDirPath userCacheDirPath
|
||||
SD.createDirectoryIfMissing True $ SP.toFilePath telemetryCacheDirPath
|
||||
return telemetryCacheDirPath
|
||||
userCacheDirPath <- getUserCacheDirPath
|
||||
SD.createDirectoryIfMissing False $ SP.toFilePath userCacheDirPath
|
||||
let telemetryCacheDirPath = getTelemetryCacheDirPath userCacheDirPath
|
||||
SD.createDirectoryIfMissing True $ SP.toFilePath telemetryCacheDirPath
|
||||
return telemetryCacheDirPath
|
||||
|
||||
getTelemetryCacheDirPath :: Path Abs (Dir UserCacheDir) -> Path Abs (Dir TelemetryCacheDir)
|
||||
getTelemetryCacheDirPath userCacheDirPath = userCacheDirPath SP.</> SP.fromPathRelDir [reldir|wasp/telemetry|]
|
||||
|
@ -1,73 +1,74 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Command.Telemetry.Project
|
||||
( getWaspProjectPathHash
|
||||
, considerSendingData
|
||||
, readProjectTelemetryFile
|
||||
, getTimeOfLastTelemetryDataSent
|
||||
) where
|
||||
( getWaspProjectPathHash,
|
||||
considerSendingData,
|
||||
readProjectTelemetryFile,
|
||||
getTimeOfLastTelemetryDataSent,
|
||||
)
|
||||
where
|
||||
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import Control.Monad (void, when)
|
||||
import Crypto.Hash (SHA256 (..), hashWith)
|
||||
import Data.Aeson ((.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.ByteString.Lazy.UTF8 as ByteStringLazyUTF8
|
||||
import qualified Data.ByteString.UTF8 as ByteStringUTF8
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Time as T
|
||||
import Data.Version (showVersion)
|
||||
import GHC.Generics
|
||||
import qualified Network.HTTP.Simple as HTTP
|
||||
import Paths_waspc (version)
|
||||
import qualified System.Directory as SD
|
||||
import qualified System.Info
|
||||
|
||||
import Command (Command)
|
||||
import Command (Command)
|
||||
import qualified Command.Call
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import Command.Telemetry.User (UserSignature (..))
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import Command.Telemetry.User (UserSignature (..))
|
||||
import Control.Monad (void, when)
|
||||
import Crypto.Hash (SHA256 (..), hashWith)
|
||||
import Data.Aeson ((.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.ByteString.Lazy.UTF8 as ByteStringLazyUTF8
|
||||
import qualified Data.ByteString.UTF8 as ByteStringUTF8
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Time as T
|
||||
import Data.Version (showVersion)
|
||||
import GHC.Generics
|
||||
import qualified Network.HTTP.Simple as HTTP
|
||||
import Paths_waspc (version)
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.Directory as SD
|
||||
import qualified System.Info
|
||||
|
||||
considerSendingData :: Path Abs (Dir TelemetryCacheDir) -> UserSignature -> ProjectHash -> Command.Call.Call -> IO ()
|
||||
considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
|
||||
projectCache <- readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
projectCache <- readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
|
||||
let relevantLastCheckIn = case cmdCall of
|
||||
Command.Call.Build -> _lastCheckInBuild projectCache
|
||||
_ -> _lastCheckIn projectCache
|
||||
let relevantLastCheckIn = case cmdCall of
|
||||
Command.Call.Build -> _lastCheckInBuild projectCache
|
||||
_ -> _lastCheckIn projectCache
|
||||
|
||||
shouldSendData <- case relevantLastCheckIn of
|
||||
Nothing -> return True
|
||||
Just lastCheckIn -> isOlderThan12Hours lastCheckIn
|
||||
shouldSendData <- case relevantLastCheckIn of
|
||||
Nothing -> return True
|
||||
Just lastCheckIn -> isOlderThan12Hours lastCheckIn
|
||||
|
||||
when shouldSendData $ do
|
||||
sendTelemetryData $ getProjectTelemetryData userSignature projectHash cmdCall
|
||||
projectCache' <- newProjectCache projectCache
|
||||
writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache'
|
||||
when shouldSendData $ do
|
||||
sendTelemetryData $ getProjectTelemetryData userSignature projectHash cmdCall
|
||||
projectCache' <- newProjectCache projectCache
|
||||
writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache'
|
||||
where
|
||||
isOlderThan12Hours :: T.UTCTime -> IO Bool
|
||||
isOlderThan12Hours time = do
|
||||
now <- T.getCurrentTime
|
||||
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
|
||||
return $ let numSecondsInHour = 3600
|
||||
in secondsSinceLastCheckIn > 12 * numSecondsInHour
|
||||
isOlderThan12Hours :: T.UTCTime -> IO Bool
|
||||
isOlderThan12Hours time = do
|
||||
now <- T.getCurrentTime
|
||||
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
|
||||
return $
|
||||
let numSecondsInHour = 3600
|
||||
in secondsSinceLastCheckIn > 12 * numSecondsInHour
|
||||
|
||||
newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
|
||||
newProjectCache currentProjectCache = do
|
||||
now <- T.getCurrentTime
|
||||
return currentProjectCache
|
||||
{ _lastCheckIn = Just now
|
||||
, _lastCheckInBuild = case cmdCall of
|
||||
Command.Call.Build -> Just now
|
||||
_ -> _lastCheckInBuild currentProjectCache
|
||||
}
|
||||
newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
|
||||
newProjectCache currentProjectCache = do
|
||||
now <- T.getCurrentTime
|
||||
return
|
||||
currentProjectCache
|
||||
{ _lastCheckIn = Just now,
|
||||
_lastCheckInBuild = case cmdCall of
|
||||
Command.Call.Build -> Just now
|
||||
_ -> _lastCheckInBuild currentProjectCache
|
||||
}
|
||||
|
||||
-- * Project hash.
|
||||
|
||||
newtype ProjectHash = ProjectHash { _projectHashValue :: String } deriving (Show)
|
||||
newtype ProjectHash = ProjectHash {_projectHashValue :: String} deriving (Show)
|
||||
|
||||
getWaspProjectPathHash :: Command ProjectHash
|
||||
getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> findWaspProjectRootDirFromCwd
|
||||
@ -78,16 +79,17 @@ getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> find
|
||||
-- * Project telemetry cache.
|
||||
|
||||
data ProjectTelemetryCache = ProjectTelemetryCache
|
||||
{ _lastCheckIn :: Maybe T.UTCTime -- Last time when CLI was called for this project, any command.
|
||||
, _lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
{ _lastCheckIn :: Maybe T.UTCTime, -- Last time when CLI was called for this project, any command.
|
||||
_lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance Aeson.ToJSON ProjectTelemetryCache
|
||||
|
||||
instance Aeson.FromJSON ProjectTelemetryCache
|
||||
|
||||
initialCache :: ProjectTelemetryCache
|
||||
initialCache = ProjectTelemetryCache { _lastCheckIn = Nothing, _lastCheckInBuild = Nothing }
|
||||
initialCache = ProjectTelemetryCache {_lastCheckIn = Nothing, _lastCheckInBuild = Nothing}
|
||||
|
||||
-- * Project telemetry cache file.
|
||||
|
||||
@ -96,66 +98,71 @@ getTimeOfLastTelemetryDataSent cache = maximum [_lastCheckIn cache, _lastCheckIn
|
||||
|
||||
readProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO (Maybe ProjectTelemetryCache)
|
||||
readProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
||||
fileExists <- SD.doesFileExist filePathFP
|
||||
if fileExists then readCacheFile else return Nothing
|
||||
fileExists <- SD.doesFileExist filePathFP
|
||||
if fileExists then readCacheFile else return Nothing
|
||||
where
|
||||
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
||||
readCacheFile = Aeson.decode . ByteStringLazyUTF8.fromString <$> readFile filePathFP
|
||||
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
||||
readCacheFile = Aeson.decode . ByteStringLazyUTF8.fromString <$> readFile filePathFP
|
||||
|
||||
readOrCreateProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO ProjectTelemetryCache
|
||||
readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
||||
maybeProjectTelemetryCache <- readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
case maybeProjectTelemetryCache of
|
||||
Just cache -> return cache
|
||||
Nothing -> writeProjectTelemetryFile telemetryCacheDirPath projectHash initialCache >> return initialCache
|
||||
maybeProjectTelemetryCache <- readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||
case maybeProjectTelemetryCache of
|
||||
Just cache -> return cache
|
||||
Nothing -> writeProjectTelemetryFile telemetryCacheDirPath projectHash initialCache >> return initialCache
|
||||
|
||||
writeProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> ProjectTelemetryCache -> IO ()
|
||||
writeProjectTelemetryFile telemetryCacheDirPath projectHash cache = do
|
||||
writeFile filePathFP (ByteStringLazyUTF8.toString $ Aeson.encode cache)
|
||||
writeFile filePathFP (ByteStringLazyUTF8.toString $ Aeson.encode cache)
|
||||
where
|
||||
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
||||
|
||||
getProjectTelemetryFilePath :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> Path Abs File
|
||||
getProjectTelemetryFilePath telemetryCacheDir (ProjectHash projectHash) =
|
||||
telemetryCacheDir SP.</> fromJust (SP.parseRelFile $ "project-" ++ projectHash)
|
||||
telemetryCacheDir SP.</> fromJust (SP.parseRelFile $ "project-" ++ projectHash)
|
||||
|
||||
-- * Telemetry data.
|
||||
|
||||
data ProjectTelemetryData = ProjectTelemetryData
|
||||
{ _userSignature :: UserSignature
|
||||
, _projectHash :: ProjectHash
|
||||
, _waspVersion :: String
|
||||
, _os :: String
|
||||
, _isBuild :: Bool
|
||||
} deriving (Show)
|
||||
{ _userSignature :: UserSignature,
|
||||
_projectHash :: ProjectHash,
|
||||
_waspVersion :: String,
|
||||
_os :: String,
|
||||
_isBuild :: Bool
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
getProjectTelemetryData :: UserSignature -> ProjectHash -> Command.Call.Call -> ProjectTelemetryData
|
||||
getProjectTelemetryData userSignature projectHash cmdCall = ProjectTelemetryData
|
||||
{ _userSignature = userSignature
|
||||
, _projectHash = projectHash
|
||||
, _waspVersion = showVersion version
|
||||
, _os = System.Info.os
|
||||
, _isBuild = case cmdCall of
|
||||
Command.Call.Build -> True
|
||||
_ -> False
|
||||
getProjectTelemetryData userSignature projectHash cmdCall =
|
||||
ProjectTelemetryData
|
||||
{ _userSignature = userSignature,
|
||||
_projectHash = projectHash,
|
||||
_waspVersion = showVersion version,
|
||||
_os = System.Info.os,
|
||||
_isBuild = case cmdCall of
|
||||
Command.Call.Build -> True
|
||||
_ -> False
|
||||
}
|
||||
|
||||
sendTelemetryData :: ProjectTelemetryData -> IO ()
|
||||
sendTelemetryData telemetryData = do
|
||||
let reqBodyJson = Aeson.object
|
||||
[ -- PostHog api_key is public so it is ok that we have it here.
|
||||
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String)
|
||||
, "event" .= ("cli" :: String)
|
||||
, "properties" .= Aeson.object
|
||||
let reqBodyJson =
|
||||
Aeson.object
|
||||
[ -- PostHog api_key is public so it is ok that we have it here.
|
||||
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String),
|
||||
"event" .= ("cli" :: String),
|
||||
"properties"
|
||||
.= Aeson.object
|
||||
[ -- distinct_id is special PostHog value, used as user id.
|
||||
"distinct_id" .= _userSignatureValue (_userSignature telemetryData)
|
||||
-- Following are our custom metrics:
|
||||
, "project_hash" .= _projectHashValue (_projectHash telemetryData)
|
||||
, "wasp_version" .= _waspVersion telemetryData
|
||||
, "os" .= _os telemetryData
|
||||
, "is_build" .= _isBuild telemetryData
|
||||
"distinct_id" .= _userSignatureValue (_userSignature telemetryData),
|
||||
-- Following are our custom metrics:
|
||||
"project_hash" .= _projectHashValue (_projectHash telemetryData),
|
||||
"wasp_version" .= _waspVersion telemetryData,
|
||||
"os" .= _os telemetryData,
|
||||
"is_build" .= _isBuild telemetryData
|
||||
]
|
||||
]
|
||||
request = HTTP.setRequestBodyJSON reqBodyJson $
|
||||
HTTP.parseRequest_ "POST https://app.posthog.com/capture"
|
||||
void $ HTTP.httpNoBody request
|
||||
]
|
||||
request =
|
||||
HTTP.setRequestBodyJSON reqBodyJson $
|
||||
HTTP.parseRequest_ "POST https://app.posthog.com/capture"
|
||||
void $ HTTP.httpNoBody request
|
||||
|
@ -1,34 +1,33 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Command.Telemetry.User
|
||||
( UserSignature(..)
|
||||
, readOrCreateUserSignatureFile
|
||||
) where
|
||||
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import Path (relfile)
|
||||
import qualified System.Directory as SD
|
||||
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
( UserSignature (..),
|
||||
readOrCreateUserSignatureFile,
|
||||
)
|
||||
where
|
||||
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import Path (relfile)
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.Directory as SD
|
||||
|
||||
-- Random, non-identifyable UUID used to represent user in analytics.
|
||||
newtype UserSignature = UserSignature { _userSignatureValue :: String } deriving (Show)
|
||||
newtype UserSignature = UserSignature {_userSignatureValue :: String} deriving (Show)
|
||||
|
||||
readOrCreateUserSignatureFile :: Path Abs (Dir TelemetryCacheDir) -> IO UserSignature
|
||||
readOrCreateUserSignatureFile telemetryCacheDirPath = do
|
||||
let filePath = getUserSignatureFilePath telemetryCacheDirPath
|
||||
let filePathFP = SP.toFilePath filePath
|
||||
fileExists <- SD.doesFileExist filePathFP
|
||||
UserSignature <$> if fileExists
|
||||
then readFile filePathFP
|
||||
else do userSignature <- show <$> UUID.nextRandom
|
||||
writeFile filePathFP userSignature
|
||||
return userSignature
|
||||
let filePath = getUserSignatureFilePath telemetryCacheDirPath
|
||||
let filePathFP = SP.toFilePath filePath
|
||||
fileExists <- SD.doesFileExist filePathFP
|
||||
UserSignature
|
||||
<$> if fileExists
|
||||
then readFile filePathFP
|
||||
else do
|
||||
userSignature <- show <$> UUID.nextRandom
|
||||
writeFile filePathFP userSignature
|
||||
return userSignature
|
||||
|
||||
getUserSignatureFilePath :: Path Abs (Dir TelemetryCacheDir) -> Path Abs File
|
||||
getUserSignatureFilePath telemetryCacheDir = telemetryCacheDir SP.</> SP.fromPathRelFile [relfile|signature|]
|
||||
|
||||
|
@ -1,20 +1,19 @@
|
||||
module Command.Watch
|
||||
( watch
|
||||
) where
|
||||
( watch,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.FSNotify as FSN
|
||||
|
||||
import Cli.Common (waspSays)
|
||||
import qualified Cli.Common as Common
|
||||
import Command.Compile (compileIO)
|
||||
import Cli.Common (waspSays)
|
||||
import qualified Cli.Common as Common
|
||||
import Command.Compile (compileIO)
|
||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.FSNotify as FSN
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
-- TODO: Another possible problem: on re-generation, wasp re-generates a lot of files, even those that should not
|
||||
-- be generated again, since it is not smart enough yet to know which files do not need to be regenerated.
|
||||
@ -27,47 +26,48 @@ import qualified StrongPath as SP
|
||||
-- TODO: Idea: Read .gitignore file, and ignore everything from it. This will then also cover the
|
||||
-- .wasp dir, and users can easily add any custom stuff they want ignored. But, we also have to
|
||||
-- be ready for the case when there is no .gitignore, that could be possible.
|
||||
|
||||
-- | Forever listens for any file changes in waspProjectDir, and if there is a change,
|
||||
-- compiles Wasp source files in waspProjectDir and regenerates files in outDir.
|
||||
watch :: Path Abs (Dir Common.WaspProjectDir) -> Path Abs (Dir Lib.ProjectRootDir) -> IO ()
|
||||
watch waspProjectDir outDir = FSN.withManager $ \mgr -> do
|
||||
currentTime <- getCurrentTime
|
||||
chan <- newChan
|
||||
_ <- FSN.watchDirChan mgr (SP.toFilePath waspProjectDir) eventFilter chan
|
||||
_ <- FSN.watchTreeChan mgr (SP.toFilePath $ waspProjectDir </> Common.extCodeDirInWaspProjectDir) eventFilter chan
|
||||
listenForEvents chan currentTime
|
||||
currentTime <- getCurrentTime
|
||||
chan <- newChan
|
||||
_ <- FSN.watchDirChan mgr (SP.toFilePath waspProjectDir) eventFilter chan
|
||||
_ <- FSN.watchTreeChan mgr (SP.toFilePath $ waspProjectDir </> Common.extCodeDirInWaspProjectDir) eventFilter chan
|
||||
listenForEvents chan currentTime
|
||||
where
|
||||
listenForEvents :: Chan FSN.Event -> UTCTime -> IO ()
|
||||
listenForEvents chan lastCompileTime = do
|
||||
event <- readChan chan
|
||||
let eventTime = FSN.eventTime event
|
||||
if eventTime < lastCompileTime
|
||||
-- If event happened before last compilation started, skip it.
|
||||
then listenForEvents chan lastCompileTime
|
||||
else do
|
||||
currentTime <- getCurrentTime
|
||||
recompile
|
||||
listenForEvents chan currentTime
|
||||
listenForEvents :: Chan FSN.Event -> UTCTime -> IO ()
|
||||
listenForEvents chan lastCompileTime = do
|
||||
event <- readChan chan
|
||||
let eventTime = FSN.eventTime event
|
||||
if eventTime < lastCompileTime
|
||||
then -- If event happened before last compilation started, skip it.
|
||||
listenForEvents chan lastCompileTime
|
||||
else do
|
||||
currentTime <- getCurrentTime
|
||||
recompile
|
||||
listenForEvents chan currentTime
|
||||
|
||||
recompile :: IO ()
|
||||
recompile = do
|
||||
waspSays "Recompiling on file change..."
|
||||
compilationResult <- compileIO waspProjectDir outDir
|
||||
case compilationResult of
|
||||
Left err -> waspSays $ "Recompilation on file change failed: " ++ err
|
||||
Right () -> waspSays "Recompilation on file change succeeded."
|
||||
return ()
|
||||
recompile :: IO ()
|
||||
recompile = do
|
||||
waspSays "Recompiling on file change..."
|
||||
compilationResult <- compileIO waspProjectDir outDir
|
||||
case compilationResult of
|
||||
Left err -> waspSays $ "Recompilation on file change failed: " ++ err
|
||||
Right () -> waspSays "Recompilation on file change succeeded."
|
||||
return ()
|
||||
|
||||
-- TODO: This is a hardcoded approach to ignoring most of the common tmp files that editors
|
||||
-- create next to the source code. Bad thing here is that users can't modify this,
|
||||
-- so better approach would be probably to use information from .gitignore instead, or
|
||||
-- maybe combining the two somehow.
|
||||
eventFilter :: FSN.Event -> Bool
|
||||
eventFilter event =
|
||||
let filename = FP.takeFileName $ FSN.eventPath event
|
||||
in not (null filename)
|
||||
&& not (take 2 filename == ".#") -- Ignore emacs lock files.
|
||||
&& not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files.
|
||||
&& not (last filename == '~') -- Ignore emacs and vim backup files.
|
||||
&& not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files.
|
||||
&& not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files.
|
||||
-- TODO: This is a hardcoded approach to ignoring most of the common tmp files that editors
|
||||
-- create next to the source code. Bad thing here is that users can't modify this,
|
||||
-- so better approach would be probably to use information from .gitignore instead, or
|
||||
-- maybe combining the two somehow.
|
||||
eventFilter :: FSN.Event -> Bool
|
||||
eventFilter event =
|
||||
let filename = FP.takeFileName $ FSN.eventPath event
|
||||
in not (null filename)
|
||||
&& not (take 2 filename == ".#") -- Ignore emacs lock files.
|
||||
&& not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files.
|
||||
&& not (last filename == '~') -- Ignore emacs and vim backup files.
|
||||
&& not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files.
|
||||
&& not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files.
|
||||
|
@ -1,84 +1,85 @@
|
||||
module Main where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Version (showVersion)
|
||||
import Paths_waspc (version)
|
||||
import System.Environment
|
||||
|
||||
import Command (runCommand)
|
||||
import Command.Build (build)
|
||||
import Command (runCommand)
|
||||
import Command.Build (build)
|
||||
import qualified Command.Call
|
||||
import Command.Clean (clean)
|
||||
import Command.Compile (compile)
|
||||
import Command.CreateNewProject (createNewProject)
|
||||
import Command.Db (runDbCommand, studio)
|
||||
import Command.Clean (clean)
|
||||
import Command.Compile (compile)
|
||||
import Command.CreateNewProject (createNewProject)
|
||||
import Command.Db (runDbCommand, studio)
|
||||
import qualified Command.Db.Migrate
|
||||
import Command.Start (start)
|
||||
import qualified Command.Telemetry as Telemetry
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
import Command.Start (start)
|
||||
import qualified Command.Telemetry as Telemetry
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Version (showVersion)
|
||||
import Paths_waspc (version)
|
||||
import System.Environment
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
let commandCall = case args of
|
||||
["new", projectName] -> Command.Call.New projectName
|
||||
["start"] -> Command.Call.Start
|
||||
["clean"] -> Command.Call.Clean
|
||||
["compile"] -> Command.Call.Compile
|
||||
("db":dbArgs) -> Command.Call.Db dbArgs
|
||||
["version"] -> Command.Call.Version
|
||||
["build"] -> Command.Call.Build
|
||||
["telemetry"] -> Command.Call.Telemetry
|
||||
_ -> Command.Call.Unknown args
|
||||
args <- getArgs
|
||||
let commandCall = case args of
|
||||
["new", projectName] -> Command.Call.New projectName
|
||||
["start"] -> Command.Call.Start
|
||||
["clean"] -> Command.Call.Clean
|
||||
["compile"] -> Command.Call.Compile
|
||||
("db" : dbArgs) -> Command.Call.Db dbArgs
|
||||
["version"] -> Command.Call.Version
|
||||
["build"] -> Command.Call.Build
|
||||
["telemetry"] -> Command.Call.Telemetry
|
||||
_ -> Command.Call.Unknown args
|
||||
|
||||
telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall
|
||||
telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall
|
||||
|
||||
case commandCall of
|
||||
Command.Call.New projectName -> runCommand $ createNewProject projectName
|
||||
Command.Call.Start -> runCommand start
|
||||
Command.Call.Clean -> runCommand clean
|
||||
Command.Call.Compile -> runCommand compile
|
||||
Command.Call.Db dbArgs -> dbCli dbArgs
|
||||
Command.Call.Version -> printVersion
|
||||
Command.Call.Build -> runCommand build
|
||||
Command.Call.Telemetry -> runCommand Telemetry.telemetry
|
||||
Command.Call.Unknown _ -> printUsage
|
||||
case commandCall of
|
||||
Command.Call.New projectName -> runCommand $ createNewProject projectName
|
||||
Command.Call.Start -> runCommand start
|
||||
Command.Call.Clean -> runCommand clean
|
||||
Command.Call.Compile -> runCommand compile
|
||||
Command.Call.Db dbArgs -> dbCli dbArgs
|
||||
Command.Call.Version -> printVersion
|
||||
Command.Call.Build -> runCommand build
|
||||
Command.Call.Telemetry -> runCommand Telemetry.telemetry
|
||||
Command.Call.Unknown _ -> printUsage
|
||||
|
||||
-- If sending of telemetry data is still not done 1 second since commmand finished, abort it.
|
||||
-- We also make sure here to catch all errors that might get thrown and silence them.
|
||||
void $ Async.race (threadDelaySeconds 1) (Async.waitCatch telemetryThread)
|
||||
-- If sending of telemetry data is still not done 1 second since commmand finished, abort it.
|
||||
-- We also make sure here to catch all errors that might get thrown and silence them.
|
||||
void $ Async.race (threadDelaySeconds 1) (Async.waitCatch telemetryThread)
|
||||
where
|
||||
threadDelaySeconds = let microsecondsInASecond = 1000000
|
||||
in threadDelay . (* microsecondsInASecond)
|
||||
threadDelaySeconds =
|
||||
let microsecondsInASecond = 1000000
|
||||
in threadDelay . (* microsecondsInASecond)
|
||||
|
||||
printUsage :: IO ()
|
||||
printUsage = putStrLn $ unlines
|
||||
[ title "USAGE"
|
||||
, " wasp <command> [command-args]"
|
||||
, ""
|
||||
, title "COMMANDS"
|
||||
, title " GENERAL"
|
||||
, cmd " new <project-name> Creates new Wasp project."
|
||||
, cmd " version Prints current version of CLI."
|
||||
, title " IN PROJECT"
|
||||
, cmd " start Runs Wasp app in development mode, watching for file changes."
|
||||
, cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info."
|
||||
, cmd " clean Deletes all generated code and other cached artifacts. Wasp equivalent of 'have you tried closing and opening it again?'."
|
||||
, cmd " build Generates full web app code, ready for deployment. Use when deploying or ejecting."
|
||||
, cmd " telemetry Prints telemetry status."
|
||||
, ""
|
||||
, title "EXAMPLES"
|
||||
, " wasp new MyApp"
|
||||
, " wasp start"
|
||||
, " wasp db migrate-dev"
|
||||
, ""
|
||||
, Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs"
|
||||
, Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
||||
]
|
||||
printUsage =
|
||||
putStrLn $
|
||||
unlines
|
||||
[ title "USAGE",
|
||||
" wasp <command> [command-args]",
|
||||
"",
|
||||
title "COMMANDS",
|
||||
title " GENERAL",
|
||||
cmd " new <project-name> Creates new Wasp project.",
|
||||
cmd " version Prints current version of CLI.",
|
||||
title " IN PROJECT",
|
||||
cmd " start Runs Wasp app in development mode, watching for file changes.",
|
||||
cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info.",
|
||||
cmd " clean Deletes all generated code and other cached artifacts. Wasp equivalent of 'have you tried closing and opening it again?'.",
|
||||
cmd " build Generates full web app code, ready for deployment. Use when deploying or ejecting.",
|
||||
cmd " telemetry Prints telemetry status.",
|
||||
"",
|
||||
title "EXAMPLES",
|
||||
" wasp new MyApp",
|
||||
" wasp start",
|
||||
" wasp db migrate-dev",
|
||||
"",
|
||||
Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs",
|
||||
Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
||||
]
|
||||
|
||||
printVersion :: IO ()
|
||||
printVersion = putStrLn $ showVersion version
|
||||
@ -86,27 +87,29 @@ printVersion = putStrLn $ showVersion version
|
||||
-- TODO(matija): maybe extract to a separate module, e.g. DbCli.hs?
|
||||
dbCli :: [String] -> IO ()
|
||||
dbCli args = case args of
|
||||
["migrate-dev"] -> runDbCommand Command.Db.Migrate.migrateDev
|
||||
["studio"] -> runDbCommand studio
|
||||
_ -> printDbUsage
|
||||
["migrate-dev"] -> runDbCommand Command.Db.Migrate.migrateDev
|
||||
["studio"] -> runDbCommand studio
|
||||
_ -> printDbUsage
|
||||
|
||||
printDbUsage :: IO ()
|
||||
printDbUsage = putStrLn $ unlines
|
||||
[ title "USAGE"
|
||||
, " wasp db <command> [command-args]"
|
||||
, ""
|
||||
, title "COMMANDS"
|
||||
, cmd (
|
||||
" migrate-dev Ensures dev database corresponds to the current state of schema(entities):\n" <>
|
||||
" - Generates a new migration if there are changes in the schema.\n" <>
|
||||
" - Applies any pending migrations to the database."
|
||||
)
|
||||
, cmd " studio GUI for inspecting your database."
|
||||
, ""
|
||||
, title "EXAMPLES"
|
||||
, " wasp db migrate-dev"
|
||||
, " wasp db studio"
|
||||
]
|
||||
printDbUsage =
|
||||
putStrLn $
|
||||
unlines
|
||||
[ title "USAGE",
|
||||
" wasp db <command> [command-args]",
|
||||
"",
|
||||
title "COMMANDS",
|
||||
cmd
|
||||
( " migrate-dev Ensures dev database corresponds to the current state of schema(entities):\n"
|
||||
<> " - Generates a new migration if there are changes in the schema.\n"
|
||||
<> " - Applies any pending migrations to the database."
|
||||
),
|
||||
cmd " studio GUI for inspecting your database.",
|
||||
"",
|
||||
title "EXAMPLES",
|
||||
" wasp db migrate-dev",
|
||||
" wasp db studio"
|
||||
]
|
||||
|
||||
title :: String -> String
|
||||
title = Term.applyStyles [Term.Bold]
|
||||
@ -118,4 +121,4 @@ mapFirstWord :: (String -> String) -> String -> String
|
||||
mapFirstWord f s = beforeFirstWord ++ f firstWord ++ afterFirstWord
|
||||
where
|
||||
(beforeFirstWord, firstWordAndAfter) = span isSpace s
|
||||
(firstWord, afterFirstWord) = break isSpace firstWordAndAfter
|
||||
(firstWord, afterFirstWord) = break isSpace firstWordAndAfter
|
||||
|
@ -1,5 +1,6 @@
|
||||
module Common
|
||||
( WaspProjectDir
|
||||
) where
|
||||
( WaspProjectDir,
|
||||
)
|
||||
where
|
||||
|
||||
data WaspProjectDir -- Root dir of Wasp project, containing source files.
|
||||
|
@ -1,15 +1,15 @@
|
||||
module CompileOptions
|
||||
( CompileOptions(..)
|
||||
) where
|
||||
|
||||
import StrongPath (Path, Abs, Dir)
|
||||
import ExternalCode(SourceExternalCodeDir)
|
||||
( CompileOptions (..),
|
||||
)
|
||||
where
|
||||
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
-- TODO(martin): Should these be merged with Wasp data? Is it really a separate thing or not?
|
||||
-- It would be easier to pass around if it is part of Wasp data. But is it semantically correct?
|
||||
-- Maybe it is, even more than this!
|
||||
data CompileOptions = CompileOptions
|
||||
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
||||
, isBuild :: !Bool
|
||||
}
|
||||
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||
isBuild :: !Bool
|
||||
}
|
||||
|
@ -1,13 +1,12 @@
|
||||
module Data
|
||||
( DataDir
|
||||
, getAbsDataDirPath
|
||||
) where
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
( DataDir,
|
||||
getAbsDataDirPath,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Paths_waspc
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
data DataDir
|
||||
|
||||
|
@ -1,39 +1,40 @@
|
||||
module ExternalCode
|
||||
( File
|
||||
, filePathInExtCodeDir
|
||||
, fileAbsPath
|
||||
, fileText
|
||||
, readFiles
|
||||
, SourceExternalCodeDir
|
||||
) where
|
||||
( File,
|
||||
filePathInExtCodeDir,
|
||||
fileAbsPath,
|
||||
fileText,
|
||||
readFiles,
|
||||
SourceExternalCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import qualified Data.Text.Lazy as TextL
|
||||
import qualified Data.Text.Lazy.IO as TextL.IO
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Lazy as TextL
|
||||
import qualified Data.Text.Lazy.IO as TextL.IO
|
||||
import qualified Path as P
|
||||
|
||||
import qualified Util.IO
|
||||
import StrongPath (Path, Abs, Rel, Dir, (</>))
|
||||
import StrongPath (Abs, Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import WaspignoreFile (readWaspignoreFile, ignores)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import qualified Util.IO
|
||||
import WaspignoreFile (ignores, readWaspignoreFile)
|
||||
|
||||
-- | External code directory in Wasp source, from which external code files are read.
|
||||
data SourceExternalCodeDir
|
||||
|
||||
data File = File
|
||||
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File)
|
||||
, _extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
||||
, _text :: TextL.Text -- ^ File content. It will throw error when evaluated if file is not textual file.
|
||||
}
|
||||
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File),
|
||||
_extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||
-- | File content. It will throw error when evaluated if file is not textual file.
|
||||
_text :: TextL.Text
|
||||
}
|
||||
|
||||
instance Show File where
|
||||
show = show . _pathInExtCodeDir
|
||||
show = show . _pathInExtCodeDir
|
||||
|
||||
instance Eq File where
|
||||
f1 == f2 = _pathInExtCodeDir f1 == _pathInExtCodeDir f2
|
||||
f1 == f2 = _pathInExtCodeDir f1 == _pathInExtCodeDir f2
|
||||
|
||||
-- | Returns path relative to the external code directory.
|
||||
filePathInExtCodeDir :: File -> Path (Rel SourceExternalCodeDir) SP.File
|
||||
@ -54,33 +55,38 @@ waspignorePathInExtCodeDir = SP.fromPathRelFile [P.relfile|.waspignore|]
|
||||
-- except files ignores by the specified waspignore file.
|
||||
readFiles :: Path Abs (Dir SourceExternalCodeDir) -> IO [File]
|
||||
readFiles extCodeDirPath = do
|
||||
let waspignoreFilePath = extCodeDirPath </> waspignorePathInExtCodeDir
|
||||
waspignoreFile <- readWaspignoreFile waspignoreFilePath
|
||||
relFilePaths <- filter (not . ignores waspignoreFile . SP.toFilePath) .
|
||||
map SP.fromPathRelFile <$>
|
||||
Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
||||
let absFilePaths = map (extCodeDirPath </>) relFilePaths
|
||||
-- NOTE: We read text from all the files, regardless if they are text files or not, because
|
||||
-- we don't know if they are a text file or not.
|
||||
-- Since we do lazy reading (Text.Lazy), this is not a problem as long as we don't try to use
|
||||
-- text of a file that is actually not a text file -> then we will get an error when Haskell
|
||||
-- actually tries to read that file.
|
||||
-- TODO: We are doing lazy IO here, and there is an idea of it being a thing to avoid, due to no
|
||||
-- control over when resources are released and similar.
|
||||
-- If we do figure out that this is causing us problems, we could do the following refactoring:
|
||||
-- Don't read files at this point, just list them, and Wasp will contain just list of filepaths.
|
||||
-- Modify TextFileDraft so that it also takes text transformation function (Text -> Text),
|
||||
-- or create new file draft that will support that.
|
||||
-- In generator, when creating TextFileDraft, give it function/logic for text transformation,
|
||||
-- and it will be taken care of when draft will be written to the disk.
|
||||
fileTexts <- catMaybes <$> mapM (tryReadFile . SP.toFilePath) absFilePaths
|
||||
let files = map (\(path, text) -> File path extCodeDirPath text) (zip relFilePaths fileTexts)
|
||||
return files
|
||||
where
|
||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||
-- but then got deleted before actual reading was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
tryReadFile :: FilePath -> IO (Maybe TextL.Text)
|
||||
tryReadFile fp = (Just <$> TextL.IO.readFile fp) `catch` (\e -> if isDoesNotExistError e
|
||||
then return Nothing
|
||||
else throwIO e)
|
||||
let waspignoreFilePath = extCodeDirPath </> waspignorePathInExtCodeDir
|
||||
waspignoreFile <- readWaspignoreFile waspignoreFilePath
|
||||
relFilePaths <-
|
||||
filter (not . ignores waspignoreFile . SP.toFilePath)
|
||||
. map SP.fromPathRelFile
|
||||
<$> Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
||||
let absFilePaths = map (extCodeDirPath </>) relFilePaths
|
||||
-- NOTE: We read text from all the files, regardless if they are text files or not, because
|
||||
-- we don't know if they are a text file or not.
|
||||
-- Since we do lazy reading (Text.Lazy), this is not a problem as long as we don't try to use
|
||||
-- text of a file that is actually not a text file -> then we will get an error when Haskell
|
||||
-- actually tries to read that file.
|
||||
-- TODO: We are doing lazy IO here, and there is an idea of it being a thing to avoid, due to no
|
||||
-- control over when resources are released and similar.
|
||||
-- If we do figure out that this is causing us problems, we could do the following refactoring:
|
||||
-- Don't read files at this point, just list them, and Wasp will contain just list of filepaths.
|
||||
-- Modify TextFileDraft so that it also takes text transformation function (Text -> Text),
|
||||
-- or create new file draft that will support that.
|
||||
-- In generator, when creating TextFileDraft, give it function/logic for text transformation,
|
||||
-- and it will be taken care of when draft will be written to the disk.
|
||||
fileTexts <- catMaybes <$> mapM (tryReadFile . SP.toFilePath) absFilePaths
|
||||
let files = map (\(path, text) -> File path extCodeDirPath text) (zip relFilePaths fileTexts)
|
||||
return files
|
||||
where
|
||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||
-- but then got deleted before actual reading was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
tryReadFile :: FilePath -> IO (Maybe TextL.Text)
|
||||
tryReadFile fp =
|
||||
(Just <$> TextL.IO.readFile fp)
|
||||
`catch` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return Nothing
|
||||
else throwIO e
|
||||
)
|
||||
|
@ -1,30 +1,29 @@
|
||||
module Generator
|
||||
( writeWebAppCode
|
||||
, Generator.Setup.setup
|
||||
, Generator.Start.start
|
||||
) where
|
||||
( writeWebAppCode,
|
||||
Generator.Setup.setup,
|
||||
Generator.Start.start,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.IO
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock
|
||||
import qualified Data.Version
|
||||
import qualified Path as P
|
||||
import qualified Paths_waspc
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (genDb)
|
||||
import Generator.FileDraft (FileDraft, write)
|
||||
import Generator.ServerGenerator (genServer)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (genDb)
|
||||
import Generator.DockerGenerator (genDockerFiles)
|
||||
import Generator.FileDraft (FileDraft, write)
|
||||
import Generator.ServerGenerator (genServer)
|
||||
import qualified Generator.ServerGenerator as ServerGenerator
|
||||
import Generator.DockerGenerator (genDockerFiles)
|
||||
import qualified Generator.Setup
|
||||
import qualified Generator.Start
|
||||
import Generator.WebAppGenerator (generateWebApp)
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
|
||||
import Generator.WebAppGenerator (generateWebApp)
|
||||
import qualified Path as P
|
||||
import qualified Paths_waspc
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
|
||||
-- | Generates web app code from given Wasp and writes it to given destination directory.
|
||||
-- If dstDir does not exist yet, it will be created.
|
||||
@ -33,12 +32,12 @@ import Wasp (Wasp)
|
||||
-- from user's machine. Maybe we just overwrite and we are good?
|
||||
writeWebAppCode :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
||||
writeWebAppCode wasp dstDir compileOptions = do
|
||||
writeFileDrafts dstDir (generateWebApp wasp compileOptions)
|
||||
ServerGenerator.preCleanup wasp dstDir compileOptions
|
||||
writeFileDrafts dstDir (genServer wasp compileOptions)
|
||||
writeFileDrafts dstDir (genDb wasp compileOptions)
|
||||
writeFileDrafts dstDir (genDockerFiles wasp compileOptions)
|
||||
writeDotWaspInfo dstDir
|
||||
writeFileDrafts dstDir (generateWebApp wasp compileOptions)
|
||||
ServerGenerator.preCleanup wasp dstDir compileOptions
|
||||
writeFileDrafts dstDir (genServer wasp compileOptions)
|
||||
writeFileDrafts dstDir (genDb wasp compileOptions)
|
||||
writeFileDrafts dstDir (genDockerFiles wasp compileOptions)
|
||||
writeDotWaspInfo dstDir
|
||||
|
||||
-- | Writes file drafts while using given destination dir as root dir.
|
||||
-- TODO(martin): We could/should parallelize this.
|
||||
@ -49,8 +48,8 @@ writeFileDrafts dstDir = mapM_ (write dstDir)
|
||||
-- | Writes .waspinfo, which contains some basic metadata about how/when wasp generated the code.
|
||||
writeDotWaspInfo :: Path Abs (Dir ProjectRootDir) -> IO ()
|
||||
writeDotWaspInfo dstDir = do
|
||||
currentTime <- getCurrentTime
|
||||
let version = Data.Version.showVersion Paths_waspc.version
|
||||
let content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ."
|
||||
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
||||
Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content)
|
||||
currentTime <- getCurrentTime
|
||||
let version = Data.Version.showVersion Paths_waspc.version
|
||||
let content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ."
|
||||
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
||||
Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content)
|
||||
|
@ -1,8 +1,9 @@
|
||||
module Generator.Common
|
||||
( ProjectRootDir
|
||||
, nodeVersion
|
||||
, nodeVersionAsText
|
||||
) where
|
||||
( ProjectRootDir,
|
||||
nodeVersion,
|
||||
nodeVersionAsText,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Printf (printf)
|
||||
|
||||
@ -16,4 +17,5 @@ nodeVersion = (12, 18, 0) -- Latest LTS version.
|
||||
|
||||
nodeVersionAsText :: String
|
||||
nodeVersionAsText = printf "%d.%d.%d" major minor patch
|
||||
where (major, minor, patch) = nodeVersion
|
||||
where
|
||||
(major, minor, patch) = nodeVersion
|
||||
|
@ -1,30 +1,31 @@
|
||||
module Generator.DbGenerator
|
||||
( genDb
|
||||
, dbRootDirInProjectRootDir
|
||||
, dbSchemaFileInProjectRootDir
|
||||
) where
|
||||
( genDb,
|
||||
dbRootDirInProjectRootDir,
|
||||
dbSchemaFileInProjectRootDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Path as P
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
import qualified Psl.Ast.Model
|
||||
import qualified Psl.Generator.Model
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Db
|
||||
import Wasp.Entity (Entity)
|
||||
import Wasp.Entity (Entity)
|
||||
import qualified Wasp.Entity
|
||||
|
||||
-- * Path definitions
|
||||
|
||||
data DbRootDir
|
||||
|
||||
data DbTemplatesDir
|
||||
|
||||
dbRootDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir DbRootDir)
|
||||
@ -48,29 +49,32 @@ dbSchemaFileInProjectRootDir = dbRootDirInProjectRootDir </> dbSchemaFileInDbRoo
|
||||
|
||||
genDb :: Wasp -> CompileOptions -> [FileDraft]
|
||||
genDb wasp _ =
|
||||
[ genPrismaSchema wasp
|
||||
]
|
||||
[ genPrismaSchema wasp
|
||||
]
|
||||
|
||||
genPrismaSchema :: Wasp -> FileDraft
|
||||
genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templateData)
|
||||
where
|
||||
dstPath = dbSchemaFileInProjectRootDir
|
||||
tmplSrcPath = dbTemplatesDirInTemplatesDir </> dbSchemaFileInDbTemplatesDir
|
||||
where
|
||||
dstPath = dbSchemaFileInProjectRootDir
|
||||
tmplSrcPath = dbTemplatesDirInTemplatesDir </> dbSchemaFileInDbTemplatesDir
|
||||
|
||||
templateData = object
|
||||
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp)
|
||||
, "datasourceProvider" .= (datasourceProvider :: String)
|
||||
, "datasourceUrl" .= (datasourceUrl :: String)
|
||||
]
|
||||
templateData =
|
||||
object
|
||||
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp),
|
||||
"datasourceProvider" .= (datasourceProvider :: String),
|
||||
"datasourceUrl" .= (datasourceUrl :: String)
|
||||
]
|
||||
|
||||
dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp
|
||||
(datasourceProvider, datasourceUrl) = case dbSystem of
|
||||
Wasp.Db.PostgreSQL -> ("postgresql", "env(\"DATABASE_URL\")")
|
||||
-- TODO: Report this error with some better mechanism, not `error`.
|
||||
Wasp.Db.SQLite -> if Wasp.getIsBuild wasp
|
||||
then error "SQLite is not supported in production. Set db.system to smth else."
|
||||
else ("sqlite", "\"file:./dev.db\"")
|
||||
dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp
|
||||
(datasourceProvider, datasourceUrl) = case dbSystem of
|
||||
Wasp.Db.PostgreSQL -> ("postgresql", "env(\"DATABASE_URL\")")
|
||||
-- TODO: Report this error with some better mechanism, not `error`.
|
||||
Wasp.Db.SQLite ->
|
||||
if Wasp.getIsBuild wasp
|
||||
then error "SQLite is not supported in production. Set db.system to smth else."
|
||||
else ("sqlite", "\"file:./dev.db\"")
|
||||
|
||||
entityToPslModelSchema :: Entity -> String
|
||||
entityToPslModelSchema entity = Psl.Generator.Model.generateModel $
|
||||
Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody entity)
|
||||
entityToPslModelSchema :: Entity -> String
|
||||
entityToPslModelSchema entity =
|
||||
Psl.Generator.Model.generateModel $
|
||||
Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody entity)
|
||||
|
@ -1,36 +1,47 @@
|
||||
module Generator.DbGenerator.Jobs
|
||||
( migrateDev
|
||||
, runStudio
|
||||
) where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ServerGenerator.Common (serverRootDirInProjectRootDir)
|
||||
import Generator.DbGenerator (dbSchemaFileInProjectRootDir)
|
||||
( migrateDev,
|
||||
runStudio,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (dbSchemaFileInProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.ServerGenerator.Common (serverRootDirInProjectRootDir)
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
migrateDev :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
migrateDev projectDir = do
|
||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||
|
||||
-- NOTE(matija): We are running this command from server's root dir since that is where
|
||||
-- Prisma packages (cli and client) are currently installed.
|
||||
runNodeCommandAsJob serverDir "npx"
|
||||
[ "prisma", "migrate", "dev"
|
||||
, "--schema", SP.toFilePath schemaFile
|
||||
] J.Db
|
||||
-- NOTE(matija): We are running this command from server's root dir since that is where
|
||||
-- Prisma packages (cli and client) are currently installed.
|
||||
runNodeCommandAsJob
|
||||
serverDir
|
||||
"npx"
|
||||
[ "prisma",
|
||||
"migrate",
|
||||
"dev",
|
||||
"--schema",
|
||||
SP.toFilePath schemaFile
|
||||
]
|
||||
J.Db
|
||||
|
||||
-- | Runs `prisma studio` - Prisma's db inspector.
|
||||
runStudio :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
runStudio projectDir = do
|
||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||
|
||||
runNodeCommandAsJob serverDir "npx"
|
||||
[ "prisma", "studio"
|
||||
, "--schema", SP.toFilePath schemaFile
|
||||
] J.Db
|
||||
runNodeCommandAsJob
|
||||
serverDir
|
||||
"npx"
|
||||
[ "prisma",
|
||||
"studio",
|
||||
"--schema",
|
||||
SP.toFilePath schemaFile
|
||||
]
|
||||
J.Db
|
||||
|
@ -1,30 +1,32 @@
|
||||
module Generator.DbGenerator.Operations
|
||||
( migrateDev
|
||||
) where
|
||||
( migrateDev,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, newChan, readChan)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Job.IO (printJobMessage)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job (JobMessage)
|
||||
import qualified Generator.DbGenerator.Jobs as DbJobs
|
||||
import Generator.Job (JobMessage)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.IO (printJobMessage)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
printJobMsgsUntilExitReceived :: Chan JobMessage -> IO ()
|
||||
printJobMsgsUntilExitReceived chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan
|
||||
J.JobExit {} -> return ()
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan
|
||||
J.JobExit {} -> return ()
|
||||
|
||||
migrateDev :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
migrateDev projectDir = do
|
||||
chan <- newChan
|
||||
(_, dbExitCode) <- concurrently (printJobMsgsUntilExitReceived chan)
|
||||
(DbJobs.migrateDev projectDir chan)
|
||||
case dbExitCode of
|
||||
ExitSuccess -> return (Right ())
|
||||
ExitFailure code -> return $ Left $ "Migrate (dev) failed with exit code: " ++ show code
|
||||
chan <- newChan
|
||||
(_, dbExitCode) <-
|
||||
concurrently
|
||||
(printJobMsgsUntilExitReceived chan)
|
||||
(DbJobs.migrateDev projectDir chan)
|
||||
case dbExitCode of
|
||||
ExitSuccess -> return (Right ())
|
||||
ExitFailure code -> return $ Left $ "Migrate (dev) failed with exit code: " ++ show code
|
||||
|
@ -1,36 +1,41 @@
|
||||
module Generator.DockerGenerator
|
||||
( genDockerFiles
|
||||
) where
|
||||
( genDockerFiles,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import Wasp (Wasp)
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
genDockerFiles :: Wasp -> CompileOptions -> [FileDraft]
|
||||
genDockerFiles wasp _ = concat
|
||||
[ [genDockerfile wasp]
|
||||
, [genDockerignore wasp]
|
||||
genDockerFiles wasp _ =
|
||||
concat
|
||||
[ [genDockerfile wasp],
|
||||
[genDockerignore wasp]
|
||||
]
|
||||
|
||||
-- TODO: Inject paths to server and db files/dirs, right now they are hardcoded in the templates.
|
||||
genDockerfile :: Wasp -> FileDraft
|
||||
genDockerfile wasp = createTemplateFileDraft
|
||||
genDockerfile wasp =
|
||||
createTemplateFileDraft
|
||||
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel ProjectRootDir) File)
|
||||
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel TemplatesDir) File)
|
||||
(Just $ object
|
||||
[ "usingPrisma" .= not (null $ Wasp.getPSLEntities wasp)
|
||||
])
|
||||
( Just $
|
||||
object
|
||||
[ "usingPrisma" .= not (null $ Wasp.getPSLEntities wasp)
|
||||
]
|
||||
)
|
||||
|
||||
genDockerignore :: Wasp -> FileDraft
|
||||
genDockerignore _ = createTemplateFileDraft
|
||||
genDockerignore _ =
|
||||
createTemplateFileDraft
|
||||
(SP.fromPathRelFile [P.relfile|.dockerignore|] :: Path (Rel ProjectRootDir) File)
|
||||
(SP.fromPathRelFile [P.relfile|dockerignore|] :: Path (Rel TemplatesDir) File)
|
||||
Nothing
|
||||
|
@ -1,39 +1,38 @@
|
||||
module Generator.ExternalCodeGenerator
|
||||
( generateExternalCodeDir
|
||||
) where
|
||||
( generateExternalCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
import StrongPath (Path, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified ExternalCode as EC
|
||||
import qualified Generator.FileDraft as FD
|
||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Js (generateJsFile)
|
||||
|
||||
import qualified Generator.FileDraft as FD
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.FilePath as FP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
-- | Takes external code files from Wasp and generates them in new location as part of the generated project.
|
||||
-- It might not just copy them but also do some changes on them, as needed.
|
||||
generateExternalCodeDir :: C.ExternalCodeGeneratorStrategy
|
||||
-> Wasp
|
||||
-> [FD.FileDraft]
|
||||
generateExternalCodeDir ::
|
||||
C.ExternalCodeGeneratorStrategy ->
|
||||
Wasp ->
|
||||
[FD.FileDraft]
|
||||
generateExternalCodeDir strategy wasp =
|
||||
map (generateFile strategy) (Wasp.getExternalCodeFiles wasp)
|
||||
map (generateFile strategy) (Wasp.getExternalCodeFiles wasp)
|
||||
|
||||
generateFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||
generateFile strategy file
|
||||
| extension `elem` [".js", ".jsx"] = generateJsFile strategy file
|
||||
| otherwise = let relDstPath = (C._extCodeDirInProjectRootDir strategy)
|
||||
</> dstPathInGenExtCodeDir
|
||||
absSrcPath = EC.fileAbsPath file
|
||||
in FD.createCopyFileDraft relDstPath absSrcPath
|
||||
| extension `elem` [".js", ".jsx"] = generateJsFile strategy file
|
||||
| otherwise =
|
||||
let relDstPath =
|
||||
(C._extCodeDirInProjectRootDir strategy)
|
||||
</> dstPathInGenExtCodeDir
|
||||
absSrcPath = EC.fileAbsPath file
|
||||
in FD.createCopyFileDraft relDstPath absSrcPath
|
||||
where
|
||||
dstPathInGenExtCodeDir :: Path (Rel C.GeneratedExternalCodeDir) File
|
||||
dstPathInGenExtCodeDir = C.castRelPathFromSrcToGenExtCodeDir $ EC.filePathInExtCodeDir file
|
||||
|
||||
extension = FP.takeExtension $ SP.toFilePath $ EC.filePathInExtCodeDir file
|
||||
|
||||
|
||||
|
||||
|
@ -1,17 +1,17 @@
|
||||
module Generator.ExternalCodeGenerator.Common
|
||||
( ExternalCodeGeneratorStrategy(..)
|
||||
, GeneratedExternalCodeDir
|
||||
, castRelPathFromSrcToGenExtCodeDir
|
||||
, asGenExtFile
|
||||
) where
|
||||
( ExternalCodeGeneratorStrategy (..),
|
||||
GeneratedExternalCodeDir,
|
||||
castRelPathFromSrcToGenExtCodeDir,
|
||||
asGenExtFile,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir)
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Path to the directory where ext code will be generated.
|
||||
data GeneratedExternalCodeDir
|
||||
@ -23,9 +23,9 @@ castRelPathFromSrcToGenExtCodeDir :: Path (Rel SourceExternalCodeDir) a -> Path
|
||||
castRelPathFromSrcToGenExtCodeDir = SP.castRel
|
||||
|
||||
data ExternalCodeGeneratorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ -- | Takes a path where the external code js file will be generated.
|
||||
-- Also takes text of the file. Returns text where special @wasp imports have been replaced with
|
||||
-- imports that will work.
|
||||
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text
|
||||
, _extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
||||
}
|
||||
{ -- | Takes a path where the external code js file will be generated.
|
||||
-- Also takes text of the file. Returns text where special @wasp imports have been replaced with
|
||||
-- imports that will work.
|
||||
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text,
|
||||
_extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
||||
}
|
||||
|
@ -1,20 +1,19 @@
|
||||
module Generator.ExternalCodeGenerator.Js
|
||||
( generateJsFile
|
||||
, resolveJsFileWaspImportsForExtCodeDir
|
||||
) where
|
||||
( generateJsFile,
|
||||
resolveJsFileWaspImportsForExtCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Regex.TDFA as TR
|
||||
import Data.Text (Text, unpack)
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Path.Extra (reversePosixPath, toPosixFilePath)
|
||||
import qualified Generator.FileDraft as FD
|
||||
import qualified Data.Text as T
|
||||
import qualified ExternalCode as EC
|
||||
import Generator.ExternalCodeGenerator.Common (GeneratedExternalCodeDir)
|
||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
||||
|
||||
import qualified Generator.FileDraft as FD
|
||||
import Path.Extra (reversePosixPath, toPosixFilePath)
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified Text.Regex.TDFA as TR
|
||||
|
||||
generateJsFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||
generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
||||
@ -29,14 +28,18 @@ generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
||||
dstPath = (C._extCodeDirInProjectRootDir strategy) </> filePathInGenExtCodeDir
|
||||
|
||||
-- | Replaces imports that start with "@wasp/" with imports that start from the src dir of the app.
|
||||
resolveJsFileWaspImportsForExtCodeDir
|
||||
:: Path (Rel ()) (Dir GeneratedExternalCodeDir) -- ^ Relative path of ext code dir in src dir of app (web app, server (app), ...)
|
||||
-> Path (Rel GeneratedExternalCodeDir) File -- ^ Path where this JS file will be generated.
|
||||
-> Text -- ^ Original text of the file.
|
||||
-> Text -- ^ Text of the file with special "@wasp" imports resolved (replaced with normal JS imports).
|
||||
resolveJsFileWaspImportsForExtCodeDir ::
|
||||
-- | Relative path of ext code dir in src dir of app (web app, server (app), ...)
|
||||
Path (Rel ()) (Dir GeneratedExternalCodeDir) ->
|
||||
-- | Path where this JS file will be generated.
|
||||
Path (Rel GeneratedExternalCodeDir) File ->
|
||||
-- | Original text of the file.
|
||||
Text ->
|
||||
-- | Text of the file with special "@wasp" imports resolved (replaced with normal JS imports).
|
||||
Text
|
||||
resolveJsFileWaspImportsForExtCodeDir extCodeDirInAppSrcDir jsFileDstPathInExtCodeDir jsFileText =
|
||||
let matches = concat (unpack jsFileText TR.=~ ("(from +['\"]@wasp/)" :: String) :: [[String]])
|
||||
in foldr replaceFromWasp jsFileText matches
|
||||
let matches = concat (unpack jsFileText TR.=~ ("(from +['\"]@wasp/)" :: String) :: [[String]])
|
||||
in foldr replaceFromWasp jsFileText matches
|
||||
where
|
||||
replaceFromWasp fromWasp = T.replace (T.pack fromWasp) (T.pack $ transformFromWasp fromWasp)
|
||||
transformFromWasp fromWasp = (reverse $ drop (length ("@wasp/" :: String)) $ reverse fromWasp) ++ pathPrefix ++ "/"
|
||||
|
@ -1,65 +1,68 @@
|
||||
module Generator.FileDraft
|
||||
( FileDraft(..)
|
||||
, Writeable(..)
|
||||
, createTemplateFileDraft
|
||||
, createCopyFileDraft
|
||||
, createCopyFileDraftIfExists
|
||||
, createTextFileDraft
|
||||
) where
|
||||
( FileDraft (..),
|
||||
Writeable (..),
|
||||
createTemplateFileDraft,
|
||||
createCopyFileDraft,
|
||||
createCopyFileDraftIfExists,
|
||||
createTextFileDraft,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
|
||||
import StrongPath (Path, Abs, Rel, File)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import qualified Generator.FileDraft.TemplateFileDraft as TmplFD
|
||||
import qualified Generator.FileDraft.CopyFileDraft as CopyFD
|
||||
import qualified Generator.FileDraft.TemplateFileDraft as TmplFD
|
||||
import qualified Generator.FileDraft.TextFileDraft as TextFD
|
||||
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import StrongPath (Abs, File, Path, Rel)
|
||||
|
||||
-- | 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
|
||||
-- collection when needed.
|
||||
data FileDraft
|
||||
= FileDraftTemplateFd TmplFD.TemplateFileDraft
|
||||
| FileDraftCopyFd CopyFD.CopyFileDraft
|
||||
| FileDraftTextFd TextFD.TextFileDraft
|
||||
deriving (Show, Eq)
|
||||
= FileDraftTemplateFd TmplFD.TemplateFileDraft
|
||||
| FileDraftCopyFd CopyFD.CopyFileDraft
|
||||
| FileDraftTextFd TextFD.TextFileDraft
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Writeable FileDraft where
|
||||
write dstDir (FileDraftTemplateFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftCopyFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftTextFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftTemplateFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftCopyFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftTextFd draft) = write dstDir draft
|
||||
|
||||
|
||||
createTemplateFileDraft :: Path (Rel ProjectRootDir) File
|
||||
-> Path (Rel TemplatesDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
createTemplateFileDraft ::
|
||||
Path (Rel ProjectRootDir) File ->
|
||||
Path (Rel TemplatesDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
createTemplateFileDraft dstPath tmplSrcPath tmplData =
|
||||
FileDraftTemplateFd $ TmplFD.TemplateFileDraft { TmplFD._dstPath = dstPath
|
||||
, TmplFD._srcPathInTmplDir = tmplSrcPath
|
||||
, TmplFD._tmplData = tmplData
|
||||
}
|
||||
FileDraftTemplateFd $
|
||||
TmplFD.TemplateFileDraft
|
||||
{ TmplFD._dstPath = dstPath,
|
||||
TmplFD._srcPathInTmplDir = tmplSrcPath,
|
||||
TmplFD._tmplData = tmplData
|
||||
}
|
||||
|
||||
createCopyFileDraft :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||
createCopyFileDraft dstPath srcPath =
|
||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath
|
||||
, CopyFD._srcPath = srcPath
|
||||
, CopyFD._failIfSrcDoesNotExist = True
|
||||
}
|
||||
FileDraftCopyFd $
|
||||
CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath,
|
||||
CopyFD._srcPath = srcPath,
|
||||
CopyFD._failIfSrcDoesNotExist = True
|
||||
}
|
||||
|
||||
createCopyFileDraftIfExists :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||
createCopyFileDraftIfExists dstPath srcPath =
|
||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath
|
||||
, CopyFD._srcPath = srcPath
|
||||
, CopyFD._failIfSrcDoesNotExist = False
|
||||
}
|
||||
FileDraftCopyFd $
|
||||
CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath,
|
||||
CopyFD._srcPath = srcPath,
|
||||
CopyFD._failIfSrcDoesNotExist = False
|
||||
}
|
||||
|
||||
createTextFileDraft :: Path (Rel ProjectRootDir) File -> Text -> FileDraft
|
||||
createTextFileDraft dstPath content =
|
||||
FileDraftTextFd $ TextFD.TextFileDraft { TextFD._dstPath = dstPath, TextFD._content = content}
|
||||
FileDraftTextFd $ TextFD.TextFileDraft {TextFD._dstPath = dstPath, TextFD._content = content}
|
||||
|
@ -1,44 +1,49 @@
|
||||
module Generator.FileDraft.CopyFileDraft
|
||||
( CopyFileDraft(..)
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import System.IO.Error (doesNotExistErrorType, mkIOError)
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
import StrongPath (Abs, File, Path, Rel,
|
||||
(</>))
|
||||
import qualified StrongPath as SP
|
||||
( CopyFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
import StrongPath
|
||||
( Abs,
|
||||
File,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
import System.IO.Error (doesNotExistErrorType, mkIOError)
|
||||
|
||||
-- | File draft based purely on another file, that is just copied.
|
||||
data CopyFileDraft = CopyFileDraft
|
||||
{ -- | Path where the file will be copied to.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File)
|
||||
-- | Absolute path of source file to copy.
|
||||
, _srcPath :: !(Path Abs File)
|
||||
, _failIfSrcDoesNotExist :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ -- | Path where the file will be copied to.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
-- | Absolute path of source file to copy.
|
||||
_srcPath :: !(Path Abs File),
|
||||
_failIfSrcDoesNotExist :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Writeable CopyFileDraft where
|
||||
write absDstDirPath draft = do
|
||||
srcFileExists <- doesFileExist srcFilePath
|
||||
if srcFileExists
|
||||
then do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
copyFile srcFilePath (SP.toFilePath absDraftDstPath)
|
||||
else
|
||||
when
|
||||
(_failIfSrcDoesNotExist draft)
|
||||
(throwIO $ mkIOError
|
||||
doesNotExistErrorType
|
||||
"Source file of CopyFileDraft does not exist."
|
||||
Nothing
|
||||
(Just srcFilePath)
|
||||
)
|
||||
where
|
||||
srcFilePath = SP.toFilePath $ _srcPath draft
|
||||
absDraftDstPath = absDstDirPath </> _dstPath draft
|
||||
write absDstDirPath draft = do
|
||||
srcFileExists <- doesFileExist srcFilePath
|
||||
if srcFileExists
|
||||
then do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
copyFile srcFilePath (SP.toFilePath absDraftDstPath)
|
||||
else
|
||||
when
|
||||
(_failIfSrcDoesNotExist draft)
|
||||
( throwIO $
|
||||
mkIOError
|
||||
doesNotExistErrorType
|
||||
"Source file of CopyFileDraft does not exist."
|
||||
Nothing
|
||||
(Just srcFilePath)
|
||||
)
|
||||
where
|
||||
srcFilePath = SP.toFilePath $ _srcPath draft
|
||||
absDraftDstPath = absDstDirPath </> _dstPath draft
|
||||
|
@ -1,34 +1,37 @@
|
||||
module Generator.FileDraft.TemplateFileDraft
|
||||
( TemplateFileDraft(..)
|
||||
) where
|
||||
( TemplateFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
|
||||
import StrongPath (Path, Abs, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import StrongPath (Abs, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | File draft based on template file that gets combined with data.
|
||||
data TemplateFileDraft = TemplateFileDraft
|
||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
||||
, _srcPathInTmplDir :: !(Path (Rel TemplatesDir) File) -- ^ Path of template source file.
|
||||
, _tmplData :: Maybe Aeson.Value -- ^ Data to be fed to the template while rendering it.
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ -- | Path where file will be generated.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
-- | Path of template source file.
|
||||
_srcPathInTmplDir :: !(Path (Rel TemplatesDir) File),
|
||||
-- | Data to be fed to the template while rendering it.
|
||||
_tmplData :: Maybe Aeson.Value
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Writeable TemplateFileDraft where
|
||||
write absDstDirPath draft = do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
case _tmplData draft of
|
||||
Nothing -> do
|
||||
absDraftSrcPath <- getTemplateFileAbsPath (_srcPathInTmplDir draft)
|
||||
copyFile (SP.toFilePath absDraftSrcPath) (SP.toFilePath absDraftDstPath)
|
||||
Just tmplData -> do
|
||||
content <- compileAndRenderTemplate (_srcPathInTmplDir draft) tmplData
|
||||
writeFileFromText (SP.toFilePath absDraftDstPath) content
|
||||
where
|
||||
absDraftDstPath :: Path Abs File
|
||||
absDraftDstPath = absDstDirPath </> (_dstPath draft)
|
||||
write absDstDirPath draft = do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
case _tmplData draft of
|
||||
Nothing -> do
|
||||
absDraftSrcPath <- getTemplateFileAbsPath (_srcPathInTmplDir draft)
|
||||
copyFile (SP.toFilePath absDraftSrcPath) (SP.toFilePath absDraftDstPath)
|
||||
Just tmplData -> do
|
||||
content <- compileAndRenderTemplate (_srcPathInTmplDir draft) tmplData
|
||||
writeFileFromText (SP.toFilePath absDraftDstPath) content
|
||||
where
|
||||
absDraftDstPath :: Path Abs File
|
||||
absDraftDstPath = absDstDirPath </> (_dstPath draft)
|
||||
|
@ -1,26 +1,26 @@
|
||||
module Generator.FileDraft.TextFileDraft
|
||||
( TextFileDraft(..)
|
||||
) where
|
||||
( TextFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text (Text)
|
||||
|
||||
import StrongPath (Path, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | File draft based on text, that is to be written to file when time comes.
|
||||
data TextFileDraft = TextFileDraft
|
||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
||||
, _content :: Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ -- | Path where file will be generated.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
_content :: Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Writeable TextFileDraft where
|
||||
write dstDir draft = do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
writeFileFromText (SP.toFilePath absDraftDstPath) (_content draft)
|
||||
where
|
||||
absDraftDstPath = dstDir </> (_dstPath draft)
|
||||
write dstDir draft = do
|
||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||
writeFileFromText (SP.toFilePath absDraftDstPath) (_content draft)
|
||||
where
|
||||
absDraftDstPath = dstDir </> (_dstPath draft)
|
||||
|
@ -1,15 +1,16 @@
|
||||
module Generator.FileDraft.Writeable
|
||||
( Writeable(..)
|
||||
) where
|
||||
( Writeable (..),
|
||||
)
|
||||
where
|
||||
|
||||
import StrongPath (Path, Abs, Dir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
class Writeable w where
|
||||
-- | Write file somewhere in the provided project root directory.
|
||||
write :: (WriteableMonad m)
|
||||
=> Path Abs (Dir ProjectRootDir)
|
||||
-> w
|
||||
-> m ()
|
||||
-- | Write file somewhere in the provided project root directory.
|
||||
write ::
|
||||
(WriteableMonad m) =>
|
||||
Path Abs (Dir ProjectRootDir) ->
|
||||
w ->
|
||||
m ()
|
||||
|
@ -1,67 +1,77 @@
|
||||
module Generator.FileDraft.WriteableMonad
|
||||
( WriteableMonad(..)
|
||||
) where
|
||||
( WriteableMonad (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO
|
||||
import qualified Generator.Templates as Templates
|
||||
import StrongPath (Abs, Dir, File, Path, Rel)
|
||||
import qualified System.Directory
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (Exception, catch)
|
||||
import qualified UnliftIO.Exception as E
|
||||
|
||||
import qualified Generator.Templates as Templates
|
||||
import StrongPath (Abs, Dir, File, Path, Rel)
|
||||
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (Exception, catch)
|
||||
import qualified UnliftIO.Exception as E
|
||||
|
||||
-- TODO: Should we use DI via data instead of typeclasses?
|
||||
-- https://news.ycombinator.com/item?id=10392044
|
||||
|
||||
-- | Describes effects needed by File Drafts.
|
||||
class (MonadIO m) => WriteableMonad m where
|
||||
createDirectoryIfMissing
|
||||
:: Bool -- ^ True if parents should also be created.
|
||||
-> FilePath -- ^ Path to the directory to create.
|
||||
-> m ()
|
||||
createDirectoryIfMissing ::
|
||||
-- | True if parents should also be created.
|
||||
Bool ->
|
||||
-- | Path to the directory to create.
|
||||
FilePath ->
|
||||
m ()
|
||||
|
||||
copyFile
|
||||
:: FilePath -- ^ Src path.
|
||||
-> FilePath -- ^ Dst path.
|
||||
-> m ()
|
||||
copyFile ::
|
||||
-- | Src path.
|
||||
FilePath ->
|
||||
-- | Dst path.
|
||||
FilePath ->
|
||||
m ()
|
||||
|
||||
doesFileExist :: FilePath -> m Bool
|
||||
doesFileExist :: FilePath -> m Bool
|
||||
|
||||
writeFileFromText :: FilePath -> Text -> m ()
|
||||
writeFileFromText :: FilePath -> Text -> m ()
|
||||
|
||||
getTemplateFileAbsPath
|
||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
||||
-> m (Path Abs File)
|
||||
getTemplateFileAbsPath ::
|
||||
-- | Template file path.
|
||||
Path (Rel Templates.TemplatesDir) File ->
|
||||
m (Path Abs File)
|
||||
|
||||
getTemplatesDirAbsPath :: m (Path Abs (Dir Templates.TemplatesDir))
|
||||
getTemplatesDirAbsPath :: m (Path Abs (Dir Templates.TemplatesDir))
|
||||
|
||||
compileAndRenderTemplate
|
||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
||||
-> m Text
|
||||
compileAndRenderTemplate ::
|
||||
-- | Template file path.
|
||||
Path (Rel Templates.TemplatesDir) File ->
|
||||
-- | JSON to be provided as template data.
|
||||
Aeson.Value ->
|
||||
m Text
|
||||
|
||||
throwIO :: (Exception e) => e -> m a
|
||||
throwIO :: (Exception e) => e -> m a
|
||||
|
||||
instance WriteableMonad IO where
|
||||
createDirectoryIfMissing = System.Directory.createDirectoryIfMissing
|
||||
-- TODO(matija): we should rename this function to make it clear it won't throw an exception when
|
||||
-- a file does not exist.
|
||||
copyFile src dst = do
|
||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||
-- when the filedraft was created but then got deleted before actual copying was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
System.Directory.copyFile src dst `catch` (\e -> if isDoesNotExistError e
|
||||
then return ()
|
||||
else throwIO e)
|
||||
createDirectoryIfMissing = System.Directory.createDirectoryIfMissing
|
||||
|
||||
doesFileExist = System.Directory.doesFileExist
|
||||
writeFileFromText = Data.Text.IO.writeFile
|
||||
getTemplateFileAbsPath = Templates.getTemplateFileAbsPath
|
||||
getTemplatesDirAbsPath = Templates.getTemplatesDirAbsPath
|
||||
compileAndRenderTemplate = Templates.compileAndRenderTemplate
|
||||
throwIO = E.throwIO
|
||||
-- TODO(matija): we should rename this function to make it clear it won't throw an exception when
|
||||
-- a file does not exist.
|
||||
copyFile src dst = do
|
||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||
-- when the filedraft was created but then got deleted before actual copying was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
System.Directory.copyFile src dst
|
||||
`catch` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return ()
|
||||
else throwIO e
|
||||
)
|
||||
|
||||
doesFileExist = System.Directory.doesFileExist
|
||||
writeFileFromText = Data.Text.IO.writeFile
|
||||
getTemplateFileAbsPath = Templates.getTemplateFileAbsPath
|
||||
getTemplatesDirAbsPath = Templates.getTemplatesDirAbsPath
|
||||
compileAndRenderTemplate = Templates.compileAndRenderTemplate
|
||||
throwIO = E.throwIO
|
||||
|
@ -1,29 +1,30 @@
|
||||
module Generator.Job
|
||||
( Job
|
||||
, JobMessage (..)
|
||||
, JobMessageData (..)
|
||||
, JobOutputType (..)
|
||||
, JobType (..)
|
||||
) where
|
||||
|
||||
import Control.Concurrent (Chan)
|
||||
import Data.Text (Text)
|
||||
import System.Exit (ExitCode)
|
||||
( Job,
|
||||
JobMessage (..),
|
||||
JobMessageData (..),
|
||||
JobOutputType (..),
|
||||
JobType (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan)
|
||||
import Data.Text (Text)
|
||||
import System.Exit (ExitCode)
|
||||
|
||||
-- | Job is an IO action that communicates progress by writing messages to given channel
|
||||
-- until it is done, when it returns exit code.
|
||||
type Job = Chan JobMessage -> IO ExitCode
|
||||
|
||||
data JobMessage = JobMessage
|
||||
{ _data :: JobMessageData
|
||||
, _jobType :: JobType
|
||||
}
|
||||
deriving (Show)
|
||||
{ _data :: JobMessageData,
|
||||
_jobType :: JobType
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data JobMessageData = JobOutput Text JobOutputType
|
||||
| JobExit ExitCode
|
||||
deriving (Show)
|
||||
data JobMessageData
|
||||
= JobOutput Text JobOutputType
|
||||
| JobExit ExitCode
|
||||
deriving (Show)
|
||||
|
||||
data JobOutputType = Stdout | Stderr deriving (Show, Eq)
|
||||
|
||||
|
@ -1,67 +1,67 @@
|
||||
module Generator.Job.IO
|
||||
( readJobMessagesAndPrintThemPrefixed
|
||||
, printPrefixedJobMessage
|
||||
, printJobMessage
|
||||
) where
|
||||
( readJobMessagesAndPrintThemPrefixed,
|
||||
printPrefixedJobMessage,
|
||||
printJobMessage,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, readChan)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T.IO
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO (Handle, hFlush, stderr, stdout)
|
||||
|
||||
import qualified Generator.Job as J
|
||||
import qualified Util.Terminal as Term
|
||||
import Control.Concurrent (Chan, readChan)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T.IO
|
||||
import qualified Generator.Job as J
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO (Handle, hFlush, stderr, stdout)
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
readJobMessagesAndPrintThemPrefixed :: Chan J.JobMessage -> IO ()
|
||||
readJobMessagesAndPrintThemPrefixed =
|
||||
let go prevJobMsg chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg >> go (Just jobMsg) chan
|
||||
J.JobExit {} -> return ()
|
||||
in go Nothing
|
||||
let go prevJobMsg chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg >> go (Just jobMsg) chan
|
||||
J.JobExit {} -> return ()
|
||||
in go Nothing
|
||||
|
||||
printPrefixedJobMessage :: Maybe J.JobMessage -> J.JobMessage -> IO ()
|
||||
printPrefixedJobMessage maybePrevJobMessage jobMessage = do
|
||||
let outHandle = getJobMessageOutHandle jobMessage
|
||||
prefix = makeJobMessagePrefix jobMessage
|
||||
content = getJobMessageContent jobMessage
|
||||
let outHandle = getJobMessageOutHandle jobMessage
|
||||
prefix = makeJobMessagePrefix jobMessage
|
||||
content = getJobMessageContent jobMessage
|
||||
|
||||
let maybeAddPrefixAtStart =
|
||||
((if (J._jobType <$> maybePrevJobMessage) /= Just (J._jobType jobMessage) then "\n" <> prefix else "") <>)
|
||||
addPrefixAfterSubstr substr = T.intercalate (substr <> prefix) . T.splitOn substr
|
||||
addPrefix = maybeAddPrefixAtStart . addPrefixAfterSubstr "\n" . addPrefixAfterSubstr "\r"
|
||||
let maybeAddPrefixAtStart =
|
||||
((if (J._jobType <$> maybePrevJobMessage) /= Just (J._jobType jobMessage) then "\n" <> prefix else "") <>)
|
||||
addPrefixAfterSubstr substr = T.intercalate (substr <> prefix) . T.splitOn substr
|
||||
addPrefix = maybeAddPrefixAtStart . addPrefixAfterSubstr "\n" . addPrefixAfterSubstr "\r"
|
||||
|
||||
T.IO.hPutStr outHandle $ addPrefix content
|
||||
hFlush outHandle
|
||||
T.IO.hPutStr outHandle $ addPrefix content
|
||||
hFlush outHandle
|
||||
|
||||
printJobMessage :: J.JobMessage -> IO ()
|
||||
printJobMessage jobMsg = do
|
||||
let outHandle = getJobMessageOutHandle jobMsg
|
||||
let message = getJobMessageContent jobMsg
|
||||
T.IO.hPutStr outHandle message
|
||||
hFlush outHandle
|
||||
let outHandle = getJobMessageOutHandle jobMsg
|
||||
let message = getJobMessageContent jobMsg
|
||||
T.IO.hPutStr outHandle message
|
||||
hFlush outHandle
|
||||
|
||||
makeJobMessagePrefix :: J.JobMessage -> T.Text
|
||||
makeJobMessagePrefix jobMsg =
|
||||
case J._jobType jobMsg of
|
||||
J.Server -> T.pack $ Term.applyStyles [Term.Magenta] "Server"
|
||||
J.WebApp -> T.pack $ Term.applyStyles [Term.Cyan] "Web app"
|
||||
J.Db -> T.pack $ Term.applyStyles [Term.White] "Db"
|
||||
case J._jobType jobMsg of
|
||||
J.Server -> T.pack $ Term.applyStyles [Term.Magenta] "Server"
|
||||
J.WebApp -> T.pack $ Term.applyStyles [Term.Cyan] "Web app"
|
||||
J.Db -> T.pack $ Term.applyStyles [Term.White] "Db"
|
||||
<> (if getJobMessageOutHandle jobMsg == stderr then " (stderr)" else "")
|
||||
<> ": "
|
||||
|
||||
getJobMessageOutHandle :: J.JobMessage -> Handle
|
||||
getJobMessageOutHandle jobMsg = case J._data jobMsg of
|
||||
J.JobOutput _ outputType ->
|
||||
case outputType of
|
||||
J.Stdout -> stdout
|
||||
J.Stderr -> stderr
|
||||
J.JobExit _ -> stdout
|
||||
J.JobOutput _ outputType ->
|
||||
case outputType of
|
||||
J.Stdout -> stdout
|
||||
J.Stderr -> stderr
|
||||
J.JobExit _ -> stdout
|
||||
|
||||
getJobMessageContent :: J.JobMessage -> T.Text
|
||||
getJobMessageContent jobMsg = case J._data jobMsg of
|
||||
J.JobOutput output _ -> output
|
||||
J.JobExit ExitSuccess -> "Job exited successfully."
|
||||
J.JobExit (ExitFailure exitCode) -> T.pack $ "Job failed with exit code " <> show exitCode
|
||||
J.JobOutput output _ -> output
|
||||
J.JobExit ExitSuccess -> "Job exited successfully."
|
||||
J.JobExit (ExitFailure exitCode) -> T.pack $ "Job failed with exit code " <> show exitCode
|
||||
|
@ -1,28 +1,28 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Generator.Job.Process
|
||||
( runProcessAsJob
|
||||
, runNodeCommandAsJob
|
||||
) where
|
||||
( runProcessAsJob,
|
||||
runNodeCommandAsJob,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (writeChan)
|
||||
import Control.Concurrent.Async (Concurrently (..))
|
||||
import UnliftIO.Exception (bracket)
|
||||
import Data.Conduit (runConduit, (.|))
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.Conduit.Process as CP
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO.Error (catchIOError, isDoesNotExistError)
|
||||
import qualified System.Process as P
|
||||
import Text.Read (readMaybe)
|
||||
import qualified Text.Regex.TDFA as R
|
||||
|
||||
import qualified Generator.Common as C
|
||||
import qualified Generator.Job as J
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import Control.Concurrent (writeChan)
|
||||
import Control.Concurrent.Async (Concurrently (..))
|
||||
import Data.Conduit (runConduit, (.|))
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.Conduit.Process as CP
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
import qualified Generator.Common as C
|
||||
import qualified Generator.Job as J
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO.Error (catchIOError, isDoesNotExistError)
|
||||
import qualified System.Process as P
|
||||
import Text.Read (readMaybe)
|
||||
import qualified Text.Regex.TDFA as R
|
||||
import UnliftIO.Exception (bracket)
|
||||
|
||||
-- TODO:
|
||||
-- Switch from Data.Conduit.Process to Data.Conduit.Process.Typed.
|
||||
@ -32,78 +32,118 @@ import qualified StrongPath as SP
|
||||
-- Returns exit code of the process once it finishes, and also sends it to the channel.
|
||||
-- Makes sure to terminate the process if exception occurs.
|
||||
runProcessAsJob :: P.CreateProcess -> J.JobType -> J.Job
|
||||
runProcessAsJob process jobType chan = bracket
|
||||
runProcessAsJob process jobType chan =
|
||||
bracket
|
||||
(CP.streamingProcess process)
|
||||
(\(_, _, _, sph) -> terminateStreamingProcess sph)
|
||||
runStreamingProcessAsJob
|
||||
where
|
||||
runStreamingProcessAsJob (CP.Inherited, stdoutStream, stderrStream, processHandle) = do
|
||||
let forwardStdoutToChan = runConduit $ stdoutStream .| CL.mapM_
|
||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stdout
|
||||
, J._jobType = jobType })
|
||||
let forwardStdoutToChan =
|
||||
runConduit $
|
||||
stdoutStream
|
||||
.| CL.mapM_
|
||||
( \bs ->
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput (decodeUtf8 bs) J.Stdout,
|
||||
J._jobType = jobType
|
||||
}
|
||||
)
|
||||
|
||||
let forwardStderrToChan = runConduit $ stderrStream .| CL.mapM_
|
||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stderr
|
||||
, J._jobType = jobType })
|
||||
let forwardStderrToChan =
|
||||
runConduit $
|
||||
stderrStream
|
||||
.| CL.mapM_
|
||||
( \bs ->
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput (decodeUtf8 bs) J.Stderr,
|
||||
J._jobType = jobType
|
||||
}
|
||||
)
|
||||
|
||||
exitCode <- runConcurrently $
|
||||
Concurrently forwardStdoutToChan *>
|
||||
Concurrently forwardStderrToChan *>
|
||||
Concurrently (CP.waitForStreamingProcess processHandle)
|
||||
exitCode <-
|
||||
runConcurrently $
|
||||
Concurrently forwardStdoutToChan
|
||||
*> Concurrently forwardStderrToChan
|
||||
*> Concurrently (CP.waitForStreamingProcess processHandle)
|
||||
|
||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
||||
, J._jobType = jobType }
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobExit exitCode,
|
||||
J._jobType = jobType
|
||||
}
|
||||
|
||||
return exitCode
|
||||
|
||||
terminateStreamingProcess streamingProcessHandle = do
|
||||
let processHandle = CP.streamingProcessHandleRaw streamingProcessHandle
|
||||
P.terminateProcess processHandle
|
||||
return $ ExitFailure 1
|
||||
let processHandle = CP.streamingProcessHandleRaw streamingProcessHandle
|
||||
P.terminateProcess processHandle
|
||||
return $ ExitFailure 1
|
||||
|
||||
runNodeCommandAsJob :: Path Abs (Dir a) -> String -> [String] -> J.JobType -> J.Job
|
||||
runNodeCommandAsJob fromDir command args jobType chan = do
|
||||
errorOrNodeVersion <- getNodeVersion
|
||||
case errorOrNodeVersion of
|
||||
Left errorMsg -> exitWithError (ExitFailure 1) (T.pack errorMsg)
|
||||
Right nodeVersion -> if nodeVersion < C.nodeVersion
|
||||
then exitWithError (ExitFailure 1)
|
||||
(T.pack $ "Your node version is too low. " ++ waspNodeRequirementMessage)
|
||||
else do
|
||||
let process = (P.proc command args) { P.cwd = Just $ SP.toFilePath fromDir }
|
||||
runProcessAsJob process jobType chan
|
||||
errorOrNodeVersion <- getNodeVersion
|
||||
case errorOrNodeVersion of
|
||||
Left errorMsg -> exitWithError (ExitFailure 1) (T.pack errorMsg)
|
||||
Right nodeVersion ->
|
||||
if nodeVersion < C.nodeVersion
|
||||
then
|
||||
exitWithError
|
||||
(ExitFailure 1)
|
||||
(T.pack $ "Your node version is too low. " ++ waspNodeRequirementMessage)
|
||||
else do
|
||||
let process = (P.proc command args) {P.cwd = Just $ SP.toFilePath fromDir}
|
||||
runProcessAsJob process jobType chan
|
||||
where
|
||||
exitWithError exitCode errorMsg = do
|
||||
writeChan chan $ J.JobMessage
|
||||
{ J._data = J.JobOutput errorMsg J.Stderr
|
||||
, J._jobType = jobType }
|
||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
||||
, J._jobType = jobType }
|
||||
return exitCode
|
||||
exitWithError exitCode errorMsg = do
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput errorMsg J.Stderr,
|
||||
J._jobType = jobType
|
||||
}
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobExit exitCode,
|
||||
J._jobType = jobType
|
||||
}
|
||||
return exitCode
|
||||
|
||||
getNodeVersion :: IO (Either String (Int, Int, Int))
|
||||
getNodeVersion = do
|
||||
(exitCode, stdout, stderr) <- P.readProcessWithExitCode "node" ["--version"] ""
|
||||
`catchIOError` (\e -> if isDoesNotExistError e
|
||||
then return (ExitFailure 1, "", "Command 'node' not found.")
|
||||
else ioError e)
|
||||
return $ case exitCode of
|
||||
ExitFailure _ -> Left ("Running 'node --version' failed: " ++ stderr
|
||||
++ " " ++ waspNodeRequirementMessage)
|
||||
ExitSuccess -> case parseNodeVersion stdout of
|
||||
Nothing -> Left ("Wasp failed to parse node version."
|
||||
++ " This is most likely a bug in Wasp, please file an issue.")
|
||||
Just version -> Right version
|
||||
getNodeVersion :: IO (Either String (Int, Int, Int))
|
||||
getNodeVersion = do
|
||||
(exitCode, stdout, stderr) <-
|
||||
P.readProcessWithExitCode "node" ["--version"] ""
|
||||
`catchIOError` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return (ExitFailure 1, "", "Command 'node' not found.")
|
||||
else ioError e
|
||||
)
|
||||
return $ case exitCode of
|
||||
ExitFailure _ ->
|
||||
Left
|
||||
( "Running 'node --version' failed: " ++ stderr
|
||||
++ " "
|
||||
++ waspNodeRequirementMessage
|
||||
)
|
||||
ExitSuccess -> case parseNodeVersion stdout of
|
||||
Nothing ->
|
||||
Left
|
||||
( "Wasp failed to parse node version."
|
||||
++ " This is most likely a bug in Wasp, please file an issue."
|
||||
)
|
||||
Just version -> Right version
|
||||
|
||||
parseNodeVersion :: String -> Maybe (Int, Int, Int)
|
||||
parseNodeVersion nodeVersionStr =
|
||||
case nodeVersionStr R.=~ ("v([^\\.]+).([^\\.]+).(.+)" :: String) of
|
||||
((_ , _, _, [majorStr, minorStr, patchStr]) :: (String, String, String, [String])) -> do
|
||||
major <- readMaybe majorStr
|
||||
minor <- readMaybe minorStr
|
||||
patch <- readMaybe patchStr
|
||||
return (major, minor, patch)
|
||||
_ -> Nothing
|
||||
parseNodeVersion :: String -> Maybe (Int, Int, Int)
|
||||
parseNodeVersion nodeVersionStr =
|
||||
case nodeVersionStr R.=~ ("v([^\\.]+).([^\\.]+).(.+)" :: String) of
|
||||
((_, _, _, [majorStr, minorStr, patchStr]) :: (String, String, String, [String])) -> do
|
||||
major <- readMaybe majorStr
|
||||
minor <- readMaybe minorStr
|
||||
patch <- readMaybe patchStr
|
||||
return (major, minor, patch)
|
||||
_ -> Nothing
|
||||
|
||||
waspNodeRequirementMessage = "Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
||||
++ " Check Wasp docs for more details: https://wasp-lang.dev/docs#requirements ."
|
||||
waspNodeRequirementMessage =
|
||||
"Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
||||
++ " Check Wasp docs for more details: https://wasp-lang.dev/docs#requirements ."
|
||||
|
@ -1,14 +1,13 @@
|
||||
module Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps
|
||||
, toPackageJsonDependenciesString
|
||||
) where
|
||||
|
||||
import Data.List (find, intercalate)
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.List (find, intercalate)
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import qualified NpmDependency as ND
|
||||
|
||||
|
||||
type NpmDependenciesConflictError = String
|
||||
|
||||
-- | Takes wasp npm dependencies and user npm dependencies and figures out how to
|
||||
@ -18,41 +17,49 @@ type NpmDependenciesConflictError = String
|
||||
-- be different.
|
||||
-- On error (Left), returns list of conflicting user deps together with the error message
|
||||
-- explaining what the error is.
|
||||
resolveNpmDeps
|
||||
:: [ND.NpmDependency]
|
||||
-> [ND.NpmDependency]
|
||||
-> Either [(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
([ND.NpmDependency], [ND.NpmDependency])
|
||||
resolveNpmDeps waspDeps userDeps = if null conflictingUserDeps
|
||||
resolveNpmDeps ::
|
||||
[ND.NpmDependency] ->
|
||||
[ND.NpmDependency] ->
|
||||
Either
|
||||
[(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
([ND.NpmDependency], [ND.NpmDependency])
|
||||
resolveNpmDeps waspDeps userDeps =
|
||||
if null conflictingUserDeps
|
||||
then Right (waspDeps, userDepsNotInWaspDeps)
|
||||
else Left conflictingUserDeps
|
||||
where
|
||||
conflictingUserDeps :: [(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
conflictingUserDeps = map (\(dep, err) -> (dep, fromJust err))
|
||||
$ filter (isJust . snd)
|
||||
$ map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
||||
conflictingUserDeps =
|
||||
map (\(dep, err) -> (dep, fromJust err)) $
|
||||
filter (isJust . snd) $
|
||||
map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
||||
|
||||
checkIfConflictingUserDep :: ND.NpmDependency -> Maybe NpmDependenciesConflictError
|
||||
checkIfConflictingUserDep userDep =
|
||||
let attachErrorMessage dep = "Error: Dependency conflict for user npm dependency ("
|
||||
++ ND._name dep ++ ", " ++ ND._version dep ++ "): "
|
||||
++ "Version must be set to the exactly the same version as"
|
||||
++ " the one wasp is using: "
|
||||
++ ND._version dep
|
||||
in attachErrorMessage <$> find (areTwoDepsInConflict userDep) waspDeps
|
||||
let attachErrorMessage dep =
|
||||
"Error: Dependency conflict for user npm dependency ("
|
||||
++ ND._name dep
|
||||
++ ", "
|
||||
++ ND._version dep
|
||||
++ "): "
|
||||
++ "Version must be set to the exactly the same version as"
|
||||
++ " the one wasp is using: "
|
||||
++ ND._version dep
|
||||
in attachErrorMessage <$> find (areTwoDepsInConflict userDep) waspDeps
|
||||
|
||||
areTwoDepsInConflict :: ND.NpmDependency -> ND.NpmDependency -> Bool
|
||||
areTwoDepsInConflict d1 d2 = ND._name d1 == ND._name d2
|
||||
&& ND._version d1 /= ND._version d2
|
||||
areTwoDepsInConflict d1 d2 =
|
||||
ND._name d1 == ND._name d2
|
||||
&& ND._version d1 /= ND._version d2
|
||||
|
||||
userDepsNotInWaspDeps :: [ND.NpmDependency]
|
||||
userDepsNotInWaspDeps = filter (not . isDepWithNameInWaspDeps . ND._name) userDeps
|
||||
|
||||
isDepWithNameInWaspDeps :: String -> Bool
|
||||
isDepWithNameInWaspDeps name = any ((name ==). ND._name) waspDeps
|
||||
isDepWithNameInWaspDeps name = any ((name ==) . ND._name) waspDeps
|
||||
|
||||
toPackageJsonDependenciesString :: [ND.NpmDependency] -> String
|
||||
toPackageJsonDependenciesString deps =
|
||||
"\"dependencies\": {"
|
||||
"\"dependencies\": {"
|
||||
++ intercalate ",\n " (map (\dep -> "\"" ++ ND._name dep ++ "\": \"" ++ ND._version dep ++ "\"") deps)
|
||||
++ "\n}"
|
||||
|
@ -1,52 +1,58 @@
|
||||
module Generator.ServerGenerator
|
||||
( genServer
|
||||
, preCleanup
|
||||
, operationsRouteInRootRouter
|
||||
) where
|
||||
( genServer,
|
||||
preCleanup,
|
||||
operationsRouteInRootRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust,
|
||||
isJust)
|
||||
import qualified Path as P
|
||||
import StrongPath ((</>), Path, Rel, File, Abs, Dir)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (removeFile)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Control.Monad (when)
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (nodeVersionAsText, ProjectRootDir)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft (FileDraft, createCopyFileDraft)
|
||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
||||
toPackageJsonDependenciesString)
|
||||
import Generator.ServerGenerator.AuthG (genAuth)
|
||||
import Generator.ServerGenerator.Common (asServerFile,
|
||||
asTmplFile)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.ConfigG (genConfigFile)
|
||||
import CompileOptions (CompileOptions)
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe
|
||||
( fromJust,
|
||||
isJust,
|
||||
)
|
||||
import Generator.Common (ProjectRootDir, nodeVersionAsText)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft (FileDraft, createCopyFileDraft)
|
||||
import Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
import Generator.ServerGenerator.AuthG (genAuth)
|
||||
import Generator.ServerGenerator.Common
|
||||
( asServerFile,
|
||||
asTmplFile,
|
||||
)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.ConfigG (genConfigFile)
|
||||
import qualified Generator.ServerGenerator.ExternalCodeGenerator as ServerExternalCodeGenerator
|
||||
import Generator.ServerGenerator.OperationsG (genOperations)
|
||||
import Generator.ServerGenerator.OperationsRoutesG (genOperationsRoutes)
|
||||
import qualified NpmDependency as ND
|
||||
import Wasp (Wasp, getAuth)
|
||||
import Generator.ServerGenerator.OperationsG (genOperations)
|
||||
import Generator.ServerGenerator.OperationsRoutesG (genOperationsRoutes)
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (removeFile)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Auth
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
genServer :: Wasp -> CompileOptions -> [FileDraft]
|
||||
genServer wasp _ = concat
|
||||
[ [genReadme wasp]
|
||||
, [genPackageJson wasp waspNpmDeps]
|
||||
, [genNpmrc wasp]
|
||||
, [genNvmrc wasp]
|
||||
, [genGitignore wasp]
|
||||
, genSrcDir wasp
|
||||
, generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp
|
||||
, genDotEnv wasp
|
||||
genServer wasp _ =
|
||||
concat
|
||||
[ [genReadme wasp],
|
||||
[genPackageJson wasp waspNpmDeps],
|
||||
[genNpmrc wasp],
|
||||
[genNvmrc wasp],
|
||||
[genGitignore wasp],
|
||||
genSrcDir wasp,
|
||||
generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp,
|
||||
genDotEnv wasp
|
||||
]
|
||||
|
||||
-- Cleanup to be performed before generating new server code.
|
||||
@ -56,22 +62,22 @@ genServer wasp _ = concat
|
||||
-- for progress of this.
|
||||
preCleanup :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
||||
preCleanup _ outDir _ = do
|
||||
-- If .env gets removed but there is old .env file in generated project from previous attempts,
|
||||
-- we need to make sure we remove it.
|
||||
removeFile dotEnvAbsFilePath
|
||||
`catch` \e -> when (not $ isDoesNotExistError e) $ throwIO e
|
||||
-- If .env gets removed but there is old .env file in generated project from previous attempts,
|
||||
-- we need to make sure we remove it.
|
||||
removeFile dotEnvAbsFilePath
|
||||
`catch` \e -> when (not $ isDoesNotExistError e) $ throwIO e
|
||||
where
|
||||
dotEnvAbsFilePath = SP.toFilePath $ outDir </> C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir
|
||||
dotEnvAbsFilePath = SP.toFilePath $ outDir </> C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir
|
||||
|
||||
genDotEnv :: Wasp -> [FileDraft]
|
||||
genDotEnv wasp =
|
||||
case Wasp.getDotEnvFile wasp of
|
||||
Just srcFilePath ->
|
||||
[ createCopyFileDraft
|
||||
(C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir)
|
||||
srcFilePath
|
||||
]
|
||||
Nothing -> []
|
||||
case Wasp.getDotEnvFile wasp of
|
||||
Just srcFilePath ->
|
||||
[ createCopyFileDraft
|
||||
(C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir)
|
||||
srcFilePath
|
||||
]
|
||||
Nothing -> []
|
||||
|
||||
dotEnvInServerRootDir :: Path (Rel C.ServerRootDir) File
|
||||
dotEnvInServerRootDir = asServerFile [P.relfile|.env|]
|
||||
@ -80,101 +86,115 @@ genReadme :: Wasp -> FileDraft
|
||||
genReadme _ = C.copyTmplAsIs (asTmplFile [P.relfile|README.md|])
|
||||
|
||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
genPackageJson wasp waspDeps =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|package.json|])
|
||||
(asServerFile [P.relfile|package.json|])
|
||||
(Just $ object
|
||||
[ "wasp" .= wasp
|
||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
, "nodeVersion" .= nodeVersionAsText
|
||||
, "startProductionScript" .= concat
|
||||
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else ""
|
||||
, "NODE_ENV=production node ./src/server.js"
|
||||
]
|
||||
])
|
||||
( Just $
|
||||
object
|
||||
[ "wasp" .= wasp,
|
||||
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps),
|
||||
"nodeVersion" .= nodeVersionAsText,
|
||||
"startProductionScript"
|
||||
.= concat
|
||||
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else "",
|
||||
"NODE_ENV=production node ./src/server.js"
|
||||
]
|
||||
]
|
||||
)
|
||||
where
|
||||
(resolvedWaspDeps, resolvedUserDeps) =
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
Right deps -> deps
|
||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
Right deps -> deps
|
||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||
|
||||
userDeps :: [ND.NpmDependency]
|
||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||
|
||||
waspNpmDeps :: [ND.NpmDependency]
|
||||
waspNpmDeps = ND.fromList
|
||||
[ ("cookie-parser", "~1.4.4")
|
||||
, ("cors", "^2.8.5")
|
||||
, ("debug", "~2.6.9")
|
||||
, ("express", "~4.16.1")
|
||||
, ("morgan", "~1.9.1")
|
||||
, ("@prisma/client", "2.21.0")
|
||||
, ("jsonwebtoken", "^8.5.1")
|
||||
, ("secure-password", "^4.0.0")
|
||||
, ("dotenv", "8.2.0")
|
||||
waspNpmDeps =
|
||||
ND.fromList
|
||||
[ ("cookie-parser", "~1.4.4"),
|
||||
("cors", "^2.8.5"),
|
||||
("debug", "~2.6.9"),
|
||||
("express", "~4.16.1"),
|
||||
("morgan", "~1.9.1"),
|
||||
("@prisma/client", "2.21.0"),
|
||||
("jsonwebtoken", "^8.5.1"),
|
||||
("secure-password", "^4.0.0"),
|
||||
("dotenv", "8.2.0")
|
||||
]
|
||||
|
||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||
|
||||
genNpmrc :: Wasp -> FileDraft
|
||||
genNpmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|npmrc|])
|
||||
(asServerFile [P.relfile|.npmrc|])
|
||||
Nothing
|
||||
genNpmrc _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|npmrc|])
|
||||
(asServerFile [P.relfile|.npmrc|])
|
||||
Nothing
|
||||
|
||||
genNvmrc :: Wasp -> FileDraft
|
||||
genNvmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|nvmrc|])
|
||||
(asServerFile [P.relfile|.nvmrc|])
|
||||
(Just (object ["nodeVersion" .= ('v' : nodeVersionAsText)]))
|
||||
genNvmrc _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|nvmrc|])
|
||||
(asServerFile [P.relfile|.nvmrc|])
|
||||
(Just (object ["nodeVersion" .= ('v' : nodeVersionAsText)]))
|
||||
|
||||
genGitignore :: Wasp -> FileDraft
|
||||
genGitignore _ = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
||||
(asServerFile [P.relfile|.gitignore|])
|
||||
Nothing
|
||||
genGitignore _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|gitignore|])
|
||||
(asServerFile [P.relfile|.gitignore|])
|
||||
Nothing
|
||||
|
||||
genSrcDir :: Wasp -> [FileDraft]
|
||||
genSrcDir wasp = concat
|
||||
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]]
|
||||
, [genDbClient wasp]
|
||||
, [genConfigFile wasp]
|
||||
, genRoutesDir wasp
|
||||
, genOperationsRoutes wasp
|
||||
, genOperations wasp
|
||||
, genAuth wasp
|
||||
genSrcDir wasp =
|
||||
concat
|
||||
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]],
|
||||
[genDbClient wasp],
|
||||
[genConfigFile wasp],
|
||||
genRoutesDir wasp,
|
||||
genOperationsRoutes wasp,
|
||||
genOperations wasp,
|
||||
genAuth wasp
|
||||
]
|
||||
|
||||
genDbClient :: Wasp -> FileDraft
|
||||
genDbClient wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
|
||||
dbClientRelToSrcP = [P.relfile|dbClient.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> dbClientRelToSrcP
|
||||
dstFile = C.serverSrcDirInServerRootDir </> C.asServerSrcFile dbClientRelToSrcP
|
||||
dbClientRelToSrcP = [P.relfile|dbClient.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> dbClientRelToSrcP
|
||||
dstFile = C.serverSrcDirInServerRootDir </> C.asServerSrcFile dbClientRelToSrcP
|
||||
|
||||
tmplData =
|
||||
if isJust maybeAuth
|
||||
then object
|
||||
[ "isAuthEnabled" .= True
|
||||
, "userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
||||
]
|
||||
else object []
|
||||
tmplData =
|
||||
if isJust maybeAuth
|
||||
then
|
||||
object
|
||||
[ "isAuthEnabled" .= True,
|
||||
"userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
||||
]
|
||||
else object []
|
||||
|
||||
genRoutesDir :: Wasp -> [FileDraft]
|
||||
genRoutesDir wasp =
|
||||
-- TODO(martin): We will probably want to extract "routes" path here same as we did with "src", to avoid hardcoding,
|
||||
-- but I did not bother with it yet since it is used only here for now.
|
||||
[ C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|src/routes/index.js|])
|
||||
(asServerFile [P.relfile|src/routes/index.js|])
|
||||
(Just $ object
|
||||
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter
|
||||
, "isAuthEnabled" .= isJust (getAuth wasp)
|
||||
-- TODO(martin): We will probably want to extract "routes" path here same as we did with "src", to avoid hardcoding,
|
||||
-- but I did not bother with it yet since it is used only here for now.
|
||||
[ C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|src/routes/index.js|])
|
||||
(asServerFile [P.relfile|src/routes/index.js|])
|
||||
( Just $
|
||||
object
|
||||
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter,
|
||||
"isAuthEnabled" .= isJust (getAuth wasp)
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
operationsRouteInRootRouter :: String
|
||||
operationsRouteInRootRouter = "operations"
|
||||
|
@ -1,41 +1,44 @@
|
||||
module Generator.ServerGenerator.AuthG
|
||||
( genAuth
|
||||
) where
|
||||
( genAuth,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import Data.Aeson (object, (.=))
|
||||
|
||||
import StrongPath ((</>))
|
||||
import qualified Util
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp.Auth
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import StrongPath ((</>))
|
||||
|
||||
genAuth :: Wasp -> [FileDraft]
|
||||
genAuth wasp = case maybeAuth of
|
||||
Just auth -> [ genCoreAuth auth
|
||||
-- Auth routes
|
||||
, genAuthRoutesIndex
|
||||
, genLoginRoute auth
|
||||
, genSignupRoute auth
|
||||
, genMeRoute auth
|
||||
]
|
||||
Nothing -> []
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
Just auth ->
|
||||
[ genCoreAuth auth,
|
||||
-- Auth routes
|
||||
genAuthRoutesIndex,
|
||||
genLoginRoute auth,
|
||||
genSignupRoute auth,
|
||||
genMeRoute auth
|
||||
]
|
||||
Nothing -> []
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
|
||||
-- | Generates core/auth file which contains auth middleware and createUser() function.
|
||||
genCoreAuth :: Wasp.Auth.Auth -> FileDraft
|
||||
genCoreAuth auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
coreAuthRelToSrc = [P.relfile|core/auth.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> coreAuthRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile coreAuthRelToSrc)
|
||||
where
|
||||
coreAuthRelToSrc = [P.relfile|core/auth.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> coreAuthRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile coreAuthRelToSrc)
|
||||
|
||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
||||
[ "userEntityUpper" .= userEntity
|
||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
||||
tmplData =
|
||||
let userEntity = (Wasp.Auth._userEntity auth)
|
||||
in object
|
||||
[ "userEntityUpper" .= userEntity,
|
||||
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||
]
|
||||
|
||||
genAuthRoutesIndex :: FileDraft
|
||||
@ -43,34 +46,38 @@ genAuthRoutesIndex = C.copySrcTmplAsIs (C.asTmplSrcFile [P.relfile|routes/auth/i
|
||||
|
||||
genLoginRoute :: Wasp.Auth.Auth -> FileDraft
|
||||
genLoginRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
loginRouteRelToSrc = [P.relfile|routes/auth/login.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> loginRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile loginRouteRelToSrc)
|
||||
where
|
||||
loginRouteRelToSrc = [P.relfile|routes/auth/login.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> loginRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile loginRouteRelToSrc)
|
||||
|
||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
||||
[ "userEntityUpper" .= userEntity
|
||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
||||
tmplData =
|
||||
let userEntity = (Wasp.Auth._userEntity auth)
|
||||
in object
|
||||
[ "userEntityUpper" .= userEntity,
|
||||
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||
]
|
||||
|
||||
genSignupRoute :: Wasp.Auth.Auth -> FileDraft
|
||||
genSignupRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
signupRouteRelToSrc = [P.relfile|routes/auth/signup.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> signupRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile signupRouteRelToSrc)
|
||||
where
|
||||
signupRouteRelToSrc = [P.relfile|routes/auth/signup.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> signupRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile signupRouteRelToSrc)
|
||||
|
||||
tmplData = object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
tmplData =
|
||||
object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
|
||||
genMeRoute :: Wasp.Auth.Auth -> FileDraft
|
||||
genMeRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
meRouteRelToSrc = [P.relfile|routes/auth/me.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> meRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile meRouteRelToSrc)
|
||||
where
|
||||
meRouteRelToSrc = [P.relfile|routes/auth/me.js|]
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> meRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile meRouteRelToSrc)
|
||||
|
||||
tmplData = object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
tmplData =
|
||||
object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
|
@ -1,38 +1,39 @@
|
||||
module Generator.ServerGenerator.Common
|
||||
( serverRootDirInProjectRootDir
|
||||
, serverSrcDirInServerRootDir
|
||||
, serverSrcDirInProjectRootDir
|
||||
, copyTmplAsIs
|
||||
, makeSimpleTemplateFD
|
||||
, makeTemplateFD
|
||||
, copySrcTmplAsIs
|
||||
, srcDirInServerTemplatesDir
|
||||
, asTmplFile
|
||||
, asTmplSrcFile
|
||||
, asServerFile
|
||||
, asServerSrcFile
|
||||
, ServerRootDir
|
||||
, ServerSrcDir
|
||||
, ServerTemplatesDir
|
||||
, ServerTemplatesSrcDir
|
||||
) where
|
||||
( serverRootDirInProjectRootDir,
|
||||
serverSrcDirInServerRootDir,
|
||||
serverSrcDirInProjectRootDir,
|
||||
copyTmplAsIs,
|
||||
makeSimpleTemplateFD,
|
||||
makeTemplateFD,
|
||||
copySrcTmplAsIs,
|
||||
srcDirInServerTemplatesDir,
|
||||
asTmplFile,
|
||||
asTmplSrcFile,
|
||||
asServerFile,
|
||||
asServerSrcFile,
|
||||
ServerRootDir,
|
||||
ServerSrcDir,
|
||||
ServerTemplatesDir,
|
||||
ServerTemplatesSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
|
||||
|
||||
data ServerRootDir
|
||||
data ServerSrcDir
|
||||
data ServerTemplatesDir
|
||||
data ServerTemplatesSrcDir
|
||||
|
||||
data ServerSrcDir
|
||||
|
||||
data ServerTemplatesDir
|
||||
|
||||
data ServerTemplatesSrcDir
|
||||
|
||||
asTmplFile :: P.Path P.Rel P.File -> Path (Rel ServerTemplatesDir) File
|
||||
asTmplFile = SP.fromPathRelFile
|
||||
@ -59,32 +60,36 @@ serverSrcDirInServerRootDir = SP.fromPathRelDir [P.reldir|src|]
|
||||
serverSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir ServerSrcDir)
|
||||
serverSrcDirInProjectRootDir = serverRootDirInProjectRootDir </> serverSrcDirInServerRootDir
|
||||
|
||||
|
||||
-- * Templates
|
||||
|
||||
copyTmplAsIs :: Path (Rel ServerTemplatesDir) File -> FileDraft
|
||||
copyTmplAsIs srcPath = makeTemplateFD srcPath dstPath Nothing
|
||||
where dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
where
|
||||
dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
|
||||
makeSimpleTemplateFD :: Path (Rel ServerTemplatesDir) File -> Wasp -> FileDraft
|
||||
makeSimpleTemplateFD srcPath wasp = makeTemplateFD srcPath dstPath (Just $ Aeson.toJSON wasp)
|
||||
where dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
where
|
||||
dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
|
||||
makeTemplateFD :: Path (Rel ServerTemplatesDir) File
|
||||
-> Path (Rel ServerRootDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
makeTemplateFD ::
|
||||
Path (Rel ServerTemplatesDir) File ->
|
||||
Path (Rel ServerRootDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
makeTemplateFD relSrcPath relDstPath tmplData =
|
||||
createTemplateFileDraft
|
||||
(serverRootDirInProjectRootDir </> relDstPath)
|
||||
(serverTemplatesDirInTemplatesDir </> relSrcPath)
|
||||
tmplData
|
||||
createTemplateFileDraft
|
||||
(serverRootDirInProjectRootDir </> relDstPath)
|
||||
(serverTemplatesDirInTemplatesDir </> relSrcPath)
|
||||
tmplData
|
||||
|
||||
copySrcTmplAsIs :: Path (Rel ServerTemplatesSrcDir) File -> FileDraft
|
||||
copySrcTmplAsIs pathInTemplatesSrcDir = makeTemplateFD srcPath dstPath Nothing
|
||||
where srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
||||
dstPath = serverSrcDirInServerRootDir
|
||||
</> ((SP.castRel pathInTemplatesSrcDir) :: Path (Rel ServerSrcDir) File)
|
||||
where
|
||||
srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
||||
dstPath =
|
||||
serverSrcDirInServerRootDir
|
||||
</> ((SP.castRel pathInTemplatesSrcDir) :: Path (Rel ServerSrcDir) File)
|
||||
|
||||
-- | Path where server app templates reside.
|
||||
serverTemplatesDirInTemplatesDir :: Path (Rel TemplatesDir) (Dir ServerTemplatesDir)
|
||||
|
@ -1,25 +1,25 @@
|
||||
module Generator.ServerGenerator.ConfigG
|
||||
( genConfigFile
|
||||
, configFileInSrcDir
|
||||
) where
|
||||
( genConfigFile,
|
||||
configFileInSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Wasp (Wasp, getAuth)
|
||||
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp, getAuth)
|
||||
|
||||
genConfigFile :: Wasp -> FileDraft
|
||||
genConfigFile wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.srcDirInServerTemplatesDir </> SP.castRel configFileInSrcDir
|
||||
dstFile = C.serverSrcDirInServerRootDir </> configFileInSrcDir
|
||||
tmplData = object
|
||||
tmplData =
|
||||
object
|
||||
[ "isAuthEnabled" .= isJust (getAuth wasp)
|
||||
]
|
||||
|
||||
|
@ -1,24 +1,26 @@
|
||||
module Generator.ServerGenerator.ExternalCodeGenerator
|
||||
( extCodeDirInServerSrcDir
|
||||
, generatorStrategy
|
||||
) where
|
||||
( extCodeDirInServerSrcDir,
|
||||
generatorStrategy,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy(..), GeneratedExternalCodeDir)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||
import Generator.ExternalCodeGenerator.Js (resolveJsFileWaspImportsForExtCodeDir)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Relative path to directory where external code will be generated.
|
||||
extCodeDirInServerSrcDir :: Path (Rel C.ServerSrcDir) (Dir GeneratedExternalCodeDir)
|
||||
extCodeDirInServerSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||
|
||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir)
|
||||
, _extCodeDirInProjectRootDir = C.serverRootDirInProjectRootDir
|
||||
</> C.serverSrcDirInServerRootDir
|
||||
</> extCodeDirInServerSrcDir
|
||||
generatorStrategy =
|
||||
ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir),
|
||||
_extCodeDirInProjectRootDir =
|
||||
C.serverRootDirInProjectRootDir
|
||||
</> C.serverSrcDirInServerRootDir
|
||||
</> extCodeDirInServerSrcDir
|
||||
}
|
||||
|
@ -1,41 +1,43 @@
|
||||
module Generator.ServerGenerator.OperationsG
|
||||
( genOperations
|
||||
, queryFileInSrcDir
|
||||
, actionFileInSrcDir
|
||||
, operationFileInSrcDir
|
||||
) where
|
||||
( genOperations,
|
||||
queryFileInSrcDir,
|
||||
actionFileInSrcDir,
|
||||
operationFileInSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Char (toLower)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Char (toLower)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Action
|
||||
import qualified Wasp.JsImport
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
|
||||
|
||||
genOperations :: Wasp -> [FileDraft]
|
||||
genOperations wasp = concat
|
||||
[ genQueries wasp
|
||||
, genActions wasp
|
||||
genOperations wasp =
|
||||
concat
|
||||
[ genQueries wasp,
|
||||
genActions wasp
|
||||
]
|
||||
|
||||
genQueries :: Wasp -> [FileDraft]
|
||||
genQueries wasp = concat
|
||||
genQueries wasp =
|
||||
concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
||||
]
|
||||
|
||||
genActions :: Wasp -> [FileDraft]
|
||||
genActions wasp = concat
|
||||
genActions wasp =
|
||||
concat
|
||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||
]
|
||||
|
||||
@ -60,16 +62,18 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplData = operationTmplData operation
|
||||
|
||||
queryFileInSrcDir :: Wasp.Query.Query -> Path (Rel C.ServerSrcDir) File
|
||||
queryFileInSrcDir query = SP.fromPathRelFile $
|
||||
queryFileInSrcDir query =
|
||||
SP.fromPathRelFile $
|
||||
[P.reldir|queries|]
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Query._name query ++ ".js")
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Query._name query ++ ".js")
|
||||
|
||||
actionFileInSrcDir :: Wasp.Action.Action -> Path (Rel C.ServerSrcDir) File
|
||||
actionFileInSrcDir action = SP.fromPathRelFile $
|
||||
actionFileInSrcDir action =
|
||||
SP.fromPathRelFile $
|
||||
[P.reldir|actions|]
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Action._name action ++ ".js")
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Action._name action ++ ".js")
|
||||
|
||||
operationFileInSrcDir :: Wasp.Operation.Operation -> Path (Rel C.ServerSrcDir) File
|
||||
operationFileInSrcDir (Wasp.Operation.QueryOp query) = queryFileInSrcDir query
|
||||
@ -80,35 +84,39 @@ relPosixPathFromOperationFileToExtSrcDir :: FilePath -- Posix
|
||||
relPosixPathFromOperationFileToExtSrcDir = "../ext-src/"
|
||||
|
||||
operationTmplData :: Wasp.Operation.Operation -> Aeson.Value
|
||||
operationTmplData operation = object
|
||||
[ "jsFnImportStatement" .= importStmt
|
||||
, "jsFnIdentifier" .= importIdentifier
|
||||
, "entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
||||
operationTmplData operation =
|
||||
object
|
||||
[ "jsFnImportStatement" .= importStmt,
|
||||
"jsFnIdentifier" .= importIdentifier,
|
||||
"entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
||||
]
|
||||
where
|
||||
(importIdentifier, importStmt) =
|
||||
getImportDetailsForOperationUserJsFn operation relPosixPathFromOperationFileToExtSrcDir
|
||||
getImportDetailsForOperationUserJsFn operation relPosixPathFromOperationFileToExtSrcDir
|
||||
buildEntityData :: String -> Aeson.Value
|
||||
buildEntityData entityName = object [ "name" .= entityName
|
||||
, "prismaIdentifier" .= (toLower (head entityName) : tail entityName)
|
||||
]
|
||||
buildEntityData entityName =
|
||||
object
|
||||
[ "name" .= entityName,
|
||||
"prismaIdentifier" .= (toLower (head entityName) : tail entityName)
|
||||
]
|
||||
|
||||
-- | Given Wasp operation, it returns details on how to import its user js function and use it,
|
||||
-- "user js function" meaning the one provided by user directly to wasp, untouched.
|
||||
getImportDetailsForOperationUserJsFn
|
||||
:: Wasp.Operation.Operation
|
||||
-> FilePath -- ^ Relative posix path from js file where you want to do importing to generated ext code dir.
|
||||
-- | (importIdentifier, importStmt)
|
||||
-- - importIdentifier -> Identifier via which you can access js function after you import it with importStmt.
|
||||
-- - importStmt -> Import statement via which you should do the import.
|
||||
-> (String, String)
|
||||
getImportDetailsForOperationUserJsFn ::
|
||||
Wasp.Operation.Operation ->
|
||||
-- | Relative posix path from js file where you want to do importing to generated ext code dir.
|
||||
-- | (importIdentifier, importStmt)
|
||||
-- - importIdentifier -> Identifier via which you can access js function after you import it with importStmt.
|
||||
-- - importStmt -> Import statement via which you should do the import.
|
||||
FilePath ->
|
||||
(String, String)
|
||||
getImportDetailsForOperationUserJsFn operation relPosixPathToExtCodeDir = (importIdentifier, importStmt)
|
||||
where
|
||||
importStmt = "import " ++ importWhat ++ " from '" ++ importFrom ++ "'"
|
||||
importFrom = relPosixPathToExtCodeDir ++ SP.toFilePath (Wasp.JsImport._from jsImport)
|
||||
(importIdentifier, importWhat) =
|
||||
case (Wasp.JsImport._defaultImport jsImport, Wasp.JsImport._namedImports jsImport) of
|
||||
(Just defaultImport, []) -> (defaultImport, defaultImport)
|
||||
(Nothing, [namedImport]) -> (namedImport, "{ " ++ namedImport ++ " }")
|
||||
_ -> error "Expected either default import or single named import for operation (query/action) js function."
|
||||
case (Wasp.JsImport._defaultImport jsImport, Wasp.JsImport._namedImports jsImport) of
|
||||
(Just defaultImport, []) -> (defaultImport, defaultImport)
|
||||
(Nothing, [namedImport]) -> (namedImport, "{ " ++ namedImport ++ " }")
|
||||
_ -> error "Expected either default import or single named import for operation (query/action) js function."
|
||||
jsImport = Wasp.Operation.getJsFn operation
|
||||
|
@ -1,63 +1,74 @@
|
||||
module Generator.ServerGenerator.OperationsRoutesG
|
||||
( genOperationsRoutes
|
||||
, operationRouteInOperationsRouter
|
||||
) where
|
||||
( genOperationsRoutes,
|
||||
operationRouteInOperationsRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import qualified Path as P
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.OperationsG (operationFileInSrcDir)
|
||||
import qualified Path as P
|
||||
import StrongPath
|
||||
( Dir,
|
||||
File,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.FilePath.Posix as FPPosix
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.OperationsG (operationFileInSrcDir)
|
||||
import StrongPath (Dir, File, Path, Rel,
|
||||
(</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified Util as U
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Util as U
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Action
|
||||
import qualified Wasp.Auth
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
import qualified Wasp.Auth
|
||||
|
||||
|
||||
genOperationsRoutes :: Wasp -> [FileDraft]
|
||||
genOperationsRoutes wasp = concat
|
||||
[ map (genActionRoute wasp) (Wasp.getActions wasp)
|
||||
, map (genQueryRoute wasp) (Wasp.getQueries wasp)
|
||||
, [genOperationsRouter wasp]
|
||||
genOperationsRoutes wasp =
|
||||
concat
|
||||
[ map (genActionRoute wasp) (Wasp.getActions wasp),
|
||||
map (genQueryRoute wasp) (Wasp.getQueries wasp),
|
||||
[genOperationsRouter wasp]
|
||||
]
|
||||
|
||||
genActionRoute :: Wasp -> Wasp.Action.Action -> FileDraft
|
||||
genActionRoute wasp action = genOperationRoute wasp op tmplFile
|
||||
where op = Wasp.Operation.ActionOp action
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_action.js|]
|
||||
where
|
||||
op = Wasp.Operation.ActionOp action
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_action.js|]
|
||||
|
||||
genQueryRoute :: Wasp -> Wasp.Query.Query -> FileDraft
|
||||
genQueryRoute wasp query = genOperationRoute wasp op tmplFile
|
||||
where op = Wasp.Operation.QueryOp query
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_query.js|]
|
||||
where
|
||||
op = Wasp.Operation.QueryOp query
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_query.js|]
|
||||
|
||||
genOperationRoute :: Wasp -> Wasp.Operation.Operation -> Path (Rel C.ServerTemplatesDir) File -> FileDraft
|
||||
genOperationRoute wasp operation tmplFile = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
dstFile = operationsRoutesDirInServerRootDir </> operationRouteFileInOperationsRoutesDir operation
|
||||
|
||||
baseTmplData = object
|
||||
[ "operationImportPath" .= operationImportPath
|
||||
, "operationName" .= Wasp.Operation.getName operation
|
||||
baseTmplData =
|
||||
object
|
||||
[ "operationImportPath" .= operationImportPath,
|
||||
"operationName" .= Wasp.Operation.getName operation
|
||||
]
|
||||
|
||||
tmplData = case (Wasp.getAuth wasp) of
|
||||
Nothing -> baseTmplData
|
||||
Just auth -> U.jsonSet ("userEntityLower")
|
||||
(Aeson.toJSON (U.toLowerFirst $ Wasp.Auth._userEntity auth))
|
||||
baseTmplData
|
||||
Nothing -> baseTmplData
|
||||
Just auth ->
|
||||
U.jsonSet
|
||||
("userEntityLower")
|
||||
(Aeson.toJSON (U.toLowerFirst $ Wasp.Auth._userEntity auth))
|
||||
baseTmplData
|
||||
|
||||
operationImportPath = relPosixPathFromOperationsRoutesDirToSrcDir
|
||||
operationImportPath =
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir
|
||||
FPPosix.</> SP.toFilePath (SP.relFileToPosix' $ operationFileInSrcDir operation)
|
||||
|
||||
data OperationsRoutesDir
|
||||
@ -75,25 +86,26 @@ operationRouteFileInOperationsRoutesDir operation = fromJust $ SP.parseRelFile $
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir :: FilePath -- Posix
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir = "../.."
|
||||
|
||||
|
||||
genOperationsRouter :: Wasp -> FileDraft
|
||||
genOperationsRouter wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/index.js|]
|
||||
dstFile = operationsRoutesDirInServerRootDir </> SP.fromPathRelFile [P.relfile|index.js|]
|
||||
operations = map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
||||
++ map Wasp.Operation.QueryOp (Wasp.getQueries wasp)
|
||||
tmplData = object
|
||||
[ "operationRoutes" .= map makeOperationRoute operations
|
||||
, "isAuthEnabled" .= (isJust $ getAuth wasp)
|
||||
operations =
|
||||
map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
||||
++ map Wasp.Operation.QueryOp (Wasp.getQueries wasp)
|
||||
tmplData =
|
||||
object
|
||||
[ "operationRoutes" .= map makeOperationRoute operations,
|
||||
"isAuthEnabled" .= (isJust $ getAuth wasp)
|
||||
]
|
||||
makeOperationRoute operation =
|
||||
let operationName = Wasp.Operation.getName operation
|
||||
in object
|
||||
[ "importIdentifier" .= operationName
|
||||
, "importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation))
|
||||
, "routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
||||
]
|
||||
let operationName = Wasp.Operation.getName operation
|
||||
in object
|
||||
[ "importIdentifier" .= operationName,
|
||||
"importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation)),
|
||||
"routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
||||
]
|
||||
|
||||
operationRouteInOperationsRouter :: Wasp.Operation.Operation -> String
|
||||
operationRouteInOperationsRouter = U.camelToKebabCase . Wasp.Operation.getName
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.ServerGenerator.Setup
|
||||
( setupServer
|
||||
) where
|
||||
( setupServer,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.ServerGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
setupServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
setupServer projectDir = do
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
runNodeCommandAsJob serverDir "npm" ["install"] J.Server
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
runNodeCommandAsJob serverDir "npm" ["install"] J.Server
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.ServerGenerator.Start
|
||||
( startServer
|
||||
) where
|
||||
( startServer,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.ServerGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
startServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
startServer projectDir = do
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
runNodeCommandAsJob serverDir "npm" ["start"] J.Server
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
runNodeCommandAsJob serverDir "npm" ["start"] J.Server
|
||||
|
@ -1,47 +1,47 @@
|
||||
module Generator.Setup
|
||||
( setup
|
||||
) where
|
||||
|
||||
import Control.Concurrent (Chan, newChan, readChan)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.IO (printPrefixedJobMessage)
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import Generator.WebAppGenerator.Setup (setupWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
( setup,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, newChan, readChan)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.IO (printPrefixedJobMessage)
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import Generator.WebAppGenerator.Setup (setupWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
setup :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
setup projectDir = do
|
||||
chan <- newChan
|
||||
let runSetupJobs = concurrently (setupServer projectDir chan) (setupWebApp projectDir chan)
|
||||
(_, result) <- concurrently (handleJobMessages chan) runSetupJobs
|
||||
case result of
|
||||
(ExitSuccess, ExitSuccess) -> return $ Right ()
|
||||
exitCodes -> return $ Left $ setupFailedMessage exitCodes
|
||||
chan <- newChan
|
||||
let runSetupJobs = concurrently (setupServer projectDir chan) (setupWebApp projectDir chan)
|
||||
(_, result) <- concurrently (handleJobMessages chan) runSetupJobs
|
||||
case result of
|
||||
(ExitSuccess, ExitSuccess) -> return $ Right ()
|
||||
exitCodes -> return $ Left $ setupFailedMessage exitCodes
|
||||
where
|
||||
handleJobMessages = go Nothing (False, False)
|
||||
where
|
||||
go :: Maybe J.JobMessage -> (Bool, Bool) -> Chan J.JobMessage -> IO ()
|
||||
go _ (True, True) _ = return ()
|
||||
go prevJobMsg (isWebAppDone, isServerDone) chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg
|
||||
>> go (Just jobMsg) (isWebAppDone, isServerDone) chan
|
||||
J.JobExit {} -> case J._jobType jobMsg of
|
||||
J.WebApp -> go (Just jobMsg) (True, isServerDone) chan
|
||||
J.Server -> go (Just jobMsg) (isWebAppDone, True) chan
|
||||
J.Db -> error "This should never happen. No db job should be active."
|
||||
handleJobMessages = go Nothing (False, False)
|
||||
where
|
||||
go :: Maybe J.JobMessage -> (Bool, Bool) -> Chan J.JobMessage -> IO ()
|
||||
go _ (True, True) _ = return ()
|
||||
go prevJobMsg (isWebAppDone, isServerDone) chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} ->
|
||||
printPrefixedJobMessage prevJobMsg jobMsg
|
||||
>> go (Just jobMsg) (isWebAppDone, isServerDone) chan
|
||||
J.JobExit {} -> case J._jobType jobMsg of
|
||||
J.WebApp -> go (Just jobMsg) (True, isServerDone) chan
|
||||
J.Server -> go (Just jobMsg) (isWebAppDone, True) chan
|
||||
J.Db -> error "This should never happen. No db job should be active."
|
||||
|
||||
setupFailedMessage (serverExitCode, webAppExitCode) =
|
||||
let serverErrorMessage = case serverExitCode of
|
||||
ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "."
|
||||
_ -> ""
|
||||
webAppErrorMessage = case webAppExitCode of
|
||||
ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "."
|
||||
_ -> ""
|
||||
in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage
|
||||
setupFailedMessage (serverExitCode, webAppExitCode) =
|
||||
let serverErrorMessage = case serverExitCode of
|
||||
ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "."
|
||||
_ -> ""
|
||||
webAppErrorMessage = case webAppExitCode of
|
||||
ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "."
|
||||
_ -> ""
|
||||
in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage
|
||||
|
@ -1,24 +1,23 @@
|
||||
module Generator.Start
|
||||
( start
|
||||
) where
|
||||
|
||||
import Control.Concurrent (newChan)
|
||||
import Control.Concurrent.Async (race, concurrently)
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||
import Generator.ServerGenerator.Start (startServer)
|
||||
import Generator.WebAppGenerator.Start (startWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
( start,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (newChan)
|
||||
import Control.Concurrent.Async (concurrently, race)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||
import Generator.ServerGenerator.Start (startServer)
|
||||
import Generator.WebAppGenerator.Start (startWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
-- | This is a blocking action, that will start the processes that run web app and server.
|
||||
-- It will run as long as one of those processes does not fail.
|
||||
start :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
start projectDir = do
|
||||
chan <- newChan
|
||||
let runStartJobs = race (startServer projectDir chan) (startWebApp projectDir chan)
|
||||
(_, serverOrWebExitCode) <- concurrently (readJobMessagesAndPrintThemPrefixed chan) runStartJobs
|
||||
case serverOrWebExitCode of
|
||||
Left serverExitCode -> return $ Left $ "Server failed with exit code " ++ show serverExitCode ++ "."
|
||||
Right webAppExitCode -> return $ Left $ "Web app failed with exit code " ++ show webAppExitCode ++ "."
|
||||
chan <- newChan
|
||||
let runStartJobs = race (startServer projectDir chan) (startWebApp projectDir chan)
|
||||
(_, serverOrWebExitCode) <- concurrently (readJobMessagesAndPrintThemPrefixed chan) runStartJobs
|
||||
case serverOrWebExitCode of
|
||||
Left serverExitCode -> return $ Left $ "Server failed with exit code " ++ show serverExitCode ++ "."
|
||||
Right webAppExitCode -> return $ Left $ "Web app failed with exit code " ++ show webAppExitCode ++ "."
|
||||
|
@ -1,21 +1,20 @@
|
||||
module Generator.Templates
|
||||
( getTemplatesDirAbsPath
|
||||
, getTemplateFileAbsPath
|
||||
, compileAndRenderTemplate
|
||||
, TemplatesDir
|
||||
) where
|
||||
|
||||
import qualified Text.Mustache as Mustache
|
||||
import Text.Mustache.Render (SubstitutionError(..))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import Text.Printf (printf)
|
||||
import qualified Path as P
|
||||
( getTemplatesDirAbsPath,
|
||||
getTemplateFileAbsPath,
|
||||
compileAndRenderTemplate,
|
||||
TemplatesDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data
|
||||
import StrongPath (Path, File, Dir, Abs, Rel, (</>))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified Text.Mustache as Mustache
|
||||
import Text.Mustache.Render (SubstitutionError (..))
|
||||
import Text.Printf (printf)
|
||||
|
||||
-- TODO: Write tests for this file! But first we need to decouple logic from IO
|
||||
-- so that we can mock it.
|
||||
@ -34,44 +33,49 @@ getTemplateFileAbsPath relTmplFilePath = (</> relTmplFilePath) <$> getTemplatesD
|
||||
templatesDirPathInDataDir :: Path (Rel Data.DataDir) (Dir TemplatesDir)
|
||||
templatesDirPathInDataDir = SP.fromPathRelDir [P.reldir|Generator/templates|]
|
||||
|
||||
|
||||
compileAndRenderTemplate
|
||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
||||
-> IO Text
|
||||
compileAndRenderTemplate ::
|
||||
-- | Path to the template file.
|
||||
Path (Rel TemplatesDir) File ->
|
||||
-- | JSON to be provided as template data.
|
||||
Aeson.Value ->
|
||||
IO Text
|
||||
compileAndRenderTemplate relTmplPath tmplData = do
|
||||
mustacheTemplate <- compileMustacheTemplate relTmplPath
|
||||
renderMustacheTemplate mustacheTemplate tmplData
|
||||
mustacheTemplate <- compileMustacheTemplate relTmplPath
|
||||
renderMustacheTemplate mustacheTemplate tmplData
|
||||
|
||||
compileMustacheTemplate
|
||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
||||
-> IO Mustache.Template
|
||||
compileMustacheTemplate ::
|
||||
-- | Path to the template file.
|
||||
Path (Rel TemplatesDir) File ->
|
||||
IO Mustache.Template
|
||||
compileMustacheTemplate relTmplPath = do
|
||||
templatesDirAbsPath <- getTemplatesDirAbsPath
|
||||
absTmplPath <- getTemplateFileAbsPath relTmplPath
|
||||
eitherTemplate <- Mustache.automaticCompile [SP.toFilePath templatesDirAbsPath]
|
||||
(SP.toFilePath absTmplPath)
|
||||
return $ either raiseCompileError id eitherTemplate
|
||||
templatesDirAbsPath <- getTemplatesDirAbsPath
|
||||
absTmplPath <- getTemplateFileAbsPath relTmplPath
|
||||
eitherTemplate <-
|
||||
Mustache.automaticCompile
|
||||
[SP.toFilePath templatesDirAbsPath]
|
||||
(SP.toFilePath absTmplPath)
|
||||
return $ either raiseCompileError id eitherTemplate
|
||||
where
|
||||
raiseCompileError err = error $ -- TODO: Handle these errors better?
|
||||
raiseCompileError err =
|
||||
error $ -- TODO: Handle these errors better?
|
||||
printf "Compilation of template %s failed. %s" (show relTmplPath) (show err)
|
||||
|
||||
areAllErrorsSectionDataNotFound :: [SubstitutionError] -> Bool
|
||||
areAllErrorsSectionDataNotFound = all isSectionDataNotFoundError
|
||||
where
|
||||
isSectionDataNotFoundError e = case e of
|
||||
SectionTargetNotFound _ -> True
|
||||
_ -> False
|
||||
SectionTargetNotFound _ -> True
|
||||
_ -> False
|
||||
|
||||
renderMustacheTemplate :: Mustache.Template -> Aeson.Value -> IO Text
|
||||
renderMustacheTemplate mustacheTemplate templateData = do
|
||||
let mustacheTemplateData = Mustache.toMustache templateData
|
||||
let (errors, fileText) =
|
||||
Mustache.checkedSubstituteValue mustacheTemplate mustacheTemplateData
|
||||
let mustacheTemplateData = Mustache.toMustache templateData
|
||||
let (errors, fileText) =
|
||||
Mustache.checkedSubstituteValue mustacheTemplate mustacheTemplateData
|
||||
|
||||
-- NOTE(matija): Mustache reports errors when object does
|
||||
-- not have a property specified in the template, which we use to implement
|
||||
-- conditionals. This is why we ignore these errors.
|
||||
if null errors || areAllErrorsSectionDataNotFound errors
|
||||
then return fileText
|
||||
else error $ "Unexpected errors occured while rendering template: " ++ show errors
|
||||
-- NOTE(matija): Mustache reports errors when object does
|
||||
-- not have a property specified in the template, which we use to implement
|
||||
-- conditionals. This is why we ignore these errors.
|
||||
if null errors || areAllErrorsSectionDataNotFound errors
|
||||
then return fileText
|
||||
else error $ "Unexpected errors occured while rendering template: " ++ show errors
|
||||
|
@ -1,103 +1,123 @@
|
||||
module Generator.WebAppGenerator
|
||||
( generateWebApp
|
||||
) where
|
||||
( generateWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..),
|
||||
object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import qualified Path as P
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft
|
||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
||||
toPackageJsonDependenciesString)
|
||||
import qualified Generator.WebAppGenerator.AuthG as AuthG
|
||||
import Generator.WebAppGenerator.Common (asTmplFile,
|
||||
asWebAppFile,
|
||||
asWebAppSrcFile)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson
|
||||
( ToJSON (..),
|
||||
object,
|
||||
(.=),
|
||||
)
|
||||
import Data.List (intercalate)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft
|
||||
import Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
import qualified Generator.WebAppGenerator.AuthG as AuthG
|
||||
import Generator.WebAppGenerator.Common
|
||||
( asTmplFile,
|
||||
asWebAppFile,
|
||||
asWebAppSrcFile,
|
||||
)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Generator.WebAppGenerator.ExternalCodeGenerator as WebAppExternalCodeGenerator
|
||||
import Generator.WebAppGenerator.OperationsGenerator (genOperations)
|
||||
import qualified Generator.WebAppGenerator.RouterGenerator as RouterGenerator
|
||||
import qualified NpmDependency as ND
|
||||
import StrongPath (Dir, Path,
|
||||
Rel, (</>))
|
||||
import Generator.WebAppGenerator.OperationsGenerator (genOperations)
|
||||
import qualified Generator.WebAppGenerator.RouterGenerator as RouterGenerator
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Path as P
|
||||
import StrongPath
|
||||
( Dir,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
import Wasp
|
||||
import Wasp
|
||||
import qualified Wasp.App
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
generateWebApp :: Wasp -> CompileOptions -> [FileDraft]
|
||||
generateWebApp wasp _ = concat
|
||||
[ [generateReadme wasp]
|
||||
, [genPackageJson wasp waspNpmDeps]
|
||||
, [generateGitignore wasp]
|
||||
, generatePublicDir wasp
|
||||
, generateSrcDir wasp
|
||||
, generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp
|
||||
, [C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
||||
generateWebApp wasp _ =
|
||||
concat
|
||||
[ [generateReadme wasp],
|
||||
[genPackageJson wasp waspNpmDeps],
|
||||
[generateGitignore wasp],
|
||||
generatePublicDir wasp,
|
||||
generateSrcDir wasp,
|
||||
generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp,
|
||||
[C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
||||
]
|
||||
|
||||
generateReadme :: Wasp -> FileDraft
|
||||
generateReadme wasp = C.makeSimpleTemplateFD (asTmplFile [P.relfile|README.md|]) wasp
|
||||
|
||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
genPackageJson wasp waspDeps =
|
||||
C.makeTemplateFD
|
||||
(C.asTmplFile [P.relfile|package.json|])
|
||||
(C.asWebAppFile [P.relfile|package.json|])
|
||||
(Just $ object
|
||||
[ "wasp" .= wasp
|
||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
])
|
||||
( Just $
|
||||
object
|
||||
[ "wasp" .= wasp,
|
||||
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
]
|
||||
)
|
||||
where
|
||||
(resolvedWaspDeps, resolvedUserDeps) =
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
Right deps -> deps
|
||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
Right deps -> deps
|
||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||
|
||||
userDeps :: [ND.NpmDependency]
|
||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||
|
||||
waspNpmDeps :: [ND.NpmDependency]
|
||||
waspNpmDeps = ND.fromList
|
||||
[ ("axios", "^0.21.1")
|
||||
, ("lodash", "^4.17.15")
|
||||
, ("react", "^16.12.0")
|
||||
, ("react-dom", "^16.12.0")
|
||||
, ("react-query", "^2.14.1")
|
||||
, ("react-router-dom", "^5.1.2")
|
||||
, ("react-scripts", "4.0.3")
|
||||
, ("uuid", "^3.4.0")
|
||||
waspNpmDeps =
|
||||
ND.fromList
|
||||
[ ("axios", "^0.21.1"),
|
||||
("lodash", "^4.17.15"),
|
||||
("react", "^16.12.0"),
|
||||
("react-dom", "^16.12.0"),
|
||||
("react-query", "^2.14.1"),
|
||||
("react-router-dom", "^5.1.2"),
|
||||
("react-scripts", "4.0.3"),
|
||||
("uuid", "^3.4.0")
|
||||
]
|
||||
|
||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||
|
||||
generateGitignore :: Wasp -> FileDraft
|
||||
generateGitignore wasp = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
||||
(asWebAppFile [P.relfile|.gitignore|])
|
||||
(Just $ toJSON wasp)
|
||||
generateGitignore wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|gitignore|])
|
||||
(asWebAppFile [P.relfile|.gitignore|])
|
||||
(Just $ toJSON wasp)
|
||||
|
||||
generatePublicDir :: Wasp -> [FileDraft]
|
||||
generatePublicDir wasp =
|
||||
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|])
|
||||
: generatePublicIndexHtml wasp
|
||||
: map (\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
||||
[ [P.relfile|manifest.json|]
|
||||
]
|
||||
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|]) :
|
||||
generatePublicIndexHtml wasp :
|
||||
map
|
||||
(\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
||||
[ [P.relfile|manifest.json|]
|
||||
]
|
||||
|
||||
generatePublicIndexHtml :: Wasp -> FileDraft
|
||||
generatePublicIndexHtml wasp = C.makeTemplateFD
|
||||
generatePublicIndexHtml wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.relfile|public/index.html|])
|
||||
targetPath
|
||||
(Just templateData)
|
||||
where
|
||||
targetPath = SP.fromPathRelFile [P.relfile|public/index.html|]
|
||||
templateData = object
|
||||
[ "title" .= (Wasp.App.appTitle $ getApp wasp)
|
||||
, "head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
||||
]
|
||||
where
|
||||
targetPath = SP.fromPathRelFile [P.relfile|public/index.html|]
|
||||
templateData =
|
||||
object
|
||||
[ "title" .= (Wasp.App.appTitle $ getApp wasp),
|
||||
"head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
||||
]
|
||||
|
||||
-- * Src dir
|
||||
|
||||
@ -108,28 +128,34 @@ srcDir = C.webAppSrcDirInWebAppRootDir
|
||||
-- although they are not used anywhere outside.
|
||||
-- We could further "templatize" this file so only what is needed is generated.
|
||||
--
|
||||
|
||||
-- | Generates api.js file which contains token management and configured api (e.g. axios) instance.
|
||||
genApi :: FileDraft
|
||||
genApi = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/api.js|])
|
||||
|
||||
generateSrcDir :: Wasp -> [FileDraft]
|
||||
generateSrcDir wasp
|
||||
= generateLogo
|
||||
: RouterGenerator.generateRouter wasp
|
||||
: genApi
|
||||
: map makeSimpleSrcTemplateFD
|
||||
[ [P.relfile|index.js|]
|
||||
, [P.relfile|index.css|]
|
||||
, [P.relfile|serviceWorker.js|]
|
||||
, [P.relfile|config.js|]
|
||||
, [P.relfile|queryCache.js|]
|
||||
]
|
||||
generateSrcDir wasp =
|
||||
generateLogo :
|
||||
RouterGenerator.generateRouter wasp :
|
||||
genApi :
|
||||
map
|
||||
makeSimpleSrcTemplateFD
|
||||
[ [P.relfile|index.js|],
|
||||
[P.relfile|index.css|],
|
||||
[P.relfile|serviceWorker.js|],
|
||||
[P.relfile|config.js|],
|
||||
[P.relfile|queryCache.js|]
|
||||
]
|
||||
++ genOperations wasp
|
||||
++ AuthG.genAuth wasp
|
||||
where
|
||||
generateLogo = C.makeTemplateFD (asTmplFile [P.relfile|src/logo.png|])
|
||||
(srcDir </> asWebAppSrcFile [P.relfile|logo.png|])
|
||||
Nothing
|
||||
makeSimpleSrcTemplateFD path = C.makeTemplateFD (asTmplFile $ [P.reldir|src|] P.</> path)
|
||||
(srcDir </> asWebAppSrcFile path)
|
||||
(Just $ toJSON wasp)
|
||||
generateLogo =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|src/logo.png|])
|
||||
(srcDir </> asWebAppSrcFile [P.relfile|logo.png|])
|
||||
Nothing
|
||||
makeSimpleSrcTemplateFD path =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> path)
|
||||
(srcDir </> asWebAppSrcFile path)
|
||||
(Just $ toJSON wasp)
|
||||
|
@ -1,28 +1,29 @@
|
||||
module Generator.WebAppGenerator.AuthG
|
||||
( genAuth
|
||||
) where
|
||||
( genAuth,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath ((</>))
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp.Auth
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common as C
|
||||
|
||||
genAuth :: Wasp -> [FileDraft]
|
||||
genAuth wasp = case maybeAuth of
|
||||
Just auth -> [ genSignup
|
||||
, genLogin
|
||||
, genLogout
|
||||
, genUseAuth
|
||||
, genCreateAuthRequiredPage auth
|
||||
]
|
||||
++ genAuthForms
|
||||
Nothing -> []
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
Just auth ->
|
||||
[ genSignup,
|
||||
genLogin,
|
||||
genLogout,
|
||||
genUseAuth,
|
||||
genCreateAuthRequiredPage auth
|
||||
]
|
||||
++ genAuthForms
|
||||
Nothing -> []
|
||||
where
|
||||
maybeAuth = getAuth wasp
|
||||
|
||||
-- | Generates file with signup function to be used by Wasp developer.
|
||||
genSignup :: FileDraft
|
||||
@ -38,14 +39,15 @@ genLogout = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/logout.js|])
|
||||
|
||||
-- | Generates HOC that handles auth for the given page.
|
||||
genCreateAuthRequiredPage :: Wasp.Auth.Auth -> FileDraft
|
||||
genCreateAuthRequiredPage auth = C.makeTemplateFD
|
||||
genCreateAuthRequiredPage auth =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> authReqPagePath)
|
||||
targetPath
|
||||
(Just templateData)
|
||||
where
|
||||
authReqPagePath = [P.relfile|auth/pages/createAuthRequiredPage.js|]
|
||||
targetPath = C.webAppSrcDirInWebAppRootDir </> (asWebAppSrcFile authReqPagePath)
|
||||
templateData = object [ "onAuthFailedRedirectTo" .= (Wasp.Auth._onAuthFailedRedirectTo auth) ]
|
||||
where
|
||||
authReqPagePath = [P.relfile|auth/pages/createAuthRequiredPage.js|]
|
||||
targetPath = C.webAppSrcDirInWebAppRootDir </> (asWebAppSrcFile authReqPagePath)
|
||||
templateData = object ["onAuthFailedRedirectTo" .= (Wasp.Auth._onAuthFailedRedirectTo auth)]
|
||||
|
||||
-- | Generates React hook that Wasp developer can use in a component to get
|
||||
-- access to the currently logged in user (and check whether user is logged in
|
||||
@ -55,9 +57,9 @@ genUseAuth = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/useAuth.js|])
|
||||
|
||||
genAuthForms :: [FileDraft]
|
||||
genAuthForms =
|
||||
[ genLoginForm
|
||||
, genSignupForm
|
||||
]
|
||||
[ genLoginForm,
|
||||
genSignupForm
|
||||
]
|
||||
|
||||
genLoginForm :: FileDraft
|
||||
genLoginForm = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/forms/Login.js|])
|
||||
|
@ -1,34 +1,34 @@
|
||||
module Generator.WebAppGenerator.Common
|
||||
( webAppRootDirInProjectRootDir
|
||||
, webAppSrcDirInWebAppRootDir
|
||||
, copyTmplAsIs
|
||||
, makeSimpleTemplateFD
|
||||
, makeTemplateFD
|
||||
, webAppSrcDirInProjectRootDir
|
||||
, webAppTemplatesDirInTemplatesDir
|
||||
, asTmplFile
|
||||
, asWebAppFile
|
||||
, asWebAppSrcFile
|
||||
, WebAppRootDir
|
||||
, WebAppSrcDir
|
||||
, WebAppTemplatesDir
|
||||
) where
|
||||
( webAppRootDirInProjectRootDir,
|
||||
webAppSrcDirInWebAppRootDir,
|
||||
copyTmplAsIs,
|
||||
makeSimpleTemplateFD,
|
||||
makeTemplateFD,
|
||||
webAppSrcDirInProjectRootDir,
|
||||
webAppTemplatesDirInTemplatesDir,
|
||||
asTmplFile,
|
||||
asWebAppFile,
|
||||
asWebAppSrcFile,
|
||||
WebAppRootDir,
|
||||
WebAppSrcDir,
|
||||
WebAppTemplatesDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
|
||||
data WebAppRootDir
|
||||
data WebAppSrcDir
|
||||
data WebAppTemplatesDir
|
||||
|
||||
data WebAppSrcDir
|
||||
|
||||
data WebAppTemplatesDir
|
||||
|
||||
asTmplFile :: P.Path P.Rel P.File -> Path (Rel WebAppTemplatesDir) File
|
||||
asTmplFile = SP.fromPathRelFile
|
||||
@ -39,7 +39,6 @@ asWebAppFile = SP.fromPathRelFile
|
||||
asWebAppSrcFile :: P.Path P.Rel P.File -> Path (Rel WebAppSrcDir) File
|
||||
asWebAppSrcFile = SP.fromPathRelFile
|
||||
|
||||
|
||||
-- * Paths
|
||||
|
||||
-- | Path where web app root dir is generated, relative to the root directory of the whole generated project.
|
||||
@ -53,7 +52,6 @@ webAppSrcDirInWebAppRootDir = SP.fromPathRelDir [P.reldir|src|]
|
||||
webAppSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir WebAppSrcDir)
|
||||
webAppSrcDirInProjectRootDir = webAppRootDirInProjectRootDir </> webAppSrcDirInWebAppRootDir
|
||||
|
||||
|
||||
-- * Templates
|
||||
|
||||
-- | Path in templates directory where web app templates reside.
|
||||
@ -66,13 +64,13 @@ copyTmplAsIs path = makeTemplateFD path (SP.castRel path) Nothing
|
||||
makeSimpleTemplateFD :: Path (Rel WebAppTemplatesDir) File -> Wasp -> FileDraft
|
||||
makeSimpleTemplateFD path wasp = makeTemplateFD path (SP.castRel path) (Just $ Aeson.toJSON wasp)
|
||||
|
||||
makeTemplateFD
|
||||
:: Path (Rel WebAppTemplatesDir) File
|
||||
-> Path (Rel WebAppRootDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
makeTemplateFD ::
|
||||
Path (Rel WebAppTemplatesDir) File ->
|
||||
Path (Rel WebAppRootDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
makeTemplateFD srcPathInWebAppTemplatesDir dstPathInWebAppRootDir tmplData =
|
||||
createTemplateFileDraft
|
||||
(webAppRootDirInProjectRootDir </> dstPathInWebAppRootDir)
|
||||
(webAppTemplatesDirInTemplatesDir </> srcPathInWebAppTemplatesDir)
|
||||
tmplData
|
||||
createTemplateFileDraft
|
||||
(webAppRootDirInProjectRootDir </> dstPathInWebAppRootDir)
|
||||
(webAppTemplatesDirInTemplatesDir </> srcPathInWebAppTemplatesDir)
|
||||
tmplData
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.WebAppGenerator.ExternalCodeGenerator
|
||||
( extCodeDirInWebAppSrcDir
|
||||
, generatorStrategy
|
||||
) where
|
||||
( extCodeDirInWebAppSrcDir,
|
||||
generatorStrategy,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy(..), GeneratedExternalCodeDir)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||
import Generator.ExternalCodeGenerator.Js (resolveJsFileWaspImportsForExtCodeDir)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Relative path to directory where external code will be generated.
|
||||
-- Relative to web app src dir.
|
||||
@ -17,9 +17,11 @@ extCodeDirInWebAppSrcDir :: Path (Rel C.WebAppSrcDir) (Dir GeneratedExternalCode
|
||||
extCodeDirInWebAppSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||
|
||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir)
|
||||
, _extCodeDirInProjectRootDir = C.webAppRootDirInProjectRootDir
|
||||
</> C.webAppSrcDirInWebAppRootDir
|
||||
</> extCodeDirInWebAppSrcDir
|
||||
generatorStrategy =
|
||||
ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir),
|
||||
_extCodeDirInProjectRootDir =
|
||||
C.webAppRootDirInProjectRootDir
|
||||
</> C.webAppSrcDirInWebAppRootDir
|
||||
</> extCodeDirInWebAppSrcDir
|
||||
}
|
||||
|
@ -1,42 +1,48 @@
|
||||
module Generator.WebAppGenerator.OperationsGenerator
|
||||
( genOperations
|
||||
) where
|
||||
( genOperations,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object,
|
||||
(.=))
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust,
|
||||
fromMaybe)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator as ServerGenerator
|
||||
import qualified Generator.ServerGenerator.OperationsRoutesG as ServerOperationsRoutesG
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import Data.Aeson
|
||||
( object,
|
||||
(.=),
|
||||
)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe
|
||||
( fromJust,
|
||||
fromMaybe,
|
||||
)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator as ServerGenerator
|
||||
import qualified Generator.ServerGenerator.OperationsRoutesG as ServerOperationsRoutesG
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Generator.WebAppGenerator.OperationsGenerator.ResourcesG as Resources
|
||||
import Wasp (Wasp)
|
||||
import qualified Path as P
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Action
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
|
||||
|
||||
genOperations :: Wasp -> [FileDraft]
|
||||
genOperations wasp = concat
|
||||
[ genQueries wasp
|
||||
, genActions wasp
|
||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp]
|
||||
, Resources.genResources wasp
|
||||
genOperations wasp =
|
||||
concat
|
||||
[ genQueries wasp,
|
||||
genActions wasp,
|
||||
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp],
|
||||
Resources.genResources wasp
|
||||
]
|
||||
|
||||
genQueries :: Wasp -> [FileDraft]
|
||||
genQueries wasp = concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
||||
genQueries wasp =
|
||||
concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp),
|
||||
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
||||
]
|
||||
|
||||
genActions :: Wasp -> [FileDraft]
|
||||
genActions wasp = concat
|
||||
genActions wasp =
|
||||
concat
|
||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||
]
|
||||
|
||||
@ -44,14 +50,17 @@ genQuery :: Wasp -> Wasp.Query.Query -> FileDraft
|
||||
genQuery _ query = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/queries/_query.js|]
|
||||
-- | TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
|
||||
dstFile = C.asWebAppFile $ [P.reldir|src/queries/|] P.</> fromJust (getOperationDstFileName operation)
|
||||
tmplData = object
|
||||
[ "queryFnName" .= Wasp.Query._name query
|
||||
, "queryRoute" .=
|
||||
(ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
tmplData =
|
||||
object
|
||||
[ "queryFnName" .= Wasp.Query._name query,
|
||||
"queryRoute"
|
||||
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/"
|
||||
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||
),
|
||||
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
]
|
||||
operation = Wasp.Operation.QueryOp query
|
||||
|
||||
@ -59,14 +68,17 @@ genAction :: Wasp -> Wasp.Action.Action -> FileDraft
|
||||
genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/actions/_action.js|]
|
||||
-- | TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
|
||||
dstFile = C.asWebAppFile $ [P.reldir|src/actions/|] P.</> fromJust (getOperationDstFileName operation)
|
||||
tmplData = object
|
||||
[ "actionFnName" .= Wasp.Action._name action
|
||||
, "actionRoute" .=
|
||||
(ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
tmplData =
|
||||
object
|
||||
[ "actionFnName" .= Wasp.Action._name action,
|
||||
"actionRoute"
|
||||
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/"
|
||||
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||
),
|
||||
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
]
|
||||
operation = Wasp.Operation.ActionOp action
|
||||
|
||||
@ -74,7 +86,8 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
-- E.g. "['Task', 'Project']"
|
||||
makeJsArrayOfEntityNames :: Wasp.Operation.Operation -> String
|
||||
makeJsArrayOfEntityNames operation = "[" ++ intercalate ", " entityStrings ++ "]"
|
||||
where entityStrings = map (\x -> "'" ++ x ++ "'") $ fromMaybe [] $ Wasp.Operation.getEntities operation
|
||||
where
|
||||
entityStrings = map (\x -> "'" ++ x ++ "'") $ fromMaybe [] $ Wasp.Operation.getEntities operation
|
||||
|
||||
getOperationDstFileName :: Wasp.Operation.Operation -> Maybe (P.Path P.Rel P.File)
|
||||
getOperationDstFileName operation = P.parseRelFile (Wasp.Operation.getName operation ++ ".js")
|
||||
|
@ -1,14 +1,13 @@
|
||||
module Generator.WebAppGenerator.OperationsGenerator.ResourcesG
|
||||
( genResources
|
||||
) where
|
||||
|
||||
import Data.Aeson (object)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import Wasp (Wasp)
|
||||
( genResources,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import Wasp (Wasp)
|
||||
|
||||
genResources :: Wasp -> [FileDraft]
|
||||
genResources _ = [C.makeTemplateFD tmplFile dstFile (Just tmplData)]
|
||||
|
@ -1,118 +1,123 @@
|
||||
module Generator.WebAppGenerator.RouterGenerator
|
||||
( generateRouter
|
||||
) where
|
||||
( generateRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common (asTmplFile, asWebAppSrcFile)
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common (asTmplFile, asWebAppSrcFile)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import StrongPath ((</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Path as P
|
||||
import StrongPath ((</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.JsImport
|
||||
import qualified Wasp.Page
|
||||
import qualified Wasp.Route
|
||||
|
||||
|
||||
data RouterTemplateData = RouterTemplateData
|
||||
{ _routes :: ![RouteTemplateData]
|
||||
, _pagesToImport :: ![PageTemplateData]
|
||||
, _isAuthEnabled :: Bool
|
||||
}
|
||||
{ _routes :: ![RouteTemplateData],
|
||||
_pagesToImport :: ![PageTemplateData],
|
||||
_isAuthEnabled :: Bool
|
||||
}
|
||||
|
||||
instance ToJSON RouterTemplateData where
|
||||
toJSON routerTD = object
|
||||
[ "routes" .= _routes routerTD
|
||||
, "pagesToImport" .= _pagesToImport routerTD
|
||||
, "isAuthEnabled" .= _isAuthEnabled routerTD
|
||||
]
|
||||
toJSON routerTD =
|
||||
object
|
||||
[ "routes" .= _routes routerTD,
|
||||
"pagesToImport" .= _pagesToImport routerTD,
|
||||
"isAuthEnabled" .= _isAuthEnabled routerTD
|
||||
]
|
||||
|
||||
data RouteTemplateData = RouteTemplateData
|
||||
{ _urlPath :: !String
|
||||
, _targetComponent :: !String
|
||||
}
|
||||
{ _urlPath :: !String,
|
||||
_targetComponent :: !String
|
||||
}
|
||||
|
||||
instance ToJSON RouteTemplateData where
|
||||
toJSON routeTD = object
|
||||
[ "urlPath" .= _urlPath routeTD
|
||||
, "targetComponent" .= _targetComponent routeTD
|
||||
]
|
||||
toJSON routeTD =
|
||||
object
|
||||
[ "urlPath" .= _urlPath routeTD,
|
||||
"targetComponent" .= _targetComponent routeTD
|
||||
]
|
||||
|
||||
data PageTemplateData = PageTemplateData
|
||||
{ _importWhat :: !String
|
||||
, _importFrom :: !String
|
||||
} deriving (Show, Eq)
|
||||
{ _importWhat :: !String,
|
||||
_importFrom :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PageTemplateData where
|
||||
toJSON pageTD = object
|
||||
[ "importWhat" .= _importWhat pageTD
|
||||
, "importFrom" .= _importFrom pageTD
|
||||
]
|
||||
toJSON pageTD =
|
||||
object
|
||||
[ "importWhat" .= _importWhat pageTD,
|
||||
"importFrom" .= _importFrom pageTD
|
||||
]
|
||||
|
||||
generateRouter :: Wasp -> FileDraft
|
||||
generateRouter wasp = C.makeTemplateFD
|
||||
generateRouter wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> routerPath)
|
||||
targetPath
|
||||
(Just $ toJSON templateData)
|
||||
where
|
||||
routerPath = [P.relfile|router.js|]
|
||||
templateData = createRouterTemplateData wasp
|
||||
targetPath = C.webAppSrcDirInWebAppRootDir </> asWebAppSrcFile routerPath
|
||||
where
|
||||
routerPath = [P.relfile|router.js|]
|
||||
templateData = createRouterTemplateData wasp
|
||||
targetPath = C.webAppSrcDirInWebAppRootDir </> asWebAppSrcFile routerPath
|
||||
|
||||
createRouterTemplateData :: Wasp -> RouterTemplateData
|
||||
createRouterTemplateData wasp = RouterTemplateData
|
||||
{ _routes = routes
|
||||
, _pagesToImport = pages
|
||||
, _isAuthEnabled = isJust $ Wasp.getAuth wasp
|
||||
createRouterTemplateData wasp =
|
||||
RouterTemplateData
|
||||
{ _routes = routes,
|
||||
_pagesToImport = pages,
|
||||
_isAuthEnabled = isJust $ Wasp.getAuth wasp
|
||||
}
|
||||
where
|
||||
routes = map (createRouteTemplateData wasp) $ Wasp.getRoutes wasp
|
||||
pages = map createPageTemplateData $ Wasp.getPages wasp
|
||||
where
|
||||
routes = map (createRouteTemplateData wasp) $ Wasp.getRoutes wasp
|
||||
pages = map createPageTemplateData $ Wasp.getPages wasp
|
||||
|
||||
createRouteTemplateData :: Wasp -> Wasp.Route.Route -> RouteTemplateData
|
||||
createRouteTemplateData wasp route = RouteTemplateData
|
||||
{ _urlPath = Wasp.Route._urlPath route
|
||||
, _targetComponent = determineRouteTargetComponent wasp route
|
||||
createRouteTemplateData wasp route =
|
||||
RouteTemplateData
|
||||
{ _urlPath = Wasp.Route._urlPath route,
|
||||
_targetComponent = determineRouteTargetComponent wasp route
|
||||
}
|
||||
|
||||
determineRouteTargetComponent :: Wasp -> Wasp.Route.Route -> String
|
||||
determineRouteTargetComponent wasp route =
|
||||
maybe
|
||||
targetPageName
|
||||
determineRouteTargetComponent'
|
||||
(Wasp.Page._authRequired targetPage)
|
||||
where
|
||||
targetPageName = Wasp.Route._targetPage route
|
||||
-- NOTE(matija): if no page with the name specified in the route, head will fail.
|
||||
targetPage = head $ filter ((==) targetPageName . Wasp.Page._name) (Wasp.getPages wasp)
|
||||
|
||||
-- | Applied if authRequired property is present.
|
||||
determineRouteTargetComponent' :: Bool -> String
|
||||
determineRouteTargetComponent' authRequired =
|
||||
if authRequired
|
||||
-- TODO(matija): would be nicer if this function name wasn't hardcoded here.
|
||||
then "createAuthRequiredPage(" ++ targetPageName ++ ")"
|
||||
else targetPageName
|
||||
|
||||
maybe
|
||||
targetPageName
|
||||
determineRouteTargetComponent'
|
||||
(Wasp.Page._authRequired targetPage)
|
||||
where
|
||||
targetPageName = Wasp.Route._targetPage route
|
||||
-- NOTE(matija): if no page with the name specified in the route, head will fail.
|
||||
targetPage = head $ filter ((==) targetPageName . Wasp.Page._name) (Wasp.getPages wasp)
|
||||
|
||||
determineRouteTargetComponent' :: Bool -> String
|
||||
determineRouteTargetComponent' authRequired =
|
||||
if authRequired
|
||||
then -- TODO(matija): would be nicer if this function name wasn't hardcoded here.
|
||||
"createAuthRequiredPage(" ++ targetPageName ++ ")"
|
||||
else targetPageName
|
||||
|
||||
createPageTemplateData :: Wasp.Page.Page -> PageTemplateData
|
||||
createPageTemplateData page = PageTemplateData
|
||||
{ _importFrom = relPathToExtSrcDir ++
|
||||
SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent)
|
||||
, _importWhat = case Wasp.JsImport._namedImports pageComponent of
|
||||
-- If no named imports, we go with the default import.
|
||||
[] -> pageName
|
||||
[namedImport] -> "{ " ++ namedImport ++ " as " ++ pageName ++ " }"
|
||||
_ -> error "Only one named import can be provided for a page."
|
||||
createPageTemplateData page =
|
||||
PageTemplateData
|
||||
{ _importFrom =
|
||||
relPathToExtSrcDir
|
||||
++ SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent),
|
||||
_importWhat = case Wasp.JsImport._namedImports pageComponent of
|
||||
-- If no named imports, we go with the default import.
|
||||
[] -> pageName
|
||||
[namedImport] -> "{ " ++ namedImport ++ " as " ++ pageName ++ " }"
|
||||
_ -> error "Only one named import can be provided for a page."
|
||||
}
|
||||
where
|
||||
relPathToExtSrcDir :: FilePath
|
||||
relPathToExtSrcDir = "./ext-src/"
|
||||
where
|
||||
relPathToExtSrcDir :: FilePath
|
||||
relPathToExtSrcDir = "./ext-src/"
|
||||
|
||||
pageName = Wasp.Page._name page
|
||||
pageComponent = Wasp.Page._component page
|
||||
pageName = Wasp.Page._name page
|
||||
pageComponent = Wasp.Page._component page
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.WebAppGenerator.Setup
|
||||
( setupWebApp
|
||||
) where
|
||||
( setupWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.WebAppGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
setupWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
setupWebApp projectDir = do
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
runNodeCommandAsJob webAppDir "npm" ["install"] J.WebApp
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
runNodeCommandAsJob webAppDir "npm" ["install"] J.WebApp
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.WebAppGenerator.Start
|
||||
( startWebApp
|
||||
) where
|
||||
( startWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.WebAppGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
startWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
startWebApp projectDir = do
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
runNodeCommandAsJob webAppDir "npm" ["start"] J.WebApp
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
runNodeCommandAsJob webAppDir "npm" ["start"] J.WebApp
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Lexer where
|
||||
|
||||
import Text.Parsec (letter, alphaNum, (<|>), char, between)
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec (alphaNum, between, char, letter, (<|>))
|
||||
import Text.Parsec.Language (emptyDef)
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Text.Parsec.Token as Token
|
||||
|
||||
reservedNameImport :: String
|
||||
@ -56,32 +56,33 @@ reservedNameBooleanFalse = "false"
|
||||
|
||||
reservedNames :: [String]
|
||||
reservedNames =
|
||||
[ reservedNameImport
|
||||
, reservedNameFrom
|
||||
[ reservedNameImport,
|
||||
reservedNameFrom,
|
||||
-- Wasp element types
|
||||
, reservedNameApp
|
||||
, reservedNameDependencies
|
||||
, reservedNamePage
|
||||
, reservedNameRoute
|
||||
, reservedNameEntity
|
||||
, reservedNameAuth
|
||||
, reservedNameQuery
|
||||
, reservedNameAction
|
||||
reservedNameApp,
|
||||
reservedNameDependencies,
|
||||
reservedNamePage,
|
||||
reservedNameRoute,
|
||||
reservedNameEntity,
|
||||
reservedNameAuth,
|
||||
reservedNameQuery,
|
||||
reservedNameAction,
|
||||
-- Data types
|
||||
, reservedNameString
|
||||
, reservedNameBoolean
|
||||
, reservedNameBooleanTrue
|
||||
, reservedNameBooleanFalse
|
||||
]
|
||||
reservedNameString,
|
||||
reservedNameBoolean,
|
||||
reservedNameBooleanTrue,
|
||||
reservedNameBooleanFalse
|
||||
]
|
||||
|
||||
waspLanguageDef :: Token.LanguageDef ()
|
||||
waspLanguageDef = emptyDef
|
||||
{ Token.commentLine = "//"
|
||||
, Token.reservedNames = reservedNames
|
||||
, Token.caseSensitive = True
|
||||
-- Identifier
|
||||
, Token.identStart = letter
|
||||
, Token.identLetter = alphaNum <|> char '_'
|
||||
waspLanguageDef =
|
||||
emptyDef
|
||||
{ Token.commentLine = "//",
|
||||
Token.reservedNames = reservedNames,
|
||||
Token.caseSensitive = True,
|
||||
-- Identifier
|
||||
Token.identStart = letter,
|
||||
Token.identLetter = alphaNum <|> char '_'
|
||||
}
|
||||
|
||||
waspLexer :: Token.TokenParser ()
|
||||
|
@ -1,72 +1,75 @@
|
||||
module Lib
|
||||
( compile
|
||||
, Generator.setup
|
||||
, Generator.start
|
||||
, ProjectRootDir
|
||||
) where
|
||||
( compile,
|
||||
Generator.setup,
|
||||
Generator.start,
|
||||
ProjectRootDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
import System.Directory (doesFileExist)
|
||||
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions)
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions)
|
||||
import qualified CompileOptions
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.List (find, isSuffixOf)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.List (find, isSuffixOf)
|
||||
import qualified ExternalCode
|
||||
import qualified Generator
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Parser
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (doesFileExist)
|
||||
import qualified Util.IO
|
||||
import Wasp (Wasp)
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
|
||||
type CompileError = String
|
||||
|
||||
compile :: Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir ProjectRootDir)
|
||||
-> CompileOptions
|
||||
-> IO (Either CompileError ())
|
||||
compile ::
|
||||
Path Abs (Dir WaspProjectDir) ->
|
||||
Path Abs (Dir ProjectRootDir) ->
|
||||
CompileOptions ->
|
||||
IO (Either CompileError ())
|
||||
compile waspDir outDir options = do
|
||||
maybeWaspFile <- findWaspFile waspDir
|
||||
case maybeWaspFile of
|
||||
Nothing -> return $ Left "Couldn't find a single *.wasp file."
|
||||
Just waspFile -> do
|
||||
waspStr <- readFile (SP.toFilePath waspFile)
|
||||
maybeWaspFile <- findWaspFile waspDir
|
||||
case maybeWaspFile of
|
||||
Nothing -> return $ Left "Couldn't find a single *.wasp file."
|
||||
Just waspFile -> do
|
||||
waspStr <- readFile (SP.toFilePath waspFile)
|
||||
|
||||
case Parser.parseWasp waspStr of
|
||||
Left err -> return $ Left (show err)
|
||||
Right wasp -> do
|
||||
maybeDotEnvFile <- findDotEnvFile waspDir
|
||||
(wasp
|
||||
`Wasp.setDotEnvFile` maybeDotEnvFile
|
||||
`enrichWaspASTBasedOnCompileOptions` options
|
||||
) >>= generateCode
|
||||
case Parser.parseWasp waspStr of
|
||||
Left err -> return $ Left (show err)
|
||||
Right wasp -> do
|
||||
maybeDotEnvFile <- findDotEnvFile waspDir
|
||||
( wasp
|
||||
`Wasp.setDotEnvFile` maybeDotEnvFile
|
||||
`enrichWaspASTBasedOnCompileOptions` options
|
||||
)
|
||||
>>= generateCode
|
||||
where
|
||||
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
||||
|
||||
enrichWaspASTBasedOnCompileOptions :: Wasp -> CompileOptions -> IO Wasp
|
||||
enrichWaspASTBasedOnCompileOptions wasp options = do
|
||||
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
|
||||
return (wasp
|
||||
`Wasp.setExternalCodeFiles` externalCodeFiles
|
||||
`Wasp.setIsBuild` CompileOptions.isBuild options
|
||||
)
|
||||
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
|
||||
return
|
||||
( wasp
|
||||
`Wasp.setExternalCodeFiles` externalCodeFiles
|
||||
`Wasp.setIsBuild` CompileOptions.isBuild options
|
||||
)
|
||||
|
||||
findWaspFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
||||
findWaspFile waspDir = do
|
||||
(files, _) <- liftIO $ Util.IO.listDirectory (SP.toPathAbsDir waspDir)
|
||||
return $ (waspDir SP.</>) . SP.fromPathRelFile <$> find isWaspFile files
|
||||
(files, _) <- liftIO $ Util.IO.listDirectory (SP.toPathAbsDir waspDir)
|
||||
return $ (waspDir SP.</>) . SP.fromPathRelFile <$> find isWaspFile files
|
||||
where
|
||||
isWaspFile :: P.Path P.Rel P.File -> Bool
|
||||
isWaspFile path = ".wasp" `isSuffixOf` P.toFilePath path
|
||||
&& (length (P.toFilePath path) > length (".wasp" :: String))
|
||||
isWaspFile :: P.Path P.Rel P.File -> Bool
|
||||
isWaspFile path =
|
||||
".wasp" `isSuffixOf` P.toFilePath path
|
||||
&& (length (P.toFilePath path) > length (".wasp" :: String))
|
||||
|
||||
findDotEnvFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
||||
findDotEnvFile waspDir = do
|
||||
let dotEnvAbsPath = waspDir SP.</> SP.fromPathRelFile [P.relfile|.env|]
|
||||
dotEnvExists <- doesFileExist (SP.toFilePath dotEnvAbsPath)
|
||||
return $ if dotEnvExists then Just dotEnvAbsPath else Nothing
|
||||
let dotEnvAbsPath = waspDir SP.</> SP.fromPathRelFile [P.relfile|.env|]
|
||||
dotEnvExists <- doesFileExist (SP.toFilePath dotEnvAbsPath)
|
||||
return $ if dotEnvExists then Just dotEnvAbsPath else Nothing
|
||||
|
@ -1,21 +1,23 @@
|
||||
module NpmDependency
|
||||
( NpmDependency (..)
|
||||
, fromList
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
( NpmDependency (..),
|
||||
fromList,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
data NpmDependency = NpmDependency
|
||||
{ _name :: !String
|
||||
, _version :: !String }
|
||||
{ _name :: !String,
|
||||
_version :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
fromList :: [(String, String)] -> [NpmDependency]
|
||||
fromList = map (\(name, version) -> NpmDependency { _name = name, _version = version })
|
||||
fromList = map (\(name, version) -> NpmDependency {_name = name, _version = version})
|
||||
|
||||
instance ToJSON NpmDependency where
|
||||
toJSON npmDep = object
|
||||
[ "name" .= _name npmDep
|
||||
, "version" .= _version npmDep
|
||||
]
|
||||
toJSON npmDep =
|
||||
object
|
||||
[ "name" .= _name npmDep,
|
||||
"version" .= _version npmDep
|
||||
]
|
||||
|
@ -1,30 +1,27 @@
|
||||
module Parser
|
||||
( parseWasp
|
||||
) where
|
||||
|
||||
import Text.Parsec (ParseError, (<|>), many1, eof, many)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Wasp
|
||||
( parseWasp,
|
||||
)
|
||||
where
|
||||
|
||||
import Lexer
|
||||
|
||||
import qualified Parser.Action
|
||||
import Parser.App (app)
|
||||
import Parser.Auth (auth)
|
||||
import Parser.Db (db)
|
||||
import Parser.Route (route)
|
||||
import Parser.Page (page)
|
||||
import Parser.Entity (entity)
|
||||
|
||||
import Parser.JsImport (jsImport)
|
||||
import Parser.Common (runWaspParser)
|
||||
import qualified Parser.Query
|
||||
import qualified Parser.Action
|
||||
import Parser.Db (db)
|
||||
import Parser.Entity (entity)
|
||||
import Parser.JsImport (jsImport)
|
||||
import qualified Parser.NpmDependencies
|
||||
import Parser.Page (page)
|
||||
import qualified Parser.Query
|
||||
import Parser.Route (route)
|
||||
import Text.Parsec (ParseError, eof, many, many1, (<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp
|
||||
|
||||
waspElement :: Parser Wasp.WaspElement
|
||||
waspElement
|
||||
= waspElementApp
|
||||
waspElement =
|
||||
waspElementApp
|
||||
<|> waspElementAuth
|
||||
<|> waspElementPage
|
||||
<|> waspElementDb
|
||||
@ -52,7 +49,6 @@ waspElementRoute = Wasp.WaspElementRoute <$> route
|
||||
waspElementEntity :: Parser Wasp.WaspElement
|
||||
waspElementEntity = Wasp.WaspElementEntity <$> entity
|
||||
|
||||
|
||||
waspElementQuery :: Parser Wasp.WaspElement
|
||||
waspElementQuery = Wasp.WaspElementQuery <$> Parser.Query.query
|
||||
|
||||
@ -62,26 +58,25 @@ waspElementAction = Wasp.WaspElementAction <$> Parser.Action.action
|
||||
waspElementNpmDependencies :: Parser Wasp.WaspElement
|
||||
waspElementNpmDependencies = Wasp.WaspElementNpmDependencies <$> Parser.NpmDependencies.npmDependencies
|
||||
|
||||
|
||||
-- | Top level parser, produces Wasp.
|
||||
waspParser :: Parser Wasp.Wasp
|
||||
waspParser = do
|
||||
-- NOTE(matija): this is the only place we need to use whiteSpace, to skip empty lines
|
||||
-- and comments in the beginning of file. All other used parsers are lexeme parsers
|
||||
-- so they do it themselves.
|
||||
whiteSpace
|
||||
-- NOTE(matija): this is the only place we need to use whiteSpace, to skip empty lines
|
||||
-- and comments in the beginning of file. All other used parsers are lexeme parsers
|
||||
-- so they do it themselves.
|
||||
whiteSpace
|
||||
|
||||
jsImports <- many jsImport
|
||||
jsImports <- many jsImport
|
||||
|
||||
waspElems <- many1 waspElement
|
||||
waspElems <- many1 waspElement
|
||||
|
||||
eof
|
||||
eof
|
||||
|
||||
-- TODO(matija): after we parsed everything, we should do semantic analysis
|
||||
-- e.g. check there is only 1 title - if not, throw a meaningful error.
|
||||
-- Also, check there is at least one Page defined.
|
||||
-- TODO(matija): after we parsed everything, we should do semantic analysis
|
||||
-- e.g. check there is only 1 title - if not, throw a meaningful error.
|
||||
-- Also, check there is at least one Page defined.
|
||||
|
||||
return $ Wasp.fromWaspElems waspElems `Wasp.setJsImports` jsImports
|
||||
return $ Wasp.fromWaspElems waspElems `Wasp.setJsImports` jsImports
|
||||
|
||||
-- | Top level parser executor.
|
||||
parseWasp :: String -> Either ParseError Wasp.Wasp
|
||||
|
@ -1,23 +1,23 @@
|
||||
module Parser.Action
|
||||
( action
|
||||
) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
( action,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
|
||||
action :: Parser Action
|
||||
action = do
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameAction Operation.properties
|
||||
return Action.Action
|
||||
{ Action._name = name
|
||||
, Action._jsFunction =
|
||||
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props)
|
||||
, Action._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameAction Operation.properties
|
||||
return
|
||||
Action.Action
|
||||
{ Action._name = name,
|
||||
Action._jsFunction =
|
||||
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||
Action._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
|
@ -1,29 +1,30 @@
|
||||
module Parser.App
|
||||
( app
|
||||
) where
|
||||
( app,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Lexer
|
||||
import qualified Lexer as L
|
||||
import Parser.Common
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Data.Maybe (listToMaybe)
|
||||
|
||||
import Lexer
|
||||
import qualified Wasp.App as App
|
||||
import Parser.Common
|
||||
import qualified Lexer as L
|
||||
|
||||
-- | A type that describes supported app properties.
|
||||
data AppProperty
|
||||
= Title !String
|
||||
| Favicon !String
|
||||
| Head [String]
|
||||
deriving (Show, Eq)
|
||||
= Title !String
|
||||
| Favicon !String
|
||||
| Head [String]
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Parses supported app properties, expects format "key1: value1, key2: value2, ..."
|
||||
appProperties :: Parser [AppProperty]
|
||||
appProperties = commaSep1
|
||||
$ appPropertyTitle
|
||||
<|> appPropertyFavicon
|
||||
<|> appPropertyHead
|
||||
appProperties =
|
||||
commaSep1 $
|
||||
appPropertyTitle
|
||||
<|> appPropertyFavicon
|
||||
<|> appPropertyHead
|
||||
|
||||
appPropertyTitle :: Parser AppProperty
|
||||
appPropertyTitle = Title <$> waspPropertyStringLiteral "title"
|
||||
@ -45,11 +46,12 @@ getAppHead ps = listToMaybe [hs | Head hs <- ps]
|
||||
-- | Top level parser, parses App.
|
||||
app :: Parser App.App
|
||||
app = do
|
||||
(appName, appProps) <- waspElementNameAndClosureContent reservedNameApp appProperties
|
||||
(appName, appProps) <- waspElementNameAndClosureContent reservedNameApp appProperties
|
||||
|
||||
return App.App
|
||||
{ App.appName = appName
|
||||
, App.appTitle = getAppTitle appProps
|
||||
, App.appHead = getAppHead appProps
|
||||
-- TODO(matija): add favicon.
|
||||
}
|
||||
return
|
||||
App.App
|
||||
{ App.appName = appName,
|
||||
App.appTitle = getAppTitle appProps,
|
||||
App.appHead = getAppHead appProps
|
||||
-- TODO(matija): add favicon.
|
||||
}
|
||||
|
@ -1,45 +1,47 @@
|
||||
module Parser.Auth
|
||||
( auth
|
||||
) where
|
||||
( auth,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec ((<|>))
|
||||
import Control.Monad (when)
|
||||
|
||||
import qualified Wasp.Auth
|
||||
import qualified Parser.Common as P
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Auth
|
||||
|
||||
auth :: Parser Wasp.Auth.Auth
|
||||
auth = do
|
||||
L.reserved L.reservedNameAuth
|
||||
authProperties <- P.waspClosure (L.commaSep1 authProperty)
|
||||
L.reserved L.reservedNameAuth
|
||||
authProperties <- P.waspClosure (L.commaSep1 authProperty)
|
||||
|
||||
let userEntityProps = [s | AuthPropertyUserEntity s <- authProperties]
|
||||
failIfPropMissing propUserEntityName userEntityProps
|
||||
let userEntityProps = [s | AuthPropertyUserEntity s <- authProperties]
|
||||
failIfPropMissing propUserEntityName userEntityProps
|
||||
|
||||
let methodsProps = [ms | AuthPropertyMethods ms <- authProperties]
|
||||
failIfPropMissing propMethodsName methodsProps
|
||||
let methodsProps = [ms | AuthPropertyMethods ms <- authProperties]
|
||||
failIfPropMissing propMethodsName methodsProps
|
||||
|
||||
let redirectProps = [r | AuthPropertyOnAuthFailedRedirectTo r <- authProperties]
|
||||
failIfPropMissing propOnAuthFailedRedirectToName redirectProps
|
||||
let redirectProps = [r | AuthPropertyOnAuthFailedRedirectTo r <- authProperties]
|
||||
failIfPropMissing propOnAuthFailedRedirectToName redirectProps
|
||||
|
||||
return Wasp.Auth.Auth
|
||||
{ Wasp.Auth._userEntity = head userEntityProps
|
||||
, Wasp.Auth._methods = head methodsProps
|
||||
, Wasp.Auth._onAuthFailedRedirectTo = head redirectProps
|
||||
}
|
||||
return
|
||||
Wasp.Auth.Auth
|
||||
{ Wasp.Auth._userEntity = head userEntityProps,
|
||||
Wasp.Auth._methods = head methodsProps,
|
||||
Wasp.Auth._onAuthFailedRedirectTo = head redirectProps
|
||||
}
|
||||
|
||||
-- TODO(matija): this should be extracted if we want to use in other places too.
|
||||
failIfPropMissing :: (Applicative m, MonadFail m) => String -> [p] -> m ()
|
||||
failIfPropMissing propName ps = when (null ps) $ fail errorMsg
|
||||
where errorMsg = propName ++ " is required!"
|
||||
where
|
||||
errorMsg = propName ++ " is required!"
|
||||
|
||||
-- Auxiliary data structure used by parser.
|
||||
data AuthProperty
|
||||
= AuthPropertyUserEntity String
|
||||
| AuthPropertyMethods [Wasp.Auth.AuthMethod]
|
||||
| AuthPropertyOnAuthFailedRedirectTo String
|
||||
= AuthPropertyUserEntity String
|
||||
| AuthPropertyMethods [Wasp.Auth.AuthMethod]
|
||||
| AuthPropertyOnAuthFailedRedirectTo String
|
||||
|
||||
propUserEntityName :: String
|
||||
propUserEntityName = "userEntity"
|
||||
@ -53,14 +55,14 @@ propOnAuthFailedRedirectToName = "onAuthFailedRedirectTo"
|
||||
-- Sub-parsers
|
||||
|
||||
authProperty :: Parser AuthProperty
|
||||
authProperty
|
||||
= authPropertyUserEntity
|
||||
authProperty =
|
||||
authPropertyUserEntity
|
||||
<|> authPropertyMethods
|
||||
<|> authPropertyOnAuthFailedRedirectTo
|
||||
|
||||
authPropertyOnAuthFailedRedirectTo :: Parser AuthProperty
|
||||
authPropertyOnAuthFailedRedirectTo =
|
||||
AuthPropertyOnAuthFailedRedirectTo <$> (P.waspPropertyStringLiteral "onAuthFailedRedirectTo")
|
||||
AuthPropertyOnAuthFailedRedirectTo <$> (P.waspPropertyStringLiteral "onAuthFailedRedirectTo")
|
||||
|
||||
authPropertyUserEntity :: Parser AuthProperty
|
||||
authPropertyUserEntity = AuthPropertyUserEntity <$> (P.waspProperty "userEntity" L.identifier)
|
||||
|
@ -4,15 +4,19 @@
|
||||
|
||||
module Parser.Common where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PPosix
|
||||
import Text.Parsec (ParseError, anyChar, manyTill, parse, try,
|
||||
unexpected)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Lexer as L
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PPosix
|
||||
import Text.Parsec
|
||||
( ParseError,
|
||||
anyChar,
|
||||
manyTill,
|
||||
parse,
|
||||
try,
|
||||
unexpected,
|
||||
)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
-- | Runs given wasp parser on a specified input.
|
||||
runWaspParser :: Parser a -> String -> Either ParseError a
|
||||
@ -24,33 +28,40 @@ runWaspParser waspParser input = parse waspParser sourceName input
|
||||
sourceName = ""
|
||||
|
||||
-- TODO(matija): rename to just "waspElement"?
|
||||
|
||||
-- | Parses declaration of a wasp element (e.g. App or Page) and the closure content.
|
||||
waspElementNameAndClosureContent
|
||||
:: String -- ^ Type of the wasp element (e.g. "app" or "page").
|
||||
-> Parser a -- ^ Parser to be used for parsing closure content of the wasp element.
|
||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
||||
waspElementNameAndClosureContent ::
|
||||
-- | Type of the wasp element (e.g. "app" or "page").
|
||||
String ->
|
||||
-- | Parser to be used for parsing closure content of the wasp element.
|
||||
Parser a ->
|
||||
-- | Name of the element and parsed closure content.
|
||||
Parser (String, a)
|
||||
waspElementNameAndClosureContent elementType closureContent =
|
||||
waspElementNameAndClosure elementType (waspClosure closureContent)
|
||||
waspElementNameAndClosure elementType (waspClosure closureContent)
|
||||
|
||||
-- | Parses declaration of a wasp element (e.g. App or Page) and the belonging closure.
|
||||
waspElementNameAndClosure
|
||||
:: String -- ^ Element type
|
||||
-> Parser a -- ^ Closure parser (needs to parse braces as well, not just the content)
|
||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
||||
waspElementNameAndClosure ::
|
||||
-- | Element type
|
||||
String ->
|
||||
-- | Closure parser (needs to parse braces as well, not just the content)
|
||||
Parser a ->
|
||||
-- | Name of the element and parsed closure content.
|
||||
Parser (String, a)
|
||||
waspElementNameAndClosure elementType closure =
|
||||
-- NOTE(matija): It is important to have `try` here because we don't want to consume the
|
||||
-- content intended for other parsers.
|
||||
-- E.g. if we tried to parse "entity-form" this parser would have been tried first for
|
||||
-- "entity" and would consume "entity", so entity-form parser would also fail.
|
||||
-- This way when entity parser fails, it will backtrack and allow
|
||||
-- entity-form parser to succeed.
|
||||
--
|
||||
-- TODO(matija): should I push this try higher, to the specific case of entity parser
|
||||
-- which is causing the trouble?
|
||||
-- This way try will be executed in more cases where it is not neccessary, this
|
||||
-- might not be the best for the performance and the clarity of error messages.
|
||||
-- On the other hand, it is safer?
|
||||
try $ do
|
||||
-- NOTE(matija): It is important to have `try` here because we don't want to consume the
|
||||
-- content intended for other parsers.
|
||||
-- E.g. if we tried to parse "entity-form" this parser would have been tried first for
|
||||
-- "entity" and would consume "entity", so entity-form parser would also fail.
|
||||
-- This way when entity parser fails, it will backtrack and allow
|
||||
-- entity-form parser to succeed.
|
||||
--
|
||||
-- TODO(matija): should I push this try higher, to the specific case of entity parser
|
||||
-- which is causing the trouble?
|
||||
-- This way try will be executed in more cases where it is not neccessary, this
|
||||
-- might not be the best for the performance and the clarity of error messages.
|
||||
-- On the other hand, it is safer?
|
||||
try $ do
|
||||
L.reserved elementType
|
||||
elementName <- L.identifier
|
||||
closureContent <- closure
|
||||
@ -59,16 +70,19 @@ waspElementNameAndClosure elementType closure =
|
||||
|
||||
-- | Parses declaration of a wasp element linked to an entity.
|
||||
-- E.g. "entity-form<Task> ..." or "action<Task> ..."
|
||||
waspElementLinkedToEntity
|
||||
:: String -- ^ Type of the linked wasp element (e.g. "entity-form").
|
||||
-> Parser a -- ^ Parser to be used for parsing body of the wasp element.
|
||||
-> Parser (String, String, a) -- ^ Name of the linked entity, element name and body.
|
||||
waspElementLinkedToEntity ::
|
||||
-- | Type of the linked wasp element (e.g. "entity-form").
|
||||
String ->
|
||||
-- | Parser to be used for parsing body of the wasp element.
|
||||
Parser a ->
|
||||
-- | Name of the linked entity, element name and body.
|
||||
Parser (String, String, a)
|
||||
waspElementLinkedToEntity elementType bodyParser = do
|
||||
L.reserved elementType
|
||||
linkedEntityName <- L.angles L.identifier
|
||||
elementName <- L.identifier
|
||||
body <- bodyParser
|
||||
return (linkedEntityName, elementName, body)
|
||||
L.reserved elementType
|
||||
linkedEntityName <- L.angles L.identifier
|
||||
elementName <- L.identifier
|
||||
body <- bodyParser
|
||||
return (linkedEntityName, elementName, body)
|
||||
|
||||
-- | Parses wasp property along with the key, "key: value".
|
||||
waspProperty :: String -> Parser a -> Parser a
|
||||
@ -88,10 +102,10 @@ waspPropertyBool key = waspProperty key L.bool
|
||||
-- form "FIELD_NAME: {...}" -> FIELD_NAME is then an identifier we need.
|
||||
waspPropertyWithIdentifierAsKey :: Parser a -> Parser (String, a)
|
||||
waspPropertyWithIdentifierAsKey valueP = do
|
||||
identifier <- L.identifier <* L.colon
|
||||
value <- valueP
|
||||
identifier <- L.identifier <* L.colon
|
||||
value <- valueP
|
||||
|
||||
return (identifier, value)
|
||||
return (identifier, value)
|
||||
|
||||
-- | Parses wasp closure, which is {...}. Returns parsed content within the closure.
|
||||
waspClosure :: Parser a -> Parser a
|
||||
@ -128,14 +142,15 @@ waspCssClosure :: Parser String
|
||||
waspCssClosure = waspNamedClosure "css"
|
||||
|
||||
-- TODO(martin): write tests and comments.
|
||||
|
||||
-- | Parses named wasp closure, which is {=name...name=}. Returns content within the closure.
|
||||
waspNamedClosure :: String -> Parser String
|
||||
waspNamedClosure name = do
|
||||
_ <- closureStart
|
||||
strip <$> manyTill anyChar (try closureEnd)
|
||||
_ <- closureStart
|
||||
strip <$> manyTill anyChar (try closureEnd)
|
||||
where
|
||||
closureStart = L.symbol ("{=" ++ name)
|
||||
closureEnd = L.symbol (name ++ "=}")
|
||||
closureStart = L.symbol ("{=" ++ name)
|
||||
closureEnd = L.symbol (name ++ "=}")
|
||||
|
||||
-- | Parses a list of items that can be parsed with given parser.
|
||||
-- For example, `waspList L.identifier` will parse "[foo, bar, t]" into ["foo", "bar", "t"].
|
||||
@ -149,15 +164,17 @@ strip = T.unpack . T.strip . T.pack
|
||||
-- | Parses relative file path, e.g. "my/file.txt".
|
||||
relFilePathString :: Parser (P.Path P.Rel P.File)
|
||||
relFilePathString = do
|
||||
path <- L.stringLiteral
|
||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(P.parseRelFile path)
|
||||
path <- L.stringLiteral
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(P.parseRelFile path)
|
||||
|
||||
-- | Parses relative posix file path, e.g. "my/file.txt".
|
||||
relPosixFilePathString :: Parser (PPosix.Path PPosix.Rel PPosix.File)
|
||||
relPosixFilePathString = do
|
||||
path <- L.stringLiteral
|
||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(PPosix.parseRelFile path)
|
||||
path <- L.stringLiteral
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(PPosix.parseRelFile path)
|
||||
|
@ -1,36 +1,40 @@
|
||||
module Parser.Db
|
||||
( db
|
||||
) where
|
||||
( db,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec ((<|>), try)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
|
||||
import qualified Wasp.Db
|
||||
import qualified Parser.Common as P
|
||||
import Data.Maybe (fromMaybe, listToMaybe)
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec (try, (<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Db
|
||||
|
||||
db :: Parser Wasp.Db.Db
|
||||
db = do
|
||||
L.reserved L.reservedNameDb
|
||||
dbProperties <- P.waspClosure (L.commaSep1 dbProperty)
|
||||
L.reserved L.reservedNameDb
|
||||
dbProperties <- P.waspClosure (L.commaSep1 dbProperty)
|
||||
|
||||
system <- fromMaybe (fail "'system' property is required!") $ return <$>
|
||||
listToMaybe [p | DbPropertySystem p <- dbProperties]
|
||||
system <-
|
||||
fromMaybe (fail "'system' property is required!") $
|
||||
return
|
||||
<$> listToMaybe [p | DbPropertySystem p <- dbProperties]
|
||||
|
||||
return Wasp.Db.Db
|
||||
{ Wasp.Db._system = system
|
||||
}
|
||||
return
|
||||
Wasp.Db.Db
|
||||
{ Wasp.Db._system = system
|
||||
}
|
||||
|
||||
data DbProperty
|
||||
= DbPropertySystem Wasp.Db.DbSystem
|
||||
= DbPropertySystem Wasp.Db.DbSystem
|
||||
|
||||
dbProperty :: Parser DbProperty
|
||||
dbProperty
|
||||
= dbPropertySystem
|
||||
dbProperty =
|
||||
dbPropertySystem
|
||||
|
||||
dbPropertySystem :: Parser DbProperty
|
||||
dbPropertySystem = DbPropertySystem <$> (P.waspProperty "system" dbPropertySystemValue)
|
||||
where
|
||||
dbPropertySystemValue = try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
||||
<|> try (L.symbol "SQLite" >> return Wasp.Db.SQLite)
|
||||
dbPropertySystemValue =
|
||||
try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
||||
<|> try (L.symbol "SQLite" >> return Wasp.Db.SQLite)
|
||||
|
@ -1,27 +1,28 @@
|
||||
module Parser.Entity
|
||||
( entity
|
||||
) where
|
||||
( entity,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Psl.Ast.Model as PslModel
|
||||
import qualified Lexer as L
|
||||
import qualified Psl.Ast.Model as PslModel
|
||||
import qualified Psl.Parser.Model
|
||||
import qualified Wasp.Entity as Entity
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Entity as Entity
|
||||
|
||||
entity :: Parser Entity.Entity
|
||||
entity = do
|
||||
_ <- L.reserved L.reservedNameEntity
|
||||
name <- L.identifier
|
||||
_ <- L.symbol "{=psl"
|
||||
pslModelBody <- Psl.Parser.Model.body
|
||||
_ <- L.symbol "psl=}"
|
||||
_ <- L.reserved L.reservedNameEntity
|
||||
name <- L.identifier
|
||||
_ <- L.symbol "{=psl"
|
||||
pslModelBody <- Psl.Parser.Model.body
|
||||
_ <- L.symbol "psl=}"
|
||||
|
||||
return Entity.Entity
|
||||
{ Entity._name = name
|
||||
, Entity._fields = getEntityFields pslModelBody
|
||||
, Entity._pslModelBody = pslModelBody
|
||||
}
|
||||
return
|
||||
Entity.Entity
|
||||
{ Entity._name = name,
|
||||
Entity._fields = getEntityFields pslModelBody,
|
||||
Entity._pslModelBody = pslModelBody
|
||||
}
|
||||
|
||||
getEntityFields :: PslModel.Body -> [Entity.Field]
|
||||
getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslFields
|
||||
@ -29,35 +30,37 @@ getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslField
|
||||
pslFields = [field | (PslModel.ElementField field) <- pslElements]
|
||||
|
||||
pslFieldToEntityField :: PslModel.Field -> Entity.Field
|
||||
pslFieldToEntityField pslField = Entity.Field
|
||||
{ Entity._fieldName = PslModel._name pslField
|
||||
, Entity._fieldType = pslFieldTypeToEntityFieldType
|
||||
(PslModel._type pslField)
|
||||
(PslModel._typeModifiers pslField)
|
||||
pslFieldToEntityField pslField =
|
||||
Entity.Field
|
||||
{ Entity._fieldName = PslModel._name pslField,
|
||||
Entity._fieldType =
|
||||
pslFieldTypeToEntityFieldType
|
||||
(PslModel._type pslField)
|
||||
(PslModel._typeModifiers pslField)
|
||||
}
|
||||
|
||||
pslFieldTypeToEntityFieldType
|
||||
:: PslModel.FieldType
|
||||
-> [PslModel.FieldTypeModifier]
|
||||
-> Entity.FieldType
|
||||
pslFieldTypeToEntityFieldType ::
|
||||
PslModel.FieldType ->
|
||||
[PslModel.FieldTypeModifier] ->
|
||||
Entity.FieldType
|
||||
pslFieldTypeToEntityFieldType fType fTypeModifiers =
|
||||
let scalar = pslFieldTypeToScalar fType
|
||||
in case fTypeModifiers of
|
||||
[] -> Entity.FieldTypeScalar scalar
|
||||
[PslModel.List] -> Entity.FieldTypeComposite $ Entity.List scalar
|
||||
[PslModel.Optional] -> Entity.FieldTypeComposite $ Entity.Optional scalar
|
||||
_ -> error "Not a valid list of modifiers."
|
||||
let scalar = pslFieldTypeToScalar fType
|
||||
in case fTypeModifiers of
|
||||
[] -> Entity.FieldTypeScalar scalar
|
||||
[PslModel.List] -> Entity.FieldTypeComposite $ Entity.List scalar
|
||||
[PslModel.Optional] -> Entity.FieldTypeComposite $ Entity.Optional scalar
|
||||
_ -> error "Not a valid list of modifiers."
|
||||
|
||||
pslFieldTypeToScalar :: PslModel.FieldType -> Entity.Scalar
|
||||
pslFieldTypeToScalar fType = case fType of
|
||||
PslModel.String -> Entity.String
|
||||
PslModel.Boolean -> Entity.Boolean
|
||||
PslModel.Int -> Entity.Int
|
||||
PslModel.BigInt -> Entity.BigInt
|
||||
PslModel.Float -> Entity.Float
|
||||
PslModel.Decimal -> Entity.Decimal
|
||||
PslModel.DateTime -> Entity.DateTime
|
||||
PslModel.Json -> Entity.Json
|
||||
PslModel.Bytes -> Entity.Bytes
|
||||
PslModel.UserType typeName -> Entity.UserType typeName
|
||||
PslModel.Unsupported typeName -> Entity.Unsupported typeName
|
||||
PslModel.String -> Entity.String
|
||||
PslModel.Boolean -> Entity.Boolean
|
||||
PslModel.Int -> Entity.Int
|
||||
PslModel.BigInt -> Entity.BigInt
|
||||
PslModel.Float -> Entity.Float
|
||||
PslModel.Decimal -> Entity.Decimal
|
||||
PslModel.DateTime -> Entity.DateTime
|
||||
PslModel.Json -> Entity.Json
|
||||
PslModel.Bytes -> Entity.Bytes
|
||||
PslModel.UserType typeName -> Entity.UserType typeName
|
||||
PslModel.Unsupported typeName -> Entity.Unsupported typeName
|
||||
|
@ -1,23 +1,23 @@
|
||||
module Parser.ExternalCode
|
||||
( extCodeFilePathString
|
||||
) where
|
||||
( extCodeFilePathString,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path.Posix as PPosix
|
||||
import Text.Parsec (unexpected)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import qualified Parser.Common
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified Path.Posix as PPosix
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import Text.Parsec (unexpected)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
-- Parses string literal that is file path to file in source external code dir.
|
||||
-- Returns file path relative to the external code dir.
|
||||
-- Example of input: "@ext/some/file.txt". Output would be: "some/file.txt".
|
||||
extCodeFilePathString :: Parser (Path' Posix (Rel SourceExternalCodeDir) File)
|
||||
extCodeFilePathString = do
|
||||
path <- Parser.Common.relPosixFilePathString
|
||||
maybe (unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
||||
(return . SP.fromPathRelFileP)
|
||||
(PPosix.stripProperPrefix [PPosix.reldir|@ext|] path)
|
||||
path <- Parser.Common.relPosixFilePathString
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
||||
(return . SP.fromPathRelFileP)
|
||||
(PPosix.stripProperPrefix [PPosix.reldir|@ext|] path)
|
||||
|
@ -1,11 +1,11 @@
|
||||
module Parser.JsCode
|
||||
( jsCode
|
||||
) where
|
||||
( jsCode,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.JsCode as WJS
|
||||
|
||||
jsCode :: Parser WJS.JsCode
|
||||
|
@ -1,31 +1,32 @@
|
||||
module Parser.JsImport
|
||||
( jsImport
|
||||
) where
|
||||
( jsImport,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.ExternalCode
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Parser.ExternalCode
|
||||
import qualified Lexer as L
|
||||
import qualified Wasp.JsImport
|
||||
|
||||
|
||||
-- | Parses subset of JS import statement (only default or single named import, and only external code files):
|
||||
-- import <identifier> from "@ext/..."
|
||||
-- import { <identifier> } from "@ext/..."
|
||||
jsImport :: Parser Wasp.JsImport.JsImport
|
||||
jsImport = do
|
||||
L.whiteSpace
|
||||
_ <- L.reserved L.reservedNameImport
|
||||
-- For now we support only default import or one named import.
|
||||
(defaultImport, namedImports) <- ((\i -> (Just i, [])) <$> L.identifier)
|
||||
<|> ((\i -> (Nothing, [i])) <$> L.braces L.identifier)
|
||||
_ <- L.reserved L.reservedNameFrom
|
||||
-- TODO: For now we only support double quotes here, we should also support single quotes.
|
||||
-- We would need to write this from scratch, with single quote escaping enabled.
|
||||
from <- Parser.ExternalCode.extCodeFilePathString
|
||||
return Wasp.JsImport.JsImport
|
||||
{ Wasp.JsImport._defaultImport = defaultImport
|
||||
, Wasp.JsImport._namedImports = namedImports
|
||||
, Wasp.JsImport._from = from
|
||||
}
|
||||
L.whiteSpace
|
||||
_ <- L.reserved L.reservedNameImport
|
||||
-- For now we support only default import or one named import.
|
||||
(defaultImport, namedImports) <-
|
||||
((\i -> (Just i, [])) <$> L.identifier)
|
||||
<|> ((\i -> (Nothing, [i])) <$> L.braces L.identifier)
|
||||
_ <- L.reserved L.reservedNameFrom
|
||||
-- TODO: For now we only support double quotes here, we should also support single quotes.
|
||||
-- We would need to write this from scratch, with single quote escaping enabled.
|
||||
from <- Parser.ExternalCode.extCodeFilePathString
|
||||
return
|
||||
Wasp.JsImport.JsImport
|
||||
{ Wasp.JsImport._defaultImport = defaultImport,
|
||||
Wasp.JsImport._namedImports = namedImports,
|
||||
Wasp.JsImport._from = from
|
||||
}
|
||||
|
@ -1,31 +1,31 @@
|
||||
module Parser.NpmDependencies
|
||||
( npmDependencies
|
||||
) where
|
||||
( npmDependencies,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.ByteString.Lazy.UTF8 as BLU
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Text.Parsec (try)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Parser.Common as P
|
||||
import Wasp.NpmDependencies (NpmDependencies)
|
||||
import qualified Wasp.NpmDependencies as NpmDependencies
|
||||
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Lexer as L
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec (try)
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.NpmDependencies (NpmDependencies)
|
||||
import qualified Wasp.NpmDependencies as NpmDependencies
|
||||
|
||||
npmDependencies :: Parser NpmDependencies
|
||||
npmDependencies = try $ do
|
||||
L.reserved L.reservedNameDependencies
|
||||
closureContent <- P.waspNamedClosure "json"
|
||||
let jsonBytestring = BLU.fromString $ "{ " ++ closureContent ++ " }"
|
||||
npmDeps <- case Aeson.eitherDecode' jsonBytestring :: Either String (M.HashMap String String) of
|
||||
Left errorMessage -> fail $ "Failed to parse dependencies JSON: " ++ errorMessage
|
||||
Right rawDeps -> return $ map rawDepToNpmDep (M.toList rawDeps)
|
||||
return NpmDependencies.NpmDependencies
|
||||
{ NpmDependencies._dependencies = npmDeps
|
||||
}
|
||||
L.reserved L.reservedNameDependencies
|
||||
closureContent <- P.waspNamedClosure "json"
|
||||
let jsonBytestring = BLU.fromString $ "{ " ++ closureContent ++ " }"
|
||||
npmDeps <- case Aeson.eitherDecode' jsonBytestring :: Either String (M.HashMap String String) of
|
||||
Left errorMessage -> fail $ "Failed to parse dependencies JSON: " ++ errorMessage
|
||||
Right rawDeps -> return $ map rawDepToNpmDep (M.toList rawDeps)
|
||||
return
|
||||
NpmDependencies.NpmDependencies
|
||||
{ NpmDependencies._dependencies = npmDeps
|
||||
}
|
||||
where
|
||||
rawDepToNpmDep :: (String, String) -> ND.NpmDependency
|
||||
rawDepToNpmDep (name, version) = ND.NpmDependency { ND._name = name, ND._version = version }
|
||||
rawDepToNpmDep (name, version) = ND.NpmDependency {ND._name = name, ND._version = version}
|
||||
|
@ -1,31 +1,32 @@
|
||||
module Parser.Operation
|
||||
( jsFunctionPropParser
|
||||
, entitiesPropParser
|
||||
, getJsFunctionFromProps
|
||||
, getEntitiesFromProps
|
||||
, properties
|
||||
( jsFunctionPropParser,
|
||||
entitiesPropParser,
|
||||
getJsFunctionFromProps,
|
||||
getEntitiesFromProps,
|
||||
properties,
|
||||
-- FOR TESTS:
|
||||
, Property(..)
|
||||
) where
|
||||
Property (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import Data.Maybe (listToMaybe)
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.JsImport
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.JsImport
|
||||
|
||||
|
||||
data Property = JsFunction !Wasp.JsImport.JsImport
|
||||
| Entities ![String]
|
||||
deriving (Show, Eq)
|
||||
data Property
|
||||
= JsFunction !Wasp.JsImport.JsImport
|
||||
| Entities ![String]
|
||||
deriving (Show, Eq)
|
||||
|
||||
properties :: Parser [Property]
|
||||
properties = L.commaSep1 $
|
||||
properties =
|
||||
L.commaSep1 $
|
||||
jsFunctionPropParser
|
||||
<|> entitiesPropParser
|
||||
<|> entitiesPropParser
|
||||
|
||||
jsFunctionPropParser :: Parser Property
|
||||
jsFunctionPropParser = JsFunction <$> C.waspProperty "fn" Parser.JsImport.jsImport
|
||||
|
@ -1,30 +1,30 @@
|
||||
module Parser.Page
|
||||
( page
|
||||
) where
|
||||
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
|
||||
import qualified Wasp.Page as Page
|
||||
import Wasp.JsImport (JsImport)
|
||||
( page,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe, listToMaybe)
|
||||
import Lexer
|
||||
import Parser.Common
|
||||
import qualified Parser.JsImport
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.JsImport (JsImport)
|
||||
import qualified Wasp.Page as Page
|
||||
|
||||
data PageProperty
|
||||
= Title !String
|
||||
| Component !JsImport
|
||||
| AuthRequired !Bool
|
||||
deriving (Show, Eq)
|
||||
= Title !String
|
||||
| Component !JsImport
|
||||
| AuthRequired !Bool
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Parses Page properties, separated by a comma.
|
||||
pageProperties :: Parser [PageProperty]
|
||||
pageProperties = commaSep1 $
|
||||
pageProperties =
|
||||
commaSep1 $
|
||||
pagePropertyTitle
|
||||
<|> pagePropertyComponent
|
||||
<|> pagePropertyAuthRequired
|
||||
<|> pagePropertyComponent
|
||||
<|> pagePropertyAuthRequired
|
||||
|
||||
-- NOTE(matija): this is currently unused?
|
||||
pagePropertyTitle :: Parser PageProperty
|
||||
@ -45,10 +45,11 @@ getPageComponent ps = listToMaybe [c | Component c <- ps]
|
||||
-- | Top level parser, parses Page.
|
||||
page :: Parser Page.Page
|
||||
page = do
|
||||
(pageName, pageProps) <- waspElementNameAndClosureContent reservedNamePage pageProperties
|
||||
(pageName, pageProps) <- waspElementNameAndClosureContent reservedNamePage pageProperties
|
||||
|
||||
return Page.Page
|
||||
{ Page._name = pageName
|
||||
, Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps)
|
||||
, Page._authRequired = getPageAuthRequired pageProps
|
||||
}
|
||||
return
|
||||
Page.Page
|
||||
{ Page._name = pageName,
|
||||
Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps),
|
||||
Page._authRequired = getPageAuthRequired pageProps
|
||||
}
|
||||
|
@ -1,23 +1,23 @@
|
||||
module Parser.Query
|
||||
( query
|
||||
) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Wasp.Query (Query)
|
||||
import qualified Wasp.Query as Query
|
||||
( query,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.Query (Query)
|
||||
import qualified Wasp.Query as Query
|
||||
|
||||
query :: Parser Query
|
||||
query = do
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameQuery Operation.properties
|
||||
return Query.Query
|
||||
{ Query._name = name
|
||||
, Query._jsFunction =
|
||||
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props)
|
||||
, Query._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameQuery Operation.properties
|
||||
return
|
||||
Query.Query
|
||||
{ Query._name = name,
|
||||
Query._jsFunction =
|
||||
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||
Query._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
|
@ -1,26 +1,26 @@
|
||||
module Parser.Route
|
||||
( route
|
||||
) where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
( route,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Lexer as L
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Route as Route
|
||||
|
||||
-- | Top level parser, parses route Wasp element.
|
||||
route :: Parser Route.Route
|
||||
route = do
|
||||
-- route "some/url/path"
|
||||
L.reserved L.reservedNameRoute
|
||||
urlPath <- L.stringLiteral
|
||||
-- route "some/url/path"
|
||||
L.reserved L.reservedNameRoute
|
||||
urlPath <- L.stringLiteral
|
||||
|
||||
-- -> page somePage
|
||||
L.reserved "->"
|
||||
L.reserved L.reservedNamePage
|
||||
targetPage <- L.identifier
|
||||
|
||||
return Route.Route
|
||||
{ Route._urlPath = urlPath
|
||||
, Route._targetPage = targetPage
|
||||
}
|
||||
-- -> page somePage
|
||||
L.reserved "->"
|
||||
L.reserved L.reservedNamePage
|
||||
targetPage <- L.identifier
|
||||
|
||||
return
|
||||
Route.Route
|
||||
{ Route._urlPath = urlPath,
|
||||
Route._targetPage = targetPage
|
||||
}
|
||||
|
@ -1,16 +1,15 @@
|
||||
module Parser.Style
|
||||
( style
|
||||
) where
|
||||
( style,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Parser.Common
|
||||
import qualified Parser.ExternalCode
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Style
|
||||
|
||||
|
||||
style :: Parser Wasp.Style.Style
|
||||
style = cssFile <|> cssCode
|
||||
|
||||
|
@ -1,11 +1,12 @@
|
||||
module Path.Extra
|
||||
( reversePosixPath
|
||||
, toPosixFilePath
|
||||
) where
|
||||
( reversePosixPath,
|
||||
toPosixFilePath,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (assert)
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import Path
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
|
||||
-- | For given posix path P, returns posix path P', such that (terminal pseudocode incoming)
|
||||
-- `pwd == (cd P && cd P' && pwd)`, or to put it differently, such that
|
||||
@ -14,9 +15,10 @@ import Path
|
||||
-- (e.g. reversePath "foo/bar" == "../..").
|
||||
reversePosixPath :: FilePath -> FilePath
|
||||
reversePosixPath path
|
||||
| null parts = "."
|
||||
| otherwise = assert (".." `notElem` parts) $
|
||||
FPP.joinPath $ map (const "..") parts
|
||||
| null parts = "."
|
||||
| otherwise =
|
||||
assert (".." `notElem` parts) $
|
||||
FPP.joinPath $ map (const "..") parts
|
||||
where
|
||||
parts :: [String]
|
||||
parts = filter (/= ".") $ FPP.splitDirectories path
|
||||
|
@ -1,42 +1,45 @@
|
||||
module Psl.Ast.Model where
|
||||
|
||||
data Model = Model
|
||||
String -- ^ Name of the model
|
||||
Body
|
||||
deriving (Show, Eq)
|
||||
data Model
|
||||
= Model
|
||||
String
|
||||
-- ^ Name of the model
|
||||
Body
|
||||
deriving (Show, Eq)
|
||||
|
||||
newtype Body = Body [Element]
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Element = ElementField Field | ElementBlockAttribute Attribute
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- TODO: To support attributes before the field,
|
||||
-- we could just have `attrsBefore :: [[Attr]]`,
|
||||
-- which represents lines, each one with list of attributes.
|
||||
data Field = Field
|
||||
{ _name :: String
|
||||
, _type :: FieldType
|
||||
, _typeModifiers :: [FieldTypeModifier]
|
||||
, _attrs :: [Attribute]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ _name :: String,
|
||||
_type :: FieldType,
|
||||
_typeModifiers :: [FieldTypeModifier],
|
||||
_attrs :: [Attribute]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data FieldType = String
|
||||
| Boolean
|
||||
| Int
|
||||
| BigInt
|
||||
| Float
|
||||
| Decimal
|
||||
| DateTime
|
||||
| Json
|
||||
| Bytes
|
||||
| Unsupported String
|
||||
| UserType String
|
||||
deriving (Show, Eq)
|
||||
data FieldType
|
||||
= String
|
||||
| Boolean
|
||||
| Int
|
||||
| BigInt
|
||||
| Float
|
||||
| Decimal
|
||||
| DateTime
|
||||
| Json
|
||||
| Bytes
|
||||
| Unsupported String
|
||||
| UserType String
|
||||
deriving (Show, Eq)
|
||||
|
||||
data FieldTypeModifier = List | Optional
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- NOTE: We don't differentiate "native database type" attributes from normal attributes right now,
|
||||
-- they are all represented with `data Attribute`.
|
||||
@ -44,19 +47,19 @@ data FieldTypeModifier = List | Optional
|
||||
-- TODO: In the future, we might want to be "smarter" about this and actually have a special representation
|
||||
-- for them -> but let's see if that will be needed.
|
||||
data Attribute = Attribute
|
||||
{ _attrName :: String
|
||||
, _attrArgs :: [AttributeArg]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ _attrName :: String,
|
||||
_attrArgs :: [AttributeArg]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AttributeArg = AttrArgNamed String AttrArgValue | AttrArgUnnamed AttrArgValue
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AttrArgValue
|
||||
= AttrArgString String
|
||||
| AttrArgIdentifier String
|
||||
| AttrArgFunc String
|
||||
| AttrArgFieldRefList [String]
|
||||
| AttrArgNumber String
|
||||
| AttrArgUnknown String
|
||||
deriving (Show, Eq)
|
||||
= AttrArgString String
|
||||
| AttrArgIdentifier String
|
||||
| AttrArgFunc String
|
||||
| AttrArgFieldRefList [String]
|
||||
| AttrArgNumber String
|
||||
| AttrArgUnknown String
|
||||
deriving (Show, Eq)
|
||||
|
@ -1,12 +1,11 @@
|
||||
module Psl.Generator.Model
|
||||
( generateModel
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
( generateModel,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import qualified Psl.Ast.Model as Ast
|
||||
|
||||
|
||||
generateModel :: Ast.Model -> String
|
||||
generateModel (Ast.Model name body) = "model " ++ name ++ " {\n" ++ generateBody body ++ "\n}"
|
||||
|
||||
@ -15,37 +14,38 @@ generateBody (Ast.Body elements) = unlines $ map ((" " ++) . generateElement) e
|
||||
|
||||
generateElement :: Ast.Element -> String
|
||||
generateElement (Ast.ElementField field) =
|
||||
Ast._name field ++ " "
|
||||
++ generateFieldType (Ast._type field) ++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
||||
Ast._name field ++ " "
|
||||
++ generateFieldType (Ast._type field)
|
||||
++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
||||
++ concatMap ((" " ++) . generateAttribute) (Ast._attrs field)
|
||||
generateElement (Ast.ElementBlockAttribute attribute) =
|
||||
"@" ++ generateAttribute attribute
|
||||
"@" ++ generateAttribute attribute
|
||||
|
||||
generateFieldType :: Ast.FieldType -> String
|
||||
generateFieldType fieldType = case fieldType of
|
||||
Ast.String -> "String"
|
||||
Ast.Boolean -> "Boolean"
|
||||
Ast.Int -> "Int"
|
||||
Ast.BigInt -> "BigInt"
|
||||
Ast.Float -> "Float"
|
||||
Ast.Decimal -> "Decimal"
|
||||
Ast.DateTime -> "DateTime"
|
||||
Ast.Json -> "Json"
|
||||
Ast.Bytes -> "Bytes"
|
||||
Ast.UserType label -> label
|
||||
Ast.Unsupported typeName -> "Unsupported(" ++ show typeName ++ ")"
|
||||
Ast.String -> "String"
|
||||
Ast.Boolean -> "Boolean"
|
||||
Ast.Int -> "Int"
|
||||
Ast.BigInt -> "BigInt"
|
||||
Ast.Float -> "Float"
|
||||
Ast.Decimal -> "Decimal"
|
||||
Ast.DateTime -> "DateTime"
|
||||
Ast.Json -> "Json"
|
||||
Ast.Bytes -> "Bytes"
|
||||
Ast.UserType label -> label
|
||||
Ast.Unsupported typeName -> "Unsupported(" ++ show typeName ++ ")"
|
||||
|
||||
generateFieldTypeModifier :: Ast.FieldTypeModifier -> String
|
||||
generateFieldTypeModifier typeModifier = case typeModifier of
|
||||
Ast.List -> "[]"
|
||||
Ast.Optional -> "?"
|
||||
Ast.List -> "[]"
|
||||
Ast.Optional -> "?"
|
||||
|
||||
generateAttribute :: Ast.Attribute -> String
|
||||
generateAttribute attribute =
|
||||
"@" ++ Ast._attrName attribute
|
||||
"@" ++ Ast._attrName attribute
|
||||
++ if null (Ast._attrArgs attribute)
|
||||
then ""
|
||||
else "(" ++ intercalate ", " (map generateAttributeArg (Ast._attrArgs attribute)) ++ ")"
|
||||
then ""
|
||||
else "(" ++ intercalate ", " (map generateAttributeArg (Ast._attrArgs attribute)) ++ ")"
|
||||
|
||||
generateAttributeArg :: Ast.AttributeArg -> String
|
||||
generateAttributeArg (Ast.AttrArgNamed name value) = name ++ ": " ++ generateAttrArgValue value
|
||||
@ -53,12 +53,12 @@ generateAttributeArg (Ast.AttrArgUnnamed value) = generateAttrArgValue value
|
||||
|
||||
generateAttrArgValue :: Ast.AttrArgValue -> String
|
||||
generateAttrArgValue value = case value of
|
||||
Ast.AttrArgString strValue -> show strValue
|
||||
Ast.AttrArgIdentifier identifier -> identifier
|
||||
Ast.AttrArgFunc funcName -> funcName ++ "()"
|
||||
Ast.AttrArgFieldRefList refs -> "[" ++ intercalate ", " refs ++ "]"
|
||||
Ast.AttrArgNumber numberStr -> numberStr
|
||||
Ast.AttrArgUnknown unknownStr -> unknownStr
|
||||
Ast.AttrArgString strValue -> show strValue
|
||||
Ast.AttrArgIdentifier identifier -> identifier
|
||||
Ast.AttrArgFunc funcName -> funcName ++ "()"
|
||||
Ast.AttrArgFieldRefList refs -> "[" ++ intercalate ", " refs ++ "]"
|
||||
Ast.AttrArgNumber numberStr -> numberStr
|
||||
Ast.AttrArgUnknown unknownStr -> unknownStr
|
||||
|
||||
-- TODO: I should make sure to skip attributes that are not known in prisma.
|
||||
-- Or maybe it would be better if that was done in previous step, where
|
||||
|
@ -1,19 +1,30 @@
|
||||
module Psl.Parser.Model
|
||||
( model
|
||||
, body
|
||||
( model,
|
||||
body,
|
||||
-- NOTE: Only for testing:
|
||||
, attrArgument
|
||||
) where
|
||||
attrArgument,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import Text.Parsec (alphaNum, char, choice, letter,
|
||||
lookAhead, many, many1, noneOf, oneOf,
|
||||
optionMaybe, try, (<|>))
|
||||
import Text.Parsec.Language (emptyDef)
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Text.Parsec.Token as T
|
||||
|
||||
import qualified Psl.Ast.Model as Model
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import qualified Psl.Ast.Model as Model
|
||||
import Text.Parsec
|
||||
( alphaNum,
|
||||
char,
|
||||
choice,
|
||||
letter,
|
||||
lookAhead,
|
||||
many,
|
||||
many1,
|
||||
noneOf,
|
||||
oneOf,
|
||||
optionMaybe,
|
||||
try,
|
||||
(<|>),
|
||||
)
|
||||
import Text.Parsec.Language (emptyDef)
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Text.Parsec.Token as T
|
||||
|
||||
-- | Parses PSL (Prisma Schema Language model).
|
||||
-- Example of PSL model:
|
||||
@ -24,123 +35,133 @@ import qualified Psl.Ast.Model as Model
|
||||
-- }
|
||||
model :: Parser Model.Model
|
||||
model = do
|
||||
T.whiteSpace lexer
|
||||
_ <- T.symbol lexer "model"
|
||||
modelName <- T.identifier lexer
|
||||
Model.Model modelName <$> T.braces lexer body
|
||||
T.whiteSpace lexer
|
||||
_ <- T.symbol lexer "model"
|
||||
modelName <- T.identifier lexer
|
||||
Model.Model modelName <$> T.braces lexer body
|
||||
|
||||
-- | Parses body of the PSL (Prisma Schema Language) model,
|
||||
-- which is everything besides model keyword, name and braces:
|
||||
-- `model User { <body> }`.
|
||||
body :: Parser Model.Body
|
||||
body = do
|
||||
T.whiteSpace lexer
|
||||
Model.Body <$> many1 element
|
||||
T.whiteSpace lexer
|
||||
Model.Body <$> many1 element
|
||||
|
||||
element :: Parser Model.Element
|
||||
element = try (Model.ElementField <$> field) <|>
|
||||
try (Model.ElementBlockAttribute <$> blockAttribute)
|
||||
element =
|
||||
try (Model.ElementField <$> field)
|
||||
<|> try (Model.ElementBlockAttribute <$> blockAttribute)
|
||||
|
||||
field :: Parser Model.Field
|
||||
field = do
|
||||
name <- T.identifier lexer
|
||||
type' <- fieldType
|
||||
maybeTypeModifier <- fieldTypeModifier
|
||||
attrs <- many (try attribute)
|
||||
return $ Model.Field
|
||||
{ Model._name = name
|
||||
, Model._type = type'
|
||||
, Model._typeModifiers = maybeToList maybeTypeModifier
|
||||
, Model._attrs = attrs
|
||||
}
|
||||
name <- T.identifier lexer
|
||||
type' <- fieldType
|
||||
maybeTypeModifier <- fieldTypeModifier
|
||||
attrs <- many (try attribute)
|
||||
return $
|
||||
Model.Field
|
||||
{ Model._name = name,
|
||||
Model._type = type',
|
||||
Model._typeModifiers = maybeToList maybeTypeModifier,
|
||||
Model._attrs = attrs
|
||||
}
|
||||
where
|
||||
fieldType :: Parser Model.FieldType
|
||||
fieldType =
|
||||
(foldl1 (<|>) $
|
||||
map (\(s, t) -> try (T.symbol lexer s) >> return t)
|
||||
[ ("String", Model.String)
|
||||
, ("Boolean", Model.Boolean)
|
||||
, ("Int", Model.Int)
|
||||
, ("BigInt", Model.BigInt)
|
||||
, ("Float", Model.Float)
|
||||
, ("Decimal", Model.Decimal)
|
||||
, ("DateTime", Model.DateTime)
|
||||
, ("Json", Model.Json)
|
||||
, ("Bytes", Model.Bytes)
|
||||
]
|
||||
)
|
||||
( foldl1 (<|>) $
|
||||
map
|
||||
(\(s, t) -> try (T.symbol lexer s) >> return t)
|
||||
[ ("String", Model.String),
|
||||
("Boolean", Model.Boolean),
|
||||
("Int", Model.Int),
|
||||
("BigInt", Model.BigInt),
|
||||
("Float", Model.Float),
|
||||
("Decimal", Model.Decimal),
|
||||
("DateTime", Model.DateTime),
|
||||
("Json", Model.Json),
|
||||
("Bytes", Model.Bytes)
|
||||
]
|
||||
)
|
||||
<|> (try $ Model.Unsupported <$> (T.symbol lexer "Unsupported" >> T.parens lexer (T.stringLiteral lexer)))
|
||||
<|> Model.UserType <$> T.identifier lexer
|
||||
|
||||
-- NOTE: As is Prisma currently implemented, there can be only one type modifier at one time: [] or ?.
|
||||
fieldTypeModifier :: Parser (Maybe Model.FieldTypeModifier)
|
||||
fieldTypeModifier = optionMaybe
|
||||
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List) <|>
|
||||
(try (T.symbol lexer "?") >> return Model.Optional)
|
||||
fieldTypeModifier =
|
||||
optionMaybe
|
||||
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List)
|
||||
<|> (try (T.symbol lexer "?") >> return Model.Optional)
|
||||
)
|
||||
|
||||
attribute :: Parser Model.Attribute
|
||||
attribute = do
|
||||
_ <- char '@'
|
||||
name <- T.identifier lexer
|
||||
-- NOTE: we support potential "selector" in order to support native database type attributes.
|
||||
-- These have names with single . in them, like this: @db.VarChar(200), @db.TinyInt(1), ... .
|
||||
-- We are not trying to be very smart here though: we don't check that "db" part matches
|
||||
-- the name of the datasource block name (as it should), and we don't check that "VarChar" part is PascalCase
|
||||
-- (as it should be) or that it is one of the valid values.
|
||||
-- We just treat it as any other attribute, where "db.VarChar" becomes an attribute name.
|
||||
-- In case that we wanted to be smarter, we could expand the AST to have special representation for it.
|
||||
-- Also, we could do some additional checks here in parser (PascalCase), and some additional checks
|
||||
-- in th generator ("db" matching the datasource block name).
|
||||
maybeSelector <- optionMaybe $ try $ char '.' >> T.identifier lexer
|
||||
_ <- char '@'
|
||||
name <- T.identifier lexer
|
||||
-- NOTE: we support potential "selector" in order to support native database type attributes.
|
||||
-- These have names with single . in them, like this: @db.VarChar(200), @db.TinyInt(1), ... .
|
||||
-- We are not trying to be very smart here though: we don't check that "db" part matches
|
||||
-- the name of the datasource block name (as it should), and we don't check that "VarChar" part is PascalCase
|
||||
-- (as it should be) or that it is one of the valid values.
|
||||
-- We just treat it as any other attribute, where "db.VarChar" becomes an attribute name.
|
||||
-- In case that we wanted to be smarter, we could expand the AST to have special representation for it.
|
||||
-- Also, we could do some additional checks here in parser (PascalCase), and some additional checks
|
||||
-- in th generator ("db" matching the datasource block name).
|
||||
maybeSelector <- optionMaybe $ try $ char '.' >> T.identifier lexer
|
||||
|
||||
maybeArgs <- optionMaybe (T.parens lexer (T.commaSep1 lexer (try attrArgument)))
|
||||
return $ Model.Attribute
|
||||
{ Model._attrName = case maybeSelector of
|
||||
Just selector -> name ++ "." ++ selector
|
||||
Nothing -> name
|
||||
, Model._attrArgs = fromMaybe [] maybeArgs
|
||||
}
|
||||
maybeArgs <- optionMaybe (T.parens lexer (T.commaSep1 lexer (try attrArgument)))
|
||||
return $
|
||||
Model.Attribute
|
||||
{ Model._attrName = case maybeSelector of
|
||||
Just selector -> name ++ "." ++ selector
|
||||
Nothing -> name,
|
||||
Model._attrArgs = fromMaybe [] maybeArgs
|
||||
}
|
||||
|
||||
-- Parses attribute argument that ends with delimiter: , or ).
|
||||
-- Doesn't parse the delimiter.
|
||||
attrArgument :: Parser Model.AttributeArg
|
||||
attrArgument = do
|
||||
arg <- try namedArg <|> try unnamedArg
|
||||
return arg
|
||||
arg <- try namedArg <|> try unnamedArg
|
||||
return arg
|
||||
where
|
||||
namedArg :: Parser Model.AttributeArg
|
||||
namedArg = do
|
||||
name <- T.identifier lexer
|
||||
_ <- T.colon lexer
|
||||
Model.AttrArgNamed name <$> argValue
|
||||
name <- T.identifier lexer
|
||||
_ <- T.colon lexer
|
||||
Model.AttrArgNamed name <$> argValue
|
||||
|
||||
unnamedArg :: Parser Model.AttributeArg
|
||||
unnamedArg = Model.AttrArgUnnamed <$> argValue
|
||||
|
||||
argValue :: Parser Model.AttrArgValue
|
||||
argValue = choice $ map (try . delimitedArgValue)
|
||||
[ argValueString
|
||||
, argValueFunc
|
||||
, argValueFieldReferenceList
|
||||
, argValueNumberFloat
|
||||
, argValueNumberInt
|
||||
, argValueIdentifier
|
||||
, argValueUnknown
|
||||
]
|
||||
argValue =
|
||||
choice $
|
||||
map
|
||||
(try . delimitedArgValue)
|
||||
[ argValueString,
|
||||
argValueFunc,
|
||||
argValueFieldReferenceList,
|
||||
argValueNumberFloat,
|
||||
argValueNumberInt,
|
||||
argValueIdentifier,
|
||||
argValueUnknown
|
||||
]
|
||||
|
||||
argValueString :: Parser Model.AttrArgValue
|
||||
argValueString = Model.AttrArgString <$> T.stringLiteral lexer
|
||||
|
||||
argValueFunc :: Parser Model.AttrArgValue
|
||||
argValueFunc = do -- TODO: Could I implement this with applicative?
|
||||
name <- T.identifier lexer
|
||||
T.parens lexer $ T.whiteSpace lexer
|
||||
return $ Model.AttrArgFunc name
|
||||
argValueFunc = do
|
||||
-- TODO: Could I implement this with applicative?
|
||||
name <- T.identifier lexer
|
||||
T.parens lexer $ T.whiteSpace lexer
|
||||
return $ Model.AttrArgFunc name
|
||||
|
||||
argValueFieldReferenceList :: Parser Model.AttrArgValue
|
||||
argValueFieldReferenceList = Model.AttrArgFieldRefList <$>
|
||||
(T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
||||
argValueFieldReferenceList =
|
||||
Model.AttrArgFieldRefList
|
||||
<$> (T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
||||
|
||||
-- NOTE: For now we are not supporting negative numbers.
|
||||
-- I couldn't figure out from Prisma docs if there could be the case
|
||||
@ -157,16 +178,16 @@ attrArgument = do
|
||||
argValueIdentifier :: Parser Model.AttrArgValue
|
||||
argValueIdentifier = Model.AttrArgIdentifier <$> T.identifier lexer
|
||||
|
||||
-- | Our "wildcard" -> tries to capture anything.
|
||||
argValueUnknown :: Parser Model.AttrArgValue
|
||||
argValueUnknown = Model.AttrArgUnknown <$>
|
||||
(many1 $ try $ noneOf argDelimiters)
|
||||
argValueUnknown =
|
||||
Model.AttrArgUnknown
|
||||
<$> (many1 $ try $ noneOf argDelimiters)
|
||||
|
||||
delimitedArgValue :: Parser Model.AttrArgValue -> Parser Model.AttrArgValue
|
||||
delimitedArgValue argValueP = do
|
||||
value <- argValueP
|
||||
_ <- lookAhead $ oneOf argDelimiters
|
||||
return value
|
||||
value <- argValueP
|
||||
_ <- lookAhead $ oneOf argDelimiters
|
||||
return value
|
||||
|
||||
argDelimiters = [',', ')']
|
||||
|
||||
@ -174,9 +195,11 @@ blockAttribute :: Parser Model.Attribute
|
||||
blockAttribute = char '@' >> attribute
|
||||
|
||||
lexer :: T.TokenParser ()
|
||||
lexer = T.makeTokenParser emptyDef
|
||||
{ T.commentLine = "//"
|
||||
, T.caseSensitive = True
|
||||
, T.identStart = letter
|
||||
, T.identLetter = alphaNum <|> char '_'
|
||||
}
|
||||
lexer =
|
||||
T.makeTokenParser
|
||||
emptyDef
|
||||
{ T.commentLine = "//",
|
||||
T.caseSensitive = True,
|
||||
T.identStart = letter,
|
||||
T.identLetter = alphaNum <|> char '_'
|
||||
}
|
||||
|
@ -1,49 +1,87 @@
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
|
||||
module StrongPath
|
||||
( Path, Path'
|
||||
, Abs, Rel, Dir, File, File'
|
||||
, System, Windows, Posix
|
||||
( Path,
|
||||
Path',
|
||||
Abs,
|
||||
Rel,
|
||||
Dir,
|
||||
File,
|
||||
File',
|
||||
System,
|
||||
Windows,
|
||||
Posix,
|
||||
parseRelDir,
|
||||
parseRelFile,
|
||||
parseAbsDir,
|
||||
parseAbsFile,
|
||||
parseRelDirW,
|
||||
parseRelFileW,
|
||||
parseAbsDirW,
|
||||
parseAbsFileW,
|
||||
parseRelDirP,
|
||||
parseRelFileP,
|
||||
parseAbsDirP,
|
||||
parseAbsFileP,
|
||||
fromPathRelDir,
|
||||
fromPathRelFile,
|
||||
fromPathAbsDir,
|
||||
fromPathAbsFile,
|
||||
fromPathRelDirW,
|
||||
fromPathRelFileW,
|
||||
fromPathAbsDirW,
|
||||
fromPathAbsFileW,
|
||||
fromPathRelDirP,
|
||||
fromPathRelFileP,
|
||||
fromPathAbsDirP,
|
||||
fromPathAbsFileP,
|
||||
toPathRelDir,
|
||||
toPathRelFile,
|
||||
toPathAbsDir,
|
||||
toPathAbsFile,
|
||||
toPathRelDirW,
|
||||
toPathRelFileW,
|
||||
toPathAbsDirW,
|
||||
toPathAbsFileW,
|
||||
toPathRelDirP,
|
||||
toPathRelFileP,
|
||||
toPathAbsDirP,
|
||||
toPathAbsFileP,
|
||||
fromRelDir,
|
||||
fromRelFile,
|
||||
fromAbsDir,
|
||||
fromAbsFile,
|
||||
fromRelDirP,
|
||||
fromRelFileP,
|
||||
fromAbsDirP,
|
||||
fromAbsFileP,
|
||||
fromRelDirW,
|
||||
fromRelFileW,
|
||||
fromAbsDirW,
|
||||
fromAbsFileW,
|
||||
toFilePath,
|
||||
(</>),
|
||||
castRel,
|
||||
castDir,
|
||||
parent,
|
||||
relDirToPosix,
|
||||
relFileToPosix,
|
||||
relDirToPosix',
|
||||
relFileToPosix',
|
||||
)
|
||||
where
|
||||
|
||||
, parseRelDir, parseRelFile, parseAbsDir, parseAbsFile
|
||||
, parseRelDirW, parseRelFileW, parseAbsDirW, parseAbsFileW
|
||||
, parseRelDirP, parseRelFileP, parseAbsDirP, parseAbsFileP
|
||||
|
||||
, fromPathRelDir, fromPathRelFile, fromPathAbsDir, fromPathAbsFile
|
||||
, fromPathRelDirW, fromPathRelFileW, fromPathAbsDirW, fromPathAbsFileW
|
||||
, fromPathRelDirP, fromPathRelFileP, fromPathAbsDirP, fromPathAbsFileP
|
||||
|
||||
, toPathRelDir, toPathRelFile, toPathAbsDir, toPathAbsFile
|
||||
, toPathRelDirW, toPathRelFileW, toPathAbsDirW, toPathAbsFileW
|
||||
, toPathRelDirP, toPathRelFileP, toPathAbsDirP, toPathAbsFileP
|
||||
|
||||
, fromRelDir, fromRelFile, fromAbsDir, fromAbsFile
|
||||
, fromRelDirP, fromRelFileP, fromAbsDirP, fromAbsFileP
|
||||
, fromRelDirW, fromRelFileW, fromAbsDirW, fromAbsFileW
|
||||
|
||||
, toFilePath
|
||||
|
||||
, (</>)
|
||||
|
||||
, castRel, castDir
|
||||
|
||||
, parent
|
||||
|
||||
, relDirToPosix, relFileToPosix, relDirToPosix', relFileToPosix'
|
||||
) where
|
||||
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PP
|
||||
import qualified Path.Windows as PW
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PP
|
||||
import qualified Path.Windows as PW
|
||||
import StrongPath.Internal
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import qualified System.FilePath.Windows as FPW
|
||||
|
||||
import StrongPath.Internal
|
||||
|
||||
|
||||
-- TODO: We still depend on Path for creating hardcoded paths via generics. Any way to go around that?
|
||||
-- Maybe implement our own mechanism for that, so that people don't have to know about / use Path?
|
||||
-- This means we would implement our own [reldir|foobar|] stuff.
|
||||
@ -78,87 +116,109 @@ import StrongPath.Internal
|
||||
-- so compiler does not differentiate them (because they are all exporting the same module containing Path),
|
||||
-- but Path.Windows.Rel and Path.Posix.Rel (and same for Abs/Dir/File) are not the same,
|
||||
-- because they are done via Include mechanism.
|
||||
fromPathRelDir :: P.Path P.Rel P.Dir -> Path' System (Rel a) (Dir b)
|
||||
fromPathRelFile :: P.Path P.Rel P.File -> Path' System (Rel a) (File' f)
|
||||
fromPathAbsDir :: P.Path P.Abs P.Dir -> Path' System Abs (Dir a)
|
||||
fromPathAbsFile :: P.Path P.Abs P.File -> Path' System Abs (File' f)
|
||||
fromPathRelDirW :: PW.Path PW.Rel PW.Dir -> Path' Windows (Rel a) (Dir b)
|
||||
fromPathRelDir :: P.Path P.Rel P.Dir -> Path' System (Rel a) (Dir b)
|
||||
fromPathRelFile :: P.Path P.Rel P.File -> Path' System (Rel a) (File' f)
|
||||
fromPathAbsDir :: P.Path P.Abs P.Dir -> Path' System Abs (Dir a)
|
||||
fromPathAbsFile :: P.Path P.Abs P.File -> Path' System Abs (File' f)
|
||||
fromPathRelDirW :: PW.Path PW.Rel PW.Dir -> Path' Windows (Rel a) (Dir b)
|
||||
fromPathRelFileW :: PW.Path PW.Rel PW.File -> Path' Windows (Rel a) (File' f)
|
||||
fromPathAbsDirW :: PW.Path PW.Abs PW.Dir -> Path' Windows Abs (Dir a)
|
||||
fromPathAbsFileW :: PW.Path PW.Abs PW.File -> Path' Windows Abs (File' f)
|
||||
fromPathRelDirP :: PP.Path PP.Rel PP.Dir -> Path' Posix (Rel a) (Dir b)
|
||||
fromPathRelFileP :: PP.Path PP.Rel PP.File -> Path' Posix (Rel a) (File' f)
|
||||
fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path' Posix Abs (Dir a)
|
||||
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path' Posix Abs (File' f)
|
||||
fromPathAbsDirW :: PW.Path PW.Abs PW.Dir -> Path' Windows Abs (Dir a)
|
||||
fromPathAbsFileW :: PW.Path PW.Abs PW.File -> Path' Windows Abs (File' f)
|
||||
fromPathRelDirP :: PP.Path PP.Rel PP.Dir -> Path' Posix (Rel a) (Dir b)
|
||||
fromPathRelFileP :: PP.Path PP.Rel PP.File -> Path' Posix (Rel a) (File' f)
|
||||
fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path' Posix Abs (Dir a)
|
||||
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path' Posix Abs (File' f)
|
||||
---- System
|
||||
fromPathRelDir p = RelDir p NoPrefix
|
||||
fromPathRelFile p = RelFile p NoPrefix
|
||||
fromPathAbsDir = AbsDir
|
||||
fromPathAbsFile = AbsFile
|
||||
fromPathRelDir p = RelDir p NoPrefix
|
||||
|
||||
fromPathRelFile p = RelFile p NoPrefix
|
||||
|
||||
fromPathAbsDir = AbsDir
|
||||
|
||||
fromPathAbsFile = AbsFile
|
||||
|
||||
---- Windows
|
||||
fromPathRelDirW p = RelDirW p NoPrefix
|
||||
|
||||
fromPathRelFileW p = RelFileW p NoPrefix
|
||||
fromPathAbsDirW = AbsDirW
|
||||
|
||||
fromPathAbsDirW = AbsDirW
|
||||
|
||||
fromPathAbsFileW = AbsFileW
|
||||
|
||||
---- Posix
|
||||
fromPathRelDirP p = RelDirP p NoPrefix
|
||||
|
||||
fromPathRelFileP p = RelFileP p NoPrefix
|
||||
fromPathAbsDirP = AbsDirP
|
||||
|
||||
fromPathAbsDirP = AbsDirP
|
||||
|
||||
fromPathAbsFileP = AbsFileP
|
||||
|
||||
-- TODO: Should I go with MonadThrow here instead of just throwing error? Probably!
|
||||
-- I could, as error, return actual Path + info on how many ../ were there in StrongPath,
|
||||
-- so user can recover from error and continue, if they wish.
|
||||
-- Deconstructors
|
||||
toPathRelDir :: Path' System (Rel a) (Dir b) -> P.Path P.Rel P.Dir
|
||||
toPathRelFile :: Path' System (Rel a) (File' f) -> P.Path P.Rel P.File
|
||||
toPathAbsDir :: Path' System Abs (Dir a) -> P.Path P.Abs P.Dir
|
||||
toPathAbsFile :: Path' System Abs (File' f) -> P.Path P.Abs P.File
|
||||
toPathRelDirW :: Path' Windows (Rel a) (Dir b) -> PW.Path PW.Rel PW.Dir
|
||||
toPathRelDir :: Path' System (Rel a) (Dir b) -> P.Path P.Rel P.Dir
|
||||
toPathRelFile :: Path' System (Rel a) (File' f) -> P.Path P.Rel P.File
|
||||
toPathAbsDir :: Path' System Abs (Dir a) -> P.Path P.Abs P.Dir
|
||||
toPathAbsFile :: Path' System Abs (File' f) -> P.Path P.Abs P.File
|
||||
toPathRelDirW :: Path' Windows (Rel a) (Dir b) -> PW.Path PW.Rel PW.Dir
|
||||
toPathRelFileW :: Path' Windows (Rel a) (File' f) -> PW.Path PW.Rel PW.File
|
||||
toPathAbsDirW :: Path' Windows Abs (Dir a) -> PW.Path PW.Abs PW.Dir
|
||||
toPathAbsFileW :: Path' Windows Abs (File' f) -> PW.Path PW.Abs PW.File
|
||||
toPathRelDirP :: Path' Posix (Rel a) (Dir b) -> PP.Path PP.Rel PP.Dir
|
||||
toPathRelFileP :: Path' Posix (Rel a) (File' f) -> PP.Path PP.Rel PP.File
|
||||
toPathAbsDirP :: Path' Posix Abs (Dir a) -> PP.Path PP.Abs PP.Dir
|
||||
toPathAbsFileP :: Path' Posix Abs (File' f) -> PP.Path PP.Abs PP.File
|
||||
toPathAbsDirW :: Path' Windows Abs (Dir a) -> PW.Path PW.Abs PW.Dir
|
||||
toPathAbsFileW :: Path' Windows Abs (File' f) -> PW.Path PW.Abs PW.File
|
||||
toPathRelDirP :: Path' Posix (Rel a) (Dir b) -> PP.Path PP.Rel PP.Dir
|
||||
toPathRelFileP :: Path' Posix (Rel a) (File' f) -> PP.Path PP.Rel PP.File
|
||||
toPathAbsDirP :: Path' Posix Abs (Dir a) -> PP.Path PP.Abs PP.Dir
|
||||
toPathAbsFileP :: Path' Posix Abs (File' f) -> PP.Path PP.Abs PP.File
|
||||
---- System
|
||||
toPathRelDir (RelDir p NoPrefix) = p
|
||||
toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDir _ = impossible
|
||||
toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDir _ = impossible
|
||||
|
||||
toPathRelFile (RelFile p NoPrefix) = p
|
||||
toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFile _ = impossible
|
||||
toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFile _ = impossible
|
||||
|
||||
toPathAbsDir (AbsDir p) = p
|
||||
toPathAbsDir _ = impossible
|
||||
toPathAbsDir _ = impossible
|
||||
|
||||
toPathAbsFile (AbsFile p) = p
|
||||
toPathAbsFile _ = impossible
|
||||
toPathAbsFile _ = impossible
|
||||
|
||||
---- Windows
|
||||
toPathRelDirW (RelDirW p NoPrefix) = p
|
||||
toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirW _ = impossible
|
||||
toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirW _ = impossible
|
||||
|
||||
toPathRelFileW (RelFileW p NoPrefix) = p
|
||||
toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileW _ = impossible
|
||||
toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileW _ = impossible
|
||||
|
||||
toPathAbsDirW (AbsDirW p) = p
|
||||
toPathAbsDirW _ = impossible
|
||||
toPathAbsDirW _ = impossible
|
||||
|
||||
toPathAbsFileW (AbsFileW p) = p
|
||||
toPathAbsFileW _ = impossible
|
||||
toPathAbsFileW _ = impossible
|
||||
|
||||
---- Posix
|
||||
toPathRelDirP (RelDirP p NoPrefix) = p
|
||||
toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirP _ = impossible
|
||||
toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirP _ = impossible
|
||||
|
||||
toPathRelFileP (RelFileP p NoPrefix) = p
|
||||
toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileP _ = impossible
|
||||
toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileP _ = impossible
|
||||
|
||||
toPathAbsDirP (AbsDirP p) = p
|
||||
toPathAbsDirP _ = impossible
|
||||
toPathAbsDirP _ = impossible
|
||||
|
||||
toPathAbsFileP (AbsFileP p) = p
|
||||
toPathAbsFileP _ = impossible
|
||||
toPathAbsFileP _ = impossible
|
||||
|
||||
relativeStrongPathWithPrefixToPathError :: a
|
||||
relativeStrongPathWithPrefixToPathError =
|
||||
error "Relative StrongPath.Path with prefix can't be converted into Path.Path."
|
||||
error "Relative StrongPath.Path with prefix can't be converted into Path.Path."
|
||||
|
||||
-- | Parsers.
|
||||
-- How parsers work:
|
||||
@ -173,60 +233,70 @@ relativeStrongPathWithPrefixToPathError =
|
||||
-- NOTE: System/Posix* means that path has to be System with exception of separators
|
||||
-- that can be Posix besides being System (but e.g. root can't be Posix).
|
||||
-- Win/Posix* is analogous to System/Posix*.
|
||||
parseRelDir :: MonadThrow m => FilePath -> m (Path' System (Rel d1) (Dir d2))
|
||||
parseRelFile :: MonadThrow m => FilePath -> m (Path' System (Rel d) (File' f))
|
||||
parseAbsDir :: MonadThrow m => FilePath -> m (Path' System Abs (Dir d))
|
||||
parseAbsFile :: MonadThrow m => FilePath -> m (Path' System Abs (File' f))
|
||||
parseRelDirW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d1) (Dir d2))
|
||||
parseRelFileW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d) (File' f))
|
||||
parseAbsDirW :: MonadThrow m => FilePath -> m (Path' Windows Abs (Dir d))
|
||||
parseAbsFileW :: MonadThrow m => FilePath -> m (Path' Windows Abs (File' f))
|
||||
parseRelDirP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d1) (Dir d2))
|
||||
parseRelFileP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d) (File' f))
|
||||
parseAbsDirP :: MonadThrow m => FilePath -> m (Path' Posix Abs (Dir d))
|
||||
parseAbsFileP :: MonadThrow m => FilePath -> m (Path' Posix Abs (File' f))
|
||||
parseRelDir :: MonadThrow m => FilePath -> m (Path' System (Rel d1) (Dir d2))
|
||||
parseRelFile :: MonadThrow m => FilePath -> m (Path' System (Rel d) (File' f))
|
||||
parseAbsDir :: MonadThrow m => FilePath -> m (Path' System Abs (Dir d))
|
||||
parseAbsFile :: MonadThrow m => FilePath -> m (Path' System Abs (File' f))
|
||||
parseRelDirW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d1) (Dir d2))
|
||||
parseRelFileW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d) (File' f))
|
||||
parseAbsDirW :: MonadThrow m => FilePath -> m (Path' Windows Abs (Dir d))
|
||||
parseAbsFileW :: MonadThrow m => FilePath -> m (Path' Windows Abs (File' f))
|
||||
parseRelDirP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d1) (Dir d2))
|
||||
parseRelFileP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d) (File' f))
|
||||
parseAbsDirP :: MonadThrow m => FilePath -> m (Path' Posix Abs (Dir d))
|
||||
parseAbsFileP :: MonadThrow m => FilePath -> m (Path' Posix Abs (File' f))
|
||||
---- System
|
||||
parseRelDir = parseRelFP RelDir [FP.pathSeparator, FPP.pathSeparator] P.parseRelDir
|
||||
parseRelDir = parseRelFP RelDir [FP.pathSeparator, FPP.pathSeparator] P.parseRelDir
|
||||
|
||||
parseRelFile = parseRelFP RelFile [FP.pathSeparator, FPP.pathSeparator] P.parseRelFile
|
||||
|
||||
parseAbsDir fp = fromPathAbsDir <$> P.parseAbsDir fp
|
||||
|
||||
parseAbsFile fp = fromPathAbsFile <$> P.parseAbsFile fp
|
||||
|
||||
---- Windows
|
||||
parseRelDirW = parseRelFP RelDirW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelDir
|
||||
|
||||
parseRelFileW = parseRelFP RelFileW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelFile
|
||||
|
||||
parseAbsDirW fp = fromPathAbsDirW <$> PW.parseAbsDir fp
|
||||
|
||||
parseAbsFileW fp = fromPathAbsFileW <$> PW.parseAbsFile fp
|
||||
|
||||
---- Posix
|
||||
parseRelDirP = parseRelFP RelDirP [FPP.pathSeparator] PP.parseRelDir
|
||||
parseRelFileP = parseRelFP RelFileP [FPP.pathSeparator] PP.parseRelFile
|
||||
parseAbsDirP fp = fromPathAbsDirP <$> PP.parseAbsDir fp
|
||||
parseAbsFileP fp = fromPathAbsFileP <$> PP.parseAbsFile fp
|
||||
|
||||
parseRelFileP = parseRelFP RelFileP [FPP.pathSeparator] PP.parseRelFile
|
||||
|
||||
parseAbsDirP fp = fromPathAbsDirP <$> PP.parseAbsDir fp
|
||||
|
||||
parseAbsFileP fp = fromPathAbsFileP <$> PP.parseAbsFile fp
|
||||
|
||||
toFilePath :: Path' s b t -> FilePath
|
||||
toFilePath sp = case sp of
|
||||
---- System
|
||||
RelDir p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||
RelFile p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||
AbsDir p -> P.toFilePath p
|
||||
AbsFile p -> P.toFilePath p
|
||||
---- Windows
|
||||
RelDirW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||
RelFileW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||
AbsDirW p -> PW.toFilePath p
|
||||
AbsFileW p -> PW.toFilePath p
|
||||
---- Posix
|
||||
RelDirP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||
RelFileP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||
AbsDirP p -> PP.toFilePath p
|
||||
AbsFileP p -> PP.toFilePath p
|
||||
---- System
|
||||
RelDir p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||
RelFile p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||
AbsDir p -> P.toFilePath p
|
||||
AbsFile p -> P.toFilePath p
|
||||
---- Windows
|
||||
RelDirW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||
RelFileW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||
AbsDirW p -> PW.toFilePath p
|
||||
AbsFileW p -> PW.toFilePath p
|
||||
---- Posix
|
||||
RelDirP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||
RelFileP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||
AbsDirP p -> PP.toFilePath p
|
||||
AbsFileP p -> PP.toFilePath p
|
||||
where
|
||||
relPathToFilePath pathToFilePath sep prefix path =
|
||||
combinePrefixWithPath sep (relPathPrefixToFilePath sep prefix) (pathToFilePath path)
|
||||
combinePrefixWithPath sep (relPathPrefixToFilePath sep prefix) (pathToFilePath path)
|
||||
|
||||
relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath
|
||||
relPathPrefixToFilePath _ NoPrefix = ""
|
||||
relPathPrefixToFilePath sep (ParentDir n) =
|
||||
intercalate [sep] (replicate n "..") ++ [sep]
|
||||
intercalate [sep] (replicate n "..") ++ [sep]
|
||||
|
||||
-- TODO: This function and helper functions above are somewhat too loose and hard to
|
||||
-- follow, implement them in better way.
|
||||
@ -234,56 +304,67 @@ toFilePath sp = case sp of
|
||||
-- and it could also be empty.
|
||||
combinePrefixWithPath :: Char -> String -> FilePath -> FilePath
|
||||
combinePrefixWithPath sep prefix path
|
||||
| path `elem` [".", ['.', sep], "./"] && not (null prefix) = prefix
|
||||
| path `elem` [".", ['.', sep], "./"] && not (null prefix) = prefix
|
||||
combinePrefixWithPath _ prefix path = prefix ++ path
|
||||
|
||||
-- These functions just call toFilePath, but their value is in
|
||||
-- their type: they allow you to capture expected type of the strong path
|
||||
-- that you want to convert into FilePath.
|
||||
fromRelDir :: Path' System (Rel r) (Dir d) -> FilePath
|
||||
fromRelDir = toFilePath
|
||||
fromRelFile :: Path' System (Rel r) (File' f) -> FilePath
|
||||
fromRelFile = toFilePath
|
||||
fromAbsDir :: Path' System Abs (Dir d) -> FilePath
|
||||
fromAbsDir = toFilePath
|
||||
fromAbsFile :: Path' System Abs (File' f) -> FilePath
|
||||
fromAbsFile = toFilePath
|
||||
fromRelDirP :: Path' Posix (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirP = toFilePath
|
||||
fromRelFileP :: Path' Posix (Rel r) (File' f) -> FilePath
|
||||
fromRelDir :: Path' System (Rel r) (Dir d) -> FilePath
|
||||
fromRelDir = toFilePath
|
||||
|
||||
fromRelFile :: Path' System (Rel r) (File' f) -> FilePath
|
||||
fromRelFile = toFilePath
|
||||
|
||||
fromAbsDir :: Path' System Abs (Dir d) -> FilePath
|
||||
fromAbsDir = toFilePath
|
||||
|
||||
fromAbsFile :: Path' System Abs (File' f) -> FilePath
|
||||
fromAbsFile = toFilePath
|
||||
|
||||
fromRelDirP :: Path' Posix (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirP = toFilePath
|
||||
|
||||
fromRelFileP :: Path' Posix (Rel r) (File' f) -> FilePath
|
||||
fromRelFileP = toFilePath
|
||||
fromAbsDirP :: Path' Posix Abs (Dir d) -> FilePath
|
||||
fromAbsDirP = toFilePath
|
||||
fromAbsFileP :: Path' Posix Abs (File' f) -> FilePath
|
||||
|
||||
fromAbsDirP :: Path' Posix Abs (Dir d) -> FilePath
|
||||
fromAbsDirP = toFilePath
|
||||
|
||||
fromAbsFileP :: Path' Posix Abs (File' f) -> FilePath
|
||||
fromAbsFileP = toFilePath
|
||||
fromRelDirW :: Path' Windows (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirW = toFilePath
|
||||
|
||||
fromRelDirW :: Path' Windows (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirW = toFilePath
|
||||
|
||||
fromRelFileW :: Path' Windows (Rel r) (File' f) -> FilePath
|
||||
fromRelFileW = toFilePath
|
||||
fromAbsDirW :: Path' Windows Abs (Dir d) -> FilePath
|
||||
fromAbsDirW = toFilePath
|
||||
fromAbsFileW :: Path' Windows Abs (File' f) -> FilePath
|
||||
|
||||
fromAbsDirW :: Path' Windows Abs (Dir d) -> FilePath
|
||||
fromAbsDirW = toFilePath
|
||||
|
||||
fromAbsFileW :: Path' Windows Abs (File' f) -> FilePath
|
||||
fromAbsFileW = toFilePath
|
||||
|
||||
-- | Either removes last entry or if there are no entries and just "../"s, adds one more "../".
|
||||
-- If path is absolute root and it has no parent, it will return unchanged path, same like Path.
|
||||
parent :: Path' s b t -> Path' s b (Dir d)
|
||||
parent path = case path of
|
||||
---- System
|
||||
RelDir p prefix -> relDirPathParent RelDir P.parent p prefix
|
||||
RelFile p prefix -> RelDir (P.parent p) prefix
|
||||
AbsDir p -> AbsDir $ P.parent p
|
||||
AbsFile p -> AbsDir $ P.parent p
|
||||
---- Windows
|
||||
RelDirW p prefix -> relDirPathParent RelDirW PW.parent p prefix
|
||||
RelFileW p prefix -> RelDirW (PW.parent p) prefix
|
||||
AbsDirW p -> AbsDirW $ PW.parent p
|
||||
AbsFileW p -> AbsDirW $ PW.parent p
|
||||
---- Posix
|
||||
RelDirP p prefix -> relDirPathParent RelDirP PP.parent p prefix
|
||||
RelFileP p prefix -> RelDirP (PP.parent p) prefix
|
||||
AbsDirP p -> AbsDirP $ PP.parent p
|
||||
AbsFileP p -> AbsDirP $ PP.parent p
|
||||
---- System
|
||||
RelDir p prefix -> relDirPathParent RelDir P.parent p prefix
|
||||
RelFile p prefix -> RelDir (P.parent p) prefix
|
||||
AbsDir p -> AbsDir $ P.parent p
|
||||
AbsFile p -> AbsDir $ P.parent p
|
||||
---- Windows
|
||||
RelDirW p prefix -> relDirPathParent RelDirW PW.parent p prefix
|
||||
RelFileW p prefix -> RelDirW (PW.parent p) prefix
|
||||
AbsDirW p -> AbsDirW $ PW.parent p
|
||||
AbsFileW p -> AbsDirW $ PW.parent p
|
||||
---- Posix
|
||||
RelDirP p prefix -> relDirPathParent RelDirP PP.parent p prefix
|
||||
RelFileP p prefix -> RelDirP (PP.parent p) prefix
|
||||
AbsDirP p -> AbsDirP $ PP.parent p
|
||||
AbsFileP p -> AbsDirP $ PP.parent p
|
||||
where
|
||||
-- NOTE: We need this special logic for RelDir, because if we have RelDir Path,
|
||||
-- it is possible that it is "." or smth like that and no parent can be obtained,
|
||||
@ -291,14 +372,15 @@ parent path = case path of
|
||||
-- For file though, we don't have that concern, because it will always be possible to
|
||||
-- get a parent, as per current Path implementation.
|
||||
relDirPathParent constructor pathParent p prefix =
|
||||
if pathParent p == p
|
||||
then let prefix' = case prefix of
|
||||
ParentDir n -> ParentDir (n + 1)
|
||||
NoPrefix -> ParentDir 1
|
||||
in constructor p prefix'
|
||||
else let p' = pathParent p
|
||||
in constructor p' prefix
|
||||
|
||||
if pathParent p == p
|
||||
then
|
||||
let prefix' = case prefix of
|
||||
ParentDir n -> ParentDir (n + 1)
|
||||
NoPrefix -> ParentDir 1
|
||||
in constructor p prefix'
|
||||
else
|
||||
let p' = pathParent p
|
||||
in constructor p' prefix
|
||||
|
||||
-- | How "../"s are resolved:
|
||||
-- For each "../" at the start of the right hand path, one most right entry is removed
|
||||
@ -313,92 +395,95 @@ parent path = case path of
|
||||
(</>) :: Path' s a (Dir d) -> Path' s (Rel d) c -> Path' s a c
|
||||
---- System
|
||||
lsp@(RelDir _ _) </> (RelFile rp rprefix) =
|
||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFile (lp' P.</> rp) lprefix'
|
||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFile (lp' P.</> rp) lprefix'
|
||||
lsp@(RelDir _ _) </> (RelDir rp rprefix) =
|
||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDir (lp' P.</> rp) lprefix'
|
||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDir (lp' P.</> rp) lprefix'
|
||||
lsp@(AbsDir _) </> (RelFile rp rprefix) =
|
||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFile (lp' P.</> rp)
|
||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFile (lp' P.</> rp)
|
||||
lsp@(AbsDir _) </> (RelDir rp rprefix) =
|
||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDir (lp' P.</> rp)
|
||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDir (lp' P.</> rp)
|
||||
---- Windows
|
||||
lsp@(RelDirW _ _) </> (RelFileW rp rprefix) =
|
||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFileW (lp' `pathWinCombineRelDirAndRelFile` rp) lprefix'
|
||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFileW (lp' `pathWinCombineRelDirAndRelFile` rp) lprefix'
|
||||
lsp@(RelDirW _ _) </> (RelDirW rp rprefix) =
|
||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDirW (lp' `pathWinCombineRelDirAndRelDir` rp) lprefix'
|
||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDirW (lp' `pathWinCombineRelDirAndRelDir` rp) lprefix'
|
||||
lsp@(AbsDirW _) </> (RelFileW rp rprefix) =
|
||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFileW (lp' PW.</> rp)
|
||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFileW (lp' PW.</> rp)
|
||||
lsp@(AbsDirW _) </> (RelDirW rp rprefix) =
|
||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDirW (lp' `pathWinCombineAbsDirAndRelDir` rp)
|
||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDirW (lp' `pathWinCombineAbsDirAndRelDir` rp)
|
||||
---- Posix
|
||||
lsp@(RelDirP _ _) </> (RelFileP rp rprefix) =
|
||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFileP (lp' `pathPosixCombineRelDirAndRelFile` rp) lprefix'
|
||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelFileP (lp' `pathPosixCombineRelDirAndRelFile` rp) lprefix'
|
||||
lsp@(RelDirP _ _) </> (RelDirP rp rprefix) =
|
||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDirP (lp' `pathPosixCombineRelDirAndRelDir` rp) lprefix'
|
||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in RelDirP (lp' `pathPosixCombineRelDirAndRelDir` rp) lprefix'
|
||||
lsp@(AbsDirP _) </> (RelFileP rp rprefix) =
|
||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFileP (lp' PP.</> rp)
|
||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsFileP (lp' PP.</> rp)
|
||||
lsp@(AbsDirP _) </> (RelDirP rp rprefix) =
|
||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDirP (lp' `pathPosixCombineAbsDirAndRelDir` rp)
|
||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||
in AbsDirP (lp' `pathPosixCombineAbsDirAndRelDir` rp)
|
||||
_ </> _ = impossible
|
||||
|
||||
|
||||
castRel :: Path' s (Rel d1) a -> Path' s (Rel d2) a
|
||||
---- System
|
||||
castRel (RelDir p pr) = RelDir p pr
|
||||
castRel (RelFile p pr) = RelFile p pr
|
||||
castRel (RelDir p pr) = RelDir p pr
|
||||
castRel (RelFile p pr) = RelFile p pr
|
||||
---- Windows
|
||||
castRel (RelDirW p pr) = RelDirW p pr
|
||||
castRel (RelDirW p pr) = RelDirW p pr
|
||||
castRel (RelFileW p pr) = RelFileW p pr
|
||||
---- Posix
|
||||
castRel (RelDirP p pr) = RelDirP p pr
|
||||
castRel (RelDirP p pr) = RelDirP p pr
|
||||
castRel (RelFileP p pr) = RelFileP p pr
|
||||
castRel _ = impossible
|
||||
castRel _ = impossible
|
||||
|
||||
castDir :: Path' s a (Dir d1) -> Path' s a (Dir d2)
|
||||
---- System
|
||||
castDir (AbsDir p) = AbsDir p
|
||||
castDir (RelDir p pr) = RelDir p pr
|
||||
castDir (AbsDir p) = AbsDir p
|
||||
castDir (RelDir p pr) = RelDir p pr
|
||||
---- Windows
|
||||
castDir (AbsDirW p) = AbsDirW p
|
||||
castDir (AbsDirW p) = AbsDirW p
|
||||
castDir (RelDirW p pr) = RelDirW p pr
|
||||
---- Posix
|
||||
castDir (AbsDirP p) = AbsDirP p
|
||||
castDir (AbsDirP p) = AbsDirP p
|
||||
castDir (RelDirP p pr) = RelDirP p pr
|
||||
castDir _ = impossible
|
||||
castDir _ = impossible
|
||||
|
||||
-- TODO: I was not able to unite these two functions (`relDirToPosix` and `relFileToPosix`) into just `toPosix``
|
||||
-- because Haskell did not believe me that I would be returning same "t" (Dir/File) in Path
|
||||
-- as was in first argument. I wonder if there is easy way to go around that or if
|
||||
-- we have to redo significant part of the StrongPath to be able to do smth like this.
|
||||
|
||||
-- | Converts relative path to posix by replacing current path separators with posix path separators.
|
||||
-- Works well for "normal" relative paths like "a\b\c" (Win) or "a/b/c" (Posix).
|
||||
-- If path is weird but still considered relative, like just "C:" on Win,
|
||||
-- results can be unxpected, most likely resulting with error thrown.
|
||||
-- If path is already Posix, it will not change.
|
||||
relDirToPosix :: MonadThrow m => Path' s (Rel d1) (Dir d2) -> m (Path' Posix (Rel d1) (Dir d2))
|
||||
relDirToPosix sp@(RelDir _ _) = parseRelDirP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp
|
||||
relDirToPosix sp@(RelDir _ _) = parseRelDirP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp
|
||||
relDirToPosix sp@(RelDirW _ _) = parseRelDirP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||
relDirToPosix (RelDirP p pr) = return $ RelDirP p pr
|
||||
relDirToPosix _ = impossible
|
||||
relDirToPosix (RelDirP p pr) = return $ RelDirP p pr
|
||||
relDirToPosix _ = impossible
|
||||
|
||||
relFileToPosix :: MonadThrow m => Path' s (Rel d1) (File' f) -> m (Path' Posix (Rel d1) (File' f))
|
||||
relFileToPosix sp@(RelFile _ _) = parseRelFileP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp
|
||||
relFileToPosix sp@(RelFile _ _) = parseRelFileP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp
|
||||
relFileToPosix sp@(RelFileW _ _) = parseRelFileP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||
relFileToPosix (RelFileP p pr) = return $ RelFileP p pr
|
||||
relFileToPosix _ = impossible
|
||||
relFileToPosix (RelFileP p pr) = return $ RelFileP p pr
|
||||
relFileToPosix _ = impossible
|
||||
|
||||
-- TODO: Should I name these unsafe versions differently? Maybe relDirToPosixU?
|
||||
-- Unsafe versions:
|
||||
relDirToPosix' :: Path' s (Rel d1) (Dir d2) -> Path' Posix (Rel d1) (Dir d2)
|
||||
relDirToPosix' = fromJust . relDirToPosix
|
||||
|
||||
relFileToPosix' :: Path' s (Rel d1) (File' f) -> Path' Posix (Rel d1) (File' f)
|
||||
relFileToPosix' = fromJust . relFileToPosix
|
||||
|
@ -1,85 +1,91 @@
|
||||
module StrongPath.Internal where
|
||||
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PP
|
||||
import qualified Path.Windows as PW
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PP
|
||||
import qualified Path.Windows as PW
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import qualified System.FilePath.Windows as FPW
|
||||
|
||||
|
||||
-- | s -> standard, b -> base, t -> type
|
||||
data Path' s b t
|
||||
-- System
|
||||
= RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
||||
| RelFile (P.Path P.Rel P.File) RelPathPrefix
|
||||
| AbsDir (P.Path P.Abs P.Dir)
|
||||
| AbsFile (P.Path P.Abs P.File)
|
||||
-- Windows
|
||||
| RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
||||
| RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix
|
||||
| AbsDirW (PW.Path PW.Abs PW.Dir)
|
||||
| AbsFileW (PW.Path PW.Abs PW.File)
|
||||
-- Posix
|
||||
| RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
||||
| RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix
|
||||
| AbsDirP (PP.Path PP.Abs PP.Dir)
|
||||
| AbsFileP (PP.Path PP.Abs PP.File)
|
||||
deriving (Show, Eq)
|
||||
= -- System
|
||||
RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
||||
| RelFile (P.Path P.Rel P.File) RelPathPrefix
|
||||
| AbsDir (P.Path P.Abs P.Dir)
|
||||
| AbsFile (P.Path P.Abs P.File)
|
||||
| -- Windows
|
||||
RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
||||
| RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix
|
||||
| AbsDirW (PW.Path PW.Abs PW.Dir)
|
||||
| AbsFileW (PW.Path PW.Abs PW.File)
|
||||
| -- Posix
|
||||
RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
||||
| RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix
|
||||
| AbsDirP (PP.Path PP.Abs PP.Dir)
|
||||
| AbsFileP (PP.Path PP.Abs PP.File)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data RelPathPrefix = ParentDir Int -- ^ ../, Int saying how many times it repeats.
|
||||
| NoPrefix
|
||||
deriving (Show, Eq)
|
||||
data RelPathPrefix
|
||||
= -- | ../, Int saying how many times it repeats.
|
||||
ParentDir Int
|
||||
| NoPrefix
|
||||
deriving (Show, Eq)
|
||||
|
||||
type Path = Path' System
|
||||
|
||||
-- | base
|
||||
data Abs
|
||||
|
||||
data Rel dir
|
||||
|
||||
-- | type
|
||||
data Dir dir
|
||||
|
||||
data File' file
|
||||
|
||||
type File = File' ()
|
||||
|
||||
-- | standard
|
||||
data System -- Depends on the platform, it is either Posix or Windows.
|
||||
|
||||
data Windows
|
||||
|
||||
data Posix
|
||||
|
||||
|
||||
parseRelFP :: MonadThrow m
|
||||
=> (P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t)
|
||||
-> [Char]
|
||||
-> (FilePath -> m (P.Path pb pt))
|
||||
-> FilePath
|
||||
-> m (Path' s (Rel d) t)
|
||||
parseRelFP ::
|
||||
MonadThrow m =>
|
||||
(P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t) ->
|
||||
[Char] ->
|
||||
(FilePath -> m (P.Path pb pt)) ->
|
||||
FilePath ->
|
||||
m (Path' s (Rel d) t)
|
||||
parseRelFP constructor validSeparators pathParser fp =
|
||||
let (prefix, fp') = extractRelPathPrefix validSeparators fp
|
||||
fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "".
|
||||
in (\p -> constructor p prefix) <$> pathParser fp''
|
||||
let (prefix, fp') = extractRelPathPrefix validSeparators fp
|
||||
fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "".
|
||||
in (\p -> constructor p prefix) <$> pathParser fp''
|
||||
|
||||
-- | Extracts a multiple "../" from start of the file path.
|
||||
-- If path is completely ../../.., also handles the last one.
|
||||
-- NOTE: We don't normalize path in any way.
|
||||
extractRelPathPrefix :: [Char] -> FilePath -> (RelPathPrefix, FilePath)
|
||||
extractRelPathPrefix validSeparators path =
|
||||
let (n, path') = dropParentDirs path
|
||||
in (if n == 0 then NoPrefix else ParentDir n, path')
|
||||
let (n, path') = dropParentDirs path
|
||||
in (if n == 0 then NoPrefix else ParentDir n, path')
|
||||
where
|
||||
parentDirStrings :: [String]
|
||||
parentDirStrings = [['.', '.', s] | s <- validSeparators]
|
||||
parentDirStrings = [['.', '.', s] | s <- validSeparators]
|
||||
|
||||
pathStartsWithParentDir :: FilePath -> Bool
|
||||
pathStartsWithParentDir p = take 3 p `elem` parentDirStrings
|
||||
pathStartsWithParentDir p = take 3 p `elem` parentDirStrings
|
||||
|
||||
dropParentDirs :: FilePath -> (Int, FilePath)
|
||||
dropParentDirs p
|
||||
| pathStartsWithParentDir p = let (n, p') = dropParentDirs (drop 3 p)
|
||||
in (1 + n, p')
|
||||
| p == ".." = (1, "")
|
||||
| otherwise = (0, p)
|
||||
| pathStartsWithParentDir p =
|
||||
let (n, p') = dropParentDirs (drop 3 p)
|
||||
in (1 + n, p')
|
||||
| p == ".." = (1, "")
|
||||
| otherwise = (0, p)
|
||||
|
||||
-- NOTE: These three funtions, pathWinCombine... exist only to fix
|
||||
-- Path.Windows.</> behaviour regarding concatenating '.' rel dirs
|
||||
@ -102,35 +108,39 @@ extractRelPathPrefix validSeparators path =
|
||||
-- do the rest of the work.
|
||||
pathWinCombineRelDirAndRelFile :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.File -> PW.Path PW.Rel PW.File
|
||||
pathWinCombineRelDirAndRelFile lp rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| otherwise = lp PW.</> rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| otherwise = lp PW.</> rp
|
||||
|
||||
pathWinCombineRelDirAndRelDir :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir
|
||||
pathWinCombineRelDirAndRelDir lp rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
| otherwise = lp PW.</> rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
| otherwise = lp PW.</> rp
|
||||
|
||||
pathWinCombineAbsDirAndRelDir :: PW.Path PW.Abs PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Abs PW.Dir
|
||||
pathWinCombineAbsDirAndRelDir lp rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
| otherwise = lp PW.</> rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
| otherwise = lp PW.</> rp
|
||||
|
||||
-- NOTE: Same as pathWinCombineRelDirAndRelFile but for Posix (Path has the same problem).
|
||||
pathPosixCombineRelDirAndRelFile :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.File -> PP.Path PP.Rel PP.File
|
||||
pathPosixCombineRelDirAndRelFile lp rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| otherwise = lp PP.</> rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| otherwise = lp PP.</> rp
|
||||
|
||||
pathPosixCombineRelDirAndRelDir :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir
|
||||
pathPosixCombineRelDirAndRelDir lp rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
| otherwise = lp PP.</> rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
| otherwise = lp PP.</> rp
|
||||
|
||||
pathPosixCombineAbsDirAndRelDir :: PP.Path PP.Abs PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Abs PP.Dir
|
||||
pathPosixCombineAbsDirAndRelDir lp rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
| otherwise = lp PP.</> rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
| otherwise = lp PP.</> rp
|
||||
|
||||
prefixNumParentDirs :: RelPathPrefix -> Int
|
||||
prefixNumParentDirs NoPrefix = 0
|
||||
prefixNumParentDirs NoPrefix = 0
|
||||
prefixNumParentDirs (ParentDir n) = n
|
||||
|
||||
relPathNumParentDirs :: Path' s (Rel r) t -> Int
|
||||
@ -138,13 +148,13 @@ relPathNumParentDirs = prefixNumParentDirs . relPathPrefix
|
||||
|
||||
relPathPrefix :: Path' s (Rel r) t -> RelPathPrefix
|
||||
relPathPrefix sp = case sp of
|
||||
RelDir _ pr -> pr
|
||||
RelFile _ pr -> pr
|
||||
RelDirW _ pr -> pr
|
||||
RelFileW _ pr -> pr
|
||||
RelDirP _ pr -> pr
|
||||
RelFileP _ pr -> pr
|
||||
_ -> impossible
|
||||
RelDir _ pr -> pr
|
||||
RelFile _ pr -> pr
|
||||
RelDirW _ pr -> pr
|
||||
RelFileW _ pr -> pr
|
||||
RelDirP _ pr -> pr
|
||||
RelFileP _ pr -> pr
|
||||
_ -> impossible
|
||||
|
||||
impossible :: a
|
||||
impossible = error "This should be impossible."
|
||||
|
@ -1,33 +1,35 @@
|
||||
module Util
|
||||
( camelToKebabCase
|
||||
, onFirst
|
||||
, toLowerFirst
|
||||
, toUpperFirst
|
||||
, headSafe
|
||||
, jsonSet
|
||||
) where
|
||||
( camelToKebabCase,
|
||||
onFirst,
|
||||
toLowerFirst,
|
||||
toUpperFirst,
|
||||
headSafe,
|
||||
jsonSet,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char (isUpper, toLower, toUpper)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Text as Text
|
||||
import Data.Char (isUpper, toLower, toUpper)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
camelToKebabCase :: String -> String
|
||||
camelToKebabCase "" = ""
|
||||
camelToKebabCase camel@(camelHead:camelTail) = kebabHead:kebabTail
|
||||
camelToKebabCase camel@(camelHead : camelTail) = kebabHead : kebabTail
|
||||
where
|
||||
kebabHead = toLower camelHead
|
||||
kebabTail = concat $ map
|
||||
(\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b])
|
||||
(zip camel camelTail)
|
||||
kebabTail =
|
||||
concat $
|
||||
map
|
||||
(\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b])
|
||||
(zip camel camelTail)
|
||||
isCamelHump (a, b) = (not . isUpper) a && isUpper b
|
||||
|
||||
-- | Applies given function to the first element of the list.
|
||||
-- If list is empty, returns empty list.
|
||||
onFirst :: (a -> a) -> [a] -> [a]
|
||||
onFirst _ [] = []
|
||||
onFirst f (x:xs) = (f x):xs
|
||||
onFirst f (x : xs) = (f x) : xs
|
||||
|
||||
toLowerFirst :: String -> String
|
||||
toLowerFirst = onFirst toLower
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Util.Fib (
|
||||
fibonacci
|
||||
) where
|
||||
module Util.Fib
|
||||
( fibonacci,
|
||||
)
|
||||
where
|
||||
|
||||
fibonacci :: Int -> Int
|
||||
fibonacci 0 = 0
|
||||
|
@ -1,17 +1,18 @@
|
||||
module Util.IO
|
||||
( listDirectoryDeep
|
||||
, listDirectory
|
||||
) where
|
||||
( listDirectoryDeep,
|
||||
listDirectory,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (filterM)
|
||||
import qualified Path as P
|
||||
import qualified System.Directory as Dir
|
||||
import qualified System.FilePath as FilePath
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import Control.Monad (filterM)
|
||||
import qualified Path as P
|
||||
|
||||
|
||||
-- TODO: write tests.
|
||||
|
||||
-- | Lists all files in the directory recursively.
|
||||
-- All paths are relative to the directory we are listing.
|
||||
-- If directory does not exist, returns empty list.
|
||||
@ -23,34 +24,36 @@ import qualified Path as P
|
||||
-- >>> ["test.txt", "bar/text2.txt"]
|
||||
listDirectoryDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||
listDirectoryDeep absDirPath = do
|
||||
(relFilePaths, relSubDirPaths) <- listDirectory absDirPath
|
||||
`catch` \e -> if isDoesNotExistError e then return ([], []) else throwIO e
|
||||
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath P.</>)) relSubDirPaths
|
||||
return $ relFilePaths ++ concat relSubDirFilesPaths
|
||||
(relFilePaths, relSubDirPaths) <-
|
||||
listDirectory absDirPath
|
||||
`catch` \e -> if isDoesNotExistError e then return ([], []) else throwIO e
|
||||
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath P.</>)) relSubDirPaths
|
||||
return $ relFilePaths ++ concat relSubDirFilesPaths
|
||||
where
|
||||
-- | NOTE: Here, returned paths are relative to the main dir whose sub dir we are listing,
|
||||
-- which is one level above what you might intuitively expect.
|
||||
listSubDirDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||
listSubDirDeep subDirPath = do
|
||||
files <- listDirectoryDeep subDirPath
|
||||
return $ map (P.dirname subDirPath P.</>) files
|
||||
listSubDirDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||
listSubDirDeep subDirPath = do
|
||||
files <- listDirectoryDeep subDirPath
|
||||
return $ map (P.dirname subDirPath P.</>) files
|
||||
|
||||
-- TODO: write tests.
|
||||
|
||||
-- | Lists files and directories at top lvl of the directory.
|
||||
listDirectory :: P.Path P.Abs P.Dir -> IO ([P.Path P.Rel P.File], [P.Path P.Rel P.Dir])
|
||||
listDirectory absDirPath = do
|
||||
fpRelItemPaths <- Dir.listDirectory fpAbsDirPath
|
||||
relFilePaths <- filterFiles fpAbsDirPath fpRelItemPaths
|
||||
relDirPaths <- filterDirs fpAbsDirPath fpRelItemPaths
|
||||
return (relFilePaths, relDirPaths)
|
||||
fpRelItemPaths <- Dir.listDirectory fpAbsDirPath
|
||||
relFilePaths <- filterFiles fpAbsDirPath fpRelItemPaths
|
||||
relDirPaths <- filterDirs fpAbsDirPath fpRelItemPaths
|
||||
return (relFilePaths, relDirPaths)
|
||||
where
|
||||
fpAbsDirPath :: FilePath
|
||||
fpAbsDirPath = P.toFilePath absDirPath
|
||||
fpAbsDirPath :: FilePath
|
||||
fpAbsDirPath = P.toFilePath absDirPath
|
||||
|
||||
filterFiles :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.File]
|
||||
filterFiles absDir relItems = filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelFile
|
||||
filterFiles :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.File]
|
||||
filterFiles absDir relItems =
|
||||
filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelFile
|
||||
|
||||
filterDirs :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.Dir]
|
||||
filterDirs absDir relItems = filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelDir
|
||||
filterDirs :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.Dir]
|
||||
filterDirs absDir relItems =
|
||||
filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelDir
|
||||
|
@ -1,18 +1,20 @@
|
||||
module Util.Terminal
|
||||
( Style(..)
|
||||
, applyStyles
|
||||
) where
|
||||
( Style (..),
|
||||
applyStyles,
|
||||
)
|
||||
where
|
||||
|
||||
data Style = Black
|
||||
| Red
|
||||
| Green
|
||||
| Yellow
|
||||
| Blue
|
||||
| Magenta
|
||||
| Cyan
|
||||
| White
|
||||
| Bold
|
||||
| Underline
|
||||
data Style
|
||||
= Black
|
||||
| Red
|
||||
| Green
|
||||
| Yellow
|
||||
| Blue
|
||||
| Magenta
|
||||
| Cyan
|
||||
| White
|
||||
| Bold
|
||||
| Underline
|
||||
|
||||
-- | Given a string, returns decorated string that when printed in terminal
|
||||
-- will have same content as original string but will also exibit specified styles.
|
||||
@ -20,18 +22,19 @@ applyStyles :: [Style] -> String -> String
|
||||
applyStyles [] str = str
|
||||
applyStyles _ "" = ""
|
||||
applyStyles styles str = foldl applyStyle str styles ++ escapeCode ++ resetCode
|
||||
where applyStyle s style = escapeCode ++ styleCode style ++ s
|
||||
where
|
||||
applyStyle s style = escapeCode ++ styleCode style ++ s
|
||||
|
||||
styleCode :: Style -> String
|
||||
styleCode Black = "[30m"
|
||||
styleCode Red = "[31m"
|
||||
styleCode Green = "[32m"
|
||||
styleCode Yellow = "[33m"
|
||||
styleCode Blue = "[34m"
|
||||
styleCode Magenta = "[35m"
|
||||
styleCode Cyan = "[36m"
|
||||
styleCode White = "[37m"
|
||||
styleCode Bold = "[1m"
|
||||
styleCode Black = "[30m"
|
||||
styleCode Red = "[31m"
|
||||
styleCode Green = "[32m"
|
||||
styleCode Yellow = "[33m"
|
||||
styleCode Blue = "[34m"
|
||||
styleCode Magenta = "[35m"
|
||||
styleCode Cyan = "[36m"
|
||||
styleCode White = "[37m"
|
||||
styleCode Bold = "[1m"
|
||||
styleCode Underline = "[4m"
|
||||
|
||||
escapeCode :: String
|
||||
|
@ -1,95 +1,85 @@
|
||||
module Wasp
|
||||
( Wasp
|
||||
, WaspElement (..)
|
||||
, fromWaspElems
|
||||
|
||||
, module Wasp.JsImport
|
||||
, getJsImports
|
||||
, setJsImports
|
||||
|
||||
, module Wasp.App
|
||||
, fromApp
|
||||
, getApp
|
||||
, setApp
|
||||
|
||||
, getAuth
|
||||
, getPSLEntities
|
||||
|
||||
, getDb
|
||||
|
||||
, module Wasp.Page
|
||||
, getPages
|
||||
, addPage
|
||||
, getRoutes
|
||||
|
||||
, getQueries
|
||||
, addQuery
|
||||
, getQueryByName
|
||||
|
||||
, getActions
|
||||
, addAction
|
||||
, getActionByName
|
||||
|
||||
, setExternalCodeFiles
|
||||
, getExternalCodeFiles
|
||||
|
||||
, setDotEnvFile
|
||||
, getDotEnvFile
|
||||
|
||||
, setIsBuild
|
||||
, getIsBuild
|
||||
|
||||
, setNpmDependencies
|
||||
, getNpmDependencies
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import StrongPath (Path, Abs, File)
|
||||
( Wasp,
|
||||
WaspElement (..),
|
||||
fromWaspElems,
|
||||
module Wasp.JsImport,
|
||||
getJsImports,
|
||||
setJsImports,
|
||||
module Wasp.App,
|
||||
fromApp,
|
||||
getApp,
|
||||
setApp,
|
||||
getAuth,
|
||||
getPSLEntities,
|
||||
getDb,
|
||||
module Wasp.Page,
|
||||
getPages,
|
||||
addPage,
|
||||
getRoutes,
|
||||
getQueries,
|
||||
addQuery,
|
||||
getQueryByName,
|
||||
getActions,
|
||||
addAction,
|
||||
getActionByName,
|
||||
setExternalCodeFiles,
|
||||
getExternalCodeFiles,
|
||||
setDotEnvFile,
|
||||
getDotEnvFile,
|
||||
setIsBuild,
|
||||
getIsBuild,
|
||||
setNpmDependencies,
|
||||
getNpmDependencies,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import qualified ExternalCode
|
||||
import qualified Util as U
|
||||
import StrongPath (Abs, File, Path)
|
||||
import qualified Util as U
|
||||
import qualified Wasp.Action
|
||||
import Wasp.App
|
||||
import Wasp.App
|
||||
import qualified Wasp.Auth
|
||||
import qualified Wasp.Db
|
||||
import Wasp.Entity
|
||||
import Wasp.JsImport
|
||||
import Wasp.NpmDependencies (NpmDependencies)
|
||||
import Wasp.Entity
|
||||
import Wasp.JsImport
|
||||
import Wasp.NpmDependencies (NpmDependencies)
|
||||
import qualified Wasp.NpmDependencies
|
||||
import Wasp.Page
|
||||
import Wasp.Page
|
||||
import qualified Wasp.Query
|
||||
import Wasp.Route
|
||||
|
||||
import Wasp.Route
|
||||
|
||||
-- * Wasp
|
||||
|
||||
data Wasp = Wasp
|
||||
{ waspElements :: [WaspElement]
|
||||
, waspJsImports :: [JsImport]
|
||||
, externalCodeFiles :: [ExternalCode.File]
|
||||
, dotEnvFile :: Maybe (Path Abs File)
|
||||
, isBuild :: Bool
|
||||
} deriving (Show, Eq)
|
||||
{ waspElements :: [WaspElement],
|
||||
waspJsImports :: [JsImport],
|
||||
externalCodeFiles :: [ExternalCode.File],
|
||||
dotEnvFile :: Maybe (Path Abs File),
|
||||
isBuild :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data WaspElement
|
||||
= WaspElementApp !App
|
||||
| WaspElementAuth !Wasp.Auth.Auth
|
||||
| WaspElementDb !Wasp.Db.Db
|
||||
| WaspElementPage !Page
|
||||
| WaspElementNpmDependencies !NpmDependencies
|
||||
| WaspElementRoute !Route
|
||||
| WaspElementEntity !Wasp.Entity.Entity
|
||||
| WaspElementQuery !Wasp.Query.Query
|
||||
| WaspElementAction !Wasp.Action.Action
|
||||
deriving (Show, Eq)
|
||||
= WaspElementApp !App
|
||||
| WaspElementAuth !Wasp.Auth.Auth
|
||||
| WaspElementDb !Wasp.Db.Db
|
||||
| WaspElementPage !Page
|
||||
| WaspElementNpmDependencies !NpmDependencies
|
||||
| WaspElementRoute !Route
|
||||
| WaspElementEntity !Wasp.Entity.Entity
|
||||
| WaspElementQuery !Wasp.Query.Query
|
||||
| WaspElementAction !Wasp.Action.Action
|
||||
deriving (Show, Eq)
|
||||
|
||||
fromWaspElems :: [WaspElement] -> Wasp
|
||||
fromWaspElems elems = Wasp
|
||||
{ waspElements = elems
|
||||
, waspJsImports = []
|
||||
, externalCodeFiles = []
|
||||
, dotEnvFile = Nothing
|
||||
, isBuild = False
|
||||
fromWaspElems elems =
|
||||
Wasp
|
||||
{ waspElements = elems,
|
||||
waspJsImports = [],
|
||||
externalCodeFiles = [],
|
||||
dotEnvFile = Nothing,
|
||||
isBuild = False
|
||||
}
|
||||
|
||||
-- * Build
|
||||
@ -98,7 +88,7 @@ getIsBuild :: Wasp -> Bool
|
||||
getIsBuild = isBuild
|
||||
|
||||
setIsBuild :: Wasp -> Bool -> Wasp
|
||||
setIsBuild wasp isBuildNew = wasp { isBuild = isBuildNew }
|
||||
setIsBuild wasp isBuildNew = wasp {isBuild = isBuildNew}
|
||||
|
||||
-- * External code files
|
||||
|
||||
@ -106,7 +96,7 @@ getExternalCodeFiles :: Wasp -> [ExternalCode.File]
|
||||
getExternalCodeFiles = externalCodeFiles
|
||||
|
||||
setExternalCodeFiles :: Wasp -> [ExternalCode.File] -> Wasp
|
||||
setExternalCodeFiles wasp files = wasp { externalCodeFiles = files }
|
||||
setExternalCodeFiles wasp files = wasp {externalCodeFiles = files}
|
||||
|
||||
-- * Dot env files
|
||||
|
||||
@ -114,7 +104,7 @@ getDotEnvFile :: Wasp -> Maybe (Path Abs File)
|
||||
getDotEnvFile = dotEnvFile
|
||||
|
||||
setDotEnvFile :: Wasp -> Maybe (Path Abs File) -> Wasp
|
||||
setDotEnvFile wasp file = wasp { dotEnvFile = file }
|
||||
setDotEnvFile wasp file = wasp {dotEnvFile = file}
|
||||
|
||||
-- * Js imports
|
||||
|
||||
@ -122,25 +112,26 @@ getJsImports :: Wasp -> [JsImport]
|
||||
getJsImports = waspJsImports
|
||||
|
||||
setJsImports :: Wasp -> [JsImport] -> Wasp
|
||||
setJsImports wasp jsImports = wasp { waspJsImports = jsImports }
|
||||
setJsImports wasp jsImports = wasp {waspJsImports = jsImports}
|
||||
|
||||
-- * App
|
||||
|
||||
getApp :: Wasp -> App
|
||||
getApp wasp = let apps = getApps wasp in
|
||||
if (length apps /= 1)
|
||||
then error "Wasp has to contain exactly one WaspElementApp element!"
|
||||
else head apps
|
||||
getApp wasp =
|
||||
let apps = getApps wasp
|
||||
in if (length apps /= 1)
|
||||
then error "Wasp has to contain exactly one WaspElementApp element!"
|
||||
else head apps
|
||||
|
||||
isAppElem :: WaspElement -> Bool
|
||||
isAppElem WaspElementApp{} = True
|
||||
isAppElem _ = False
|
||||
isAppElem WaspElementApp {} = True
|
||||
isAppElem _ = False
|
||||
|
||||
getApps :: Wasp -> [App]
|
||||
getApps wasp = [app | (WaspElementApp app) <- waspElements wasp]
|
||||
|
||||
setApp :: Wasp -> App -> Wasp
|
||||
setApp wasp app = wasp { waspElements = (WaspElementApp app) : (filter (not . isAppElem) (waspElements wasp)) }
|
||||
setApp wasp app = wasp {waspElements = (WaspElementApp app) : (filter (not . isAppElem) (waspElements wasp))}
|
||||
|
||||
fromApp :: App -> Wasp
|
||||
fromApp app = fromWaspElems [WaspElementApp app]
|
||||
@ -148,37 +139,40 @@ fromApp app = fromWaspElems [WaspElementApp app]
|
||||
-- * Auth
|
||||
|
||||
getAuth :: Wasp -> Maybe Wasp.Auth.Auth
|
||||
getAuth wasp = let auths = [a | WaspElementAuth a <- waspElements wasp] in
|
||||
case auths of
|
||||
[] -> Nothing
|
||||
getAuth wasp =
|
||||
let auths = [a | WaspElementAuth a <- waspElements wasp]
|
||||
in case auths of
|
||||
[] -> Nothing
|
||||
[a] -> Just a
|
||||
_ -> error "Wasp can't contain more than one WaspElementAuth element!"
|
||||
_ -> error "Wasp can't contain more than one WaspElementAuth element!"
|
||||
|
||||
-- * Db
|
||||
|
||||
getDb :: Wasp -> Maybe Wasp.Db.Db
|
||||
getDb wasp = let dbs = [db | WaspElementDb db <- waspElements wasp] in
|
||||
case dbs of
|
||||
[] -> Nothing
|
||||
getDb wasp =
|
||||
let dbs = [db | WaspElementDb db <- waspElements wasp]
|
||||
in case dbs of
|
||||
[] -> Nothing
|
||||
[db] -> Just db
|
||||
_ -> error "Wasp can't contain more than one Db element!"
|
||||
_ -> error "Wasp can't contain more than one Db element!"
|
||||
|
||||
-- * NpmDependencies
|
||||
|
||||
getNpmDependencies :: Wasp -> NpmDependencies
|
||||
getNpmDependencies wasp
|
||||
= let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
||||
in case depses of
|
||||
[] -> Wasp.NpmDependencies.empty
|
||||
[deps] -> deps
|
||||
_ -> error "Wasp can't contain more than one NpmDependencies element!"
|
||||
getNpmDependencies wasp =
|
||||
let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
||||
in case depses of
|
||||
[] -> Wasp.NpmDependencies.empty
|
||||
[deps] -> deps
|
||||
_ -> error "Wasp can't contain more than one NpmDependencies element!"
|
||||
|
||||
isNpmDependenciesElem :: WaspElement -> Bool
|
||||
isNpmDependenciesElem WaspElementNpmDependencies{} = True
|
||||
isNpmDependenciesElem _ = False
|
||||
isNpmDependenciesElem WaspElementNpmDependencies {} = True
|
||||
isNpmDependenciesElem _ = False
|
||||
|
||||
setNpmDependencies :: Wasp -> NpmDependencies -> Wasp
|
||||
setNpmDependencies wasp deps = wasp
|
||||
setNpmDependencies wasp deps =
|
||||
wasp
|
||||
{ waspElements = WaspElementNpmDependencies deps : filter (not . isNpmDependenciesElem) (waspElements wasp)
|
||||
}
|
||||
|
||||
@ -193,7 +187,7 @@ getPages :: Wasp -> [Page]
|
||||
getPages wasp = [page | (WaspElementPage page) <- waspElements wasp]
|
||||
|
||||
addPage :: Wasp -> Page -> Wasp
|
||||
addPage wasp page = wasp { waspElements = (WaspElementPage page):(waspElements wasp) }
|
||||
addPage wasp page = wasp {waspElements = (WaspElementPage page) : (waspElements wasp)}
|
||||
|
||||
-- * Query
|
||||
|
||||
@ -201,7 +195,7 @@ getQueries :: Wasp -> [Wasp.Query.Query]
|
||||
getQueries wasp = [query | (WaspElementQuery query) <- waspElements wasp]
|
||||
|
||||
addQuery :: Wasp -> Wasp.Query.Query -> Wasp
|
||||
addQuery wasp query = wasp { waspElements = WaspElementQuery query : waspElements wasp }
|
||||
addQuery wasp query = wasp {waspElements = WaspElementQuery query : waspElements wasp}
|
||||
|
||||
-- | Gets query with a specified name from wasp, if such an action exists.
|
||||
-- We assume here that there are no two queries with same name.
|
||||
@ -214,7 +208,7 @@ getActions :: Wasp -> [Wasp.Action.Action]
|
||||
getActions wasp = [action | (WaspElementAction action) <- waspElements wasp]
|
||||
|
||||
addAction :: Wasp -> Wasp.Action.Action -> Wasp
|
||||
addAction wasp action = wasp { waspElements = WaspElementAction action : waspElements wasp }
|
||||
addAction wasp action = wasp {waspElements = WaspElementAction action : waspElements wasp}
|
||||
|
||||
-- | Gets action with a specified name from wasp, if such an action exists.
|
||||
-- We assume here that there are no two actions with same name.
|
||||
@ -226,13 +220,13 @@ getActionByName wasp name = U.headSafe $ filter (\a -> Wasp.Action._name a == na
|
||||
getPSLEntities :: Wasp -> [Wasp.Entity.Entity]
|
||||
getPSLEntities wasp = [entity | (WaspElementEntity entity) <- (waspElements wasp)]
|
||||
|
||||
|
||||
-- * ToJSON instances.
|
||||
|
||||
instance ToJSON Wasp where
|
||||
toJSON wasp = object
|
||||
[ "app" .= getApp wasp
|
||||
, "pages" .= getPages wasp
|
||||
, "routes" .= getRoutes wasp
|
||||
, "jsImports" .= getJsImports wasp
|
||||
]
|
||||
toJSON wasp =
|
||||
object
|
||||
[ "app" .= getApp wasp,
|
||||
"pages" .= getPages wasp,
|
||||
"routes" .= getRoutes wasp,
|
||||
"jsImports" .= getJsImports wasp
|
||||
]
|
||||
|
@ -1,21 +1,24 @@
|
||||
module Wasp.Action
|
||||
( Action(..)
|
||||
) where
|
||||
( Action (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Wasp.JsImport (JsImport)
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Wasp.JsImport (JsImport)
|
||||
|
||||
-- TODO: Very similar to Wasp.Query, consider extracting duplication.
|
||||
|
||||
data Action = Action
|
||||
{ _name :: !String
|
||||
, _jsFunction :: !JsImport
|
||||
, _entities :: !(Maybe [String])
|
||||
} deriving (Show, Eq)
|
||||
{ _name :: !String,
|
||||
_jsFunction :: !JsImport,
|
||||
_entities :: !(Maybe [String])
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Action where
|
||||
toJSON action = object
|
||||
[ "name" .= _name action
|
||||
, "jsFunction" .= _jsFunction action
|
||||
, "entities" .= _entities action
|
||||
]
|
||||
toJSON action =
|
||||
object
|
||||
[ "name" .= _name action,
|
||||
"jsFunction" .= _jsFunction action,
|
||||
"entities" .= _entities action
|
||||
]
|
||||
|
@ -1,18 +1,20 @@
|
||||
module Wasp.App
|
||||
( App(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson ((.=), object, ToJSON(..))
|
||||
( App (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
data App = App
|
||||
{ appName :: !String -- Identifier
|
||||
, appTitle :: !String
|
||||
, appHead :: !(Maybe [String])
|
||||
} deriving (Show, Eq)
|
||||
{ appName :: !String, -- Identifier
|
||||
appTitle :: !String,
|
||||
appHead :: !(Maybe [String])
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON App where
|
||||
toJSON app = object
|
||||
[ "name" .= appName app
|
||||
, "title" .= appTitle app
|
||||
]
|
||||
toJSON app =
|
||||
object
|
||||
[ "name" .= appName app,
|
||||
"title" .= appTitle app
|
||||
]
|
||||
|
@ -1,14 +1,16 @@
|
||||
module Wasp.Auth
|
||||
( Auth (..)
|
||||
, AuthMethod (..)
|
||||
) where
|
||||
( Auth (..),
|
||||
AuthMethod (..),
|
||||
)
|
||||
where
|
||||
|
||||
data Auth = Auth
|
||||
{ _userEntity :: !String
|
||||
, _methods :: [AuthMethod]
|
||||
, _onAuthFailedRedirectTo :: !String
|
||||
} deriving (Show, Eq)
|
||||
{ _userEntity :: !String,
|
||||
_methods :: [AuthMethod],
|
||||
_onAuthFailedRedirectTo :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AuthMethod
|
||||
= EmailAndPassword
|
||||
deriving (Show, Eq)
|
||||
= EmailAndPassword
|
||||
deriving (Show, Eq)
|
||||
|
@ -1,13 +1,15 @@
|
||||
module Wasp.Db
|
||||
( Db (..)
|
||||
, DbSystem (..)
|
||||
) where
|
||||
( Db (..),
|
||||
DbSystem (..),
|
||||
)
|
||||
where
|
||||
|
||||
data Db = Db
|
||||
{ _system :: !DbSystem
|
||||
} deriving (Show, Eq)
|
||||
{ _system :: !DbSystem
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data DbSystem
|
||||
= PostgreSQL
|
||||
| SQLite
|
||||
deriving (Show, Eq)
|
||||
= PostgreSQL
|
||||
| SQLite
|
||||
deriving (Show, Eq)
|
||||
|
@ -1,55 +1,55 @@
|
||||
module Wasp.Entity
|
||||
( Entity (..)
|
||||
, Field (..)
|
||||
, FieldType (..)
|
||||
, Scalar (..)
|
||||
, Composite (..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON(..), (.=), object)
|
||||
( Entity (..),
|
||||
Field (..),
|
||||
FieldType (..),
|
||||
Scalar (..),
|
||||
Composite (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import qualified Psl.Ast.Model
|
||||
|
||||
|
||||
data Entity = Entity
|
||||
{ _name :: !String
|
||||
, _fields :: ![Field]
|
||||
, _pslModelBody :: !Psl.Ast.Model.Body
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ _name :: !String,
|
||||
_fields :: ![Field],
|
||||
_pslModelBody :: !Psl.Ast.Model.Body
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Field = Field
|
||||
{ _fieldName :: !String
|
||||
, _fieldType :: !FieldType
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
{ _fieldName :: !String,
|
||||
_fieldType :: !FieldType
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data FieldType = FieldTypeScalar Scalar | FieldTypeComposite Composite
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Composite = Optional Scalar | List Scalar
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Scalar
|
||||
= String
|
||||
| Boolean
|
||||
| Int
|
||||
| BigInt
|
||||
| Float
|
||||
| Decimal
|
||||
| DateTime
|
||||
| Json
|
||||
| Bytes
|
||||
-- | Name of the user-defined type.
|
||||
= String
|
||||
| Boolean
|
||||
| Int
|
||||
| BigInt
|
||||
| Float
|
||||
| Decimal
|
||||
| DateTime
|
||||
| Json
|
||||
| Bytes
|
||||
| -- | Name of the user-defined type.
|
||||
-- This could be another entity, or maybe an enum,
|
||||
-- we don't know here yet.
|
||||
| UserType String
|
||||
| Unsupported String
|
||||
deriving (Show, Eq)
|
||||
UserType String
|
||||
| Unsupported String
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Entity where
|
||||
toJSON entity = object
|
||||
[ "name" .= _name entity
|
||||
, "fields" .= show (_fields entity)
|
||||
, "pslModelBody" .= show (_pslModelBody entity)
|
||||
]
|
||||
toJSON entity =
|
||||
object
|
||||
[ "name" .= _name entity,
|
||||
"fields" .= show (_fields entity),
|
||||
"pslModelBody" .= show (_pslModelBody entity)
|
||||
]
|
||||
|
@ -1,8 +1,9 @@
|
||||
module Wasp.JsCode
|
||||
( JsCode(..)
|
||||
) where
|
||||
( JsCode (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON(..))
|
||||
import Data.Aeson (ToJSON (..))
|
||||
import Data.Text (Text)
|
||||
|
||||
data JsCode = JsCode !Text deriving (Show, Eq)
|
||||
@ -11,4 +12,4 @@ data JsCode = JsCode !Text deriving (Show, Eq)
|
||||
-- ideal. Ideally all the generation logic would be in the generator. But for now this was
|
||||
-- the simplest way to implement it.
|
||||
instance ToJSON JsCode where
|
||||
toJSON (JsCode code) = toJSON code
|
||||
toJSON (JsCode code) = toJSON code
|
||||
|
@ -1,24 +1,25 @@
|
||||
module Wasp.JsImport
|
||||
( JsImport(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
( JsImport (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Represents javascript import -> "import <what> from <from>".
|
||||
data JsImport = JsImport
|
||||
{ _defaultImport :: !(Maybe String)
|
||||
, _namedImports :: ![String]
|
||||
, _from :: Path' Posix (Rel SourceExternalCodeDir) File
|
||||
} deriving (Show, Eq)
|
||||
{ _defaultImport :: !(Maybe String),
|
||||
_namedImports :: ![String],
|
||||
_from :: Path' Posix (Rel SourceExternalCodeDir) File
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON JsImport where
|
||||
toJSON jsImport = object
|
||||
[ "defaultImport" .= _defaultImport jsImport
|
||||
, "namedImports" .= _namedImports jsImport
|
||||
, "from" .= SP.toFilePath (_from jsImport)
|
||||
]
|
||||
toJSON jsImport =
|
||||
object
|
||||
[ "defaultImport" .= _defaultImport jsImport,
|
||||
"namedImports" .= _namedImports jsImport,
|
||||
"from" .= SP.toFilePath (_from jsImport)
|
||||
]
|
||||
|
@ -1,20 +1,22 @@
|
||||
module Wasp.NpmDependencies
|
||||
( NpmDependencies(..)
|
||||
, empty
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import NpmDependency
|
||||
( NpmDependencies (..),
|
||||
empty,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import NpmDependency
|
||||
|
||||
data NpmDependencies = NpmDependencies
|
||||
{ _dependencies :: ![NpmDependency]
|
||||
} deriving (Show, Eq)
|
||||
{ _dependencies :: ![NpmDependency]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
empty :: NpmDependencies
|
||||
empty = NpmDependencies { _dependencies = [] }
|
||||
empty = NpmDependencies {_dependencies = []}
|
||||
|
||||
instance ToJSON NpmDependencies where
|
||||
toJSON deps = object
|
||||
[ "dependencies" .= _dependencies deps
|
||||
]
|
||||
toJSON deps =
|
||||
object
|
||||
[ "dependencies" .= _dependencies deps
|
||||
]
|
||||
|
@ -1,21 +1,23 @@
|
||||
module Wasp.Operation
|
||||
( Operation(..)
|
||||
, getName
|
||||
, getJsFn
|
||||
, getEntities
|
||||
) where
|
||||
( Operation (..),
|
||||
getName,
|
||||
getJsFn,
|
||||
getEntities,
|
||||
)
|
||||
where
|
||||
|
||||
-- TODO: Is this ok approach, should I instead use typeclass?
|
||||
-- So far, all usages in the codebase could be easily replaced with the Typeclass.
|
||||
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
import Wasp.JsImport (JsImport)
|
||||
import Wasp.Query (Query)
|
||||
import qualified Wasp.Query as Query
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
|
||||
data Operation = QueryOp Query
|
||||
| ActionOp Action
|
||||
data Operation
|
||||
= QueryOp Query
|
||||
| ActionOp Action
|
||||
|
||||
getName :: Operation -> String
|
||||
getName (QueryOp query) = Query._name query
|
||||
|
@ -1,19 +1,21 @@
|
||||
module Wasp.Page
|
||||
( Page(..)
|
||||
) where
|
||||
( Page (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson ((.=), object, ToJSON(..))
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Wasp.JsImport (JsImport)
|
||||
|
||||
|
||||
data Page = Page
|
||||
{ _name :: !String
|
||||
, _component :: !JsImport
|
||||
, _authRequired :: Maybe Bool
|
||||
} deriving (Show, Eq)
|
||||
{ _name :: !String,
|
||||
_component :: !JsImport,
|
||||
_authRequired :: Maybe Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Page where
|
||||
toJSON page = object
|
||||
[ "name" .= _name page
|
||||
, "component" .= _component page
|
||||
]
|
||||
toJSON page =
|
||||
object
|
||||
[ "name" .= _name page,
|
||||
"component" .= _component page
|
||||
]
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user