mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-08-17 03:00:59 +03:00
Formatted whole codebase with ormolu.
This commit is contained in:
parent
369ab16586
commit
1219a57bc9
@ -1,2 +1,3 @@
|
|||||||
import Distribution.Simple
|
import Distribution.Simple
|
||||||
|
|
||||||
main = defaultMain
|
main = defaultMain
|
||||||
|
@ -1,28 +1,27 @@
|
|||||||
module Cli.Common
|
module Cli.Common
|
||||||
( WaspProjectDir
|
( WaspProjectDir,
|
||||||
, DotWaspDir
|
DotWaspDir,
|
||||||
, CliTemplatesDir
|
CliTemplatesDir,
|
||||||
, dotWaspDirInWaspProjectDir
|
dotWaspDirInWaspProjectDir,
|
||||||
, dotWaspRootFileInWaspProjectDir
|
dotWaspRootFileInWaspProjectDir,
|
||||||
, extCodeDirInWaspProjectDir
|
extCodeDirInWaspProjectDir,
|
||||||
, generatedCodeDirInDotWaspDir
|
generatedCodeDirInDotWaspDir,
|
||||||
, buildDirInDotWaspDir
|
buildDirInDotWaspDir,
|
||||||
, waspSays
|
waspSays,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Path as P
|
import Common (WaspProjectDir)
|
||||||
|
import ExternalCode (SourceExternalCodeDir)
|
||||||
import Common (WaspProjectDir)
|
|
||||||
import ExternalCode (SourceExternalCodeDir)
|
|
||||||
import qualified Generator.Common
|
import qualified Generator.Common
|
||||||
import StrongPath (Dir, File, Path, Rel)
|
import qualified Path as P
|
||||||
import qualified StrongPath as SP
|
import StrongPath (Dir, File, Path, Rel)
|
||||||
import qualified Util.Terminal as Term
|
import qualified StrongPath as SP
|
||||||
|
import qualified Util.Terminal as Term
|
||||||
|
|
||||||
data DotWaspDir -- Here we put everything that wasp generates.
|
data DotWaspDir -- Here we put everything that wasp generates.
|
||||||
data CliTemplatesDir
|
|
||||||
|
|
||||||
|
data CliTemplatesDir
|
||||||
|
|
||||||
-- TODO: SHould this be renamed to include word "root"?
|
-- TODO: SHould this be renamed to include word "root"?
|
||||||
dotWaspDirInWaspProjectDir :: Path (Rel WaspProjectDir) (Dir DotWaspDir)
|
dotWaspDirInWaspProjectDir :: Path (Rel WaspProjectDir) (Dir DotWaspDir)
|
||||||
|
@ -1,24 +1,25 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
|
||||||
module Command
|
module Command
|
||||||
( Command
|
( Command,
|
||||||
, runCommand
|
runCommand,
|
||||||
, CommandError(..)
|
CommandError (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
|
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
|
||||||
import Control.Monad.IO.Class (MonadIO)
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
|
||||||
|
newtype Command a = Command {_runCommand :: ExceptT CommandError IO a}
|
||||||
newtype Command a = Command { _runCommand :: ExceptT CommandError IO a }
|
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
|
||||||
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
|
|
||||||
|
|
||||||
runCommand :: Command a -> IO ()
|
runCommand :: Command a -> IO ()
|
||||||
runCommand cmd = do
|
runCommand cmd = do
|
||||||
errorOrResult <- runExceptT $ _runCommand cmd
|
errorOrResult <- runExceptT $ _runCommand cmd
|
||||||
case errorOrResult of
|
case errorOrResult of
|
||||||
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
||||||
Right _ -> return ()
|
Right _ -> return ()
|
||||||
|
|
||||||
-- TODO: What if we want to recognize errors in order to handle them?
|
-- 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?
|
-- 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
|
module Command.Build
|
||||||
( build
|
( build,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Monad.Except (throwError)
|
import qualified Cli.Common as Common
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Command (Command, CommandError (..))
|
||||||
|
import Command.Common
|
||||||
import qualified Cli.Common as Common
|
( alphaWarningMessage,
|
||||||
import Command (Command, CommandError (..))
|
findWaspProjectRootDirFromCwd,
|
||||||
import Command.Common (alphaWarningMessage,
|
)
|
||||||
findWaspProjectRootDirFromCwd)
|
import Command.Compile (compileIOWithOptions)
|
||||||
import Command.Compile (compileIOWithOptions)
|
import CompileOptions (CompileOptions (..))
|
||||||
import CompileOptions (CompileOptions (..))
|
import Control.Monad.Except (throwError)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Lib
|
import qualified Lib
|
||||||
import StrongPath (Abs, Dir, Path, (</>))
|
import StrongPath (Abs, Dir, Path, (</>))
|
||||||
|
|
||||||
build :: Command ()
|
build :: Command ()
|
||||||
build = do
|
build = do
|
||||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||||
let outDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
let outDir =
|
||||||
</> Common.buildDirInDotWaspDir
|
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||||
|
</> Common.buildDirInDotWaspDir
|
||||||
|
|
||||||
liftIO $ putStrLn "Building wasp project..."
|
liftIO $ putStrLn "Building wasp project..."
|
||||||
buildResult <- liftIO $ buildIO waspProjectDir outDir
|
buildResult <- liftIO $ buildIO waspProjectDir outDir
|
||||||
case buildResult of
|
case buildResult of
|
||||||
Left compileError -> throwError $ CommandError $ "Build failed: " ++ compileError
|
Left compileError -> throwError $ CommandError $ "Build failed: " ++ compileError
|
||||||
Right () -> liftIO $ putStrLn "Code has been successfully built! Check it out in .wasp/build directory.\n"
|
Right () -> liftIO $ putStrLn "Code has been successfully built! Check it out in .wasp/build directory.\n"
|
||||||
liftIO $ putStrLn alphaWarningMessage
|
liftIO $ putStrLn alphaWarningMessage
|
||||||
|
|
||||||
buildIO :: Path Abs (Dir Common.WaspProjectDir)
|
buildIO ::
|
||||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
Path Abs (Dir Common.WaspProjectDir) ->
|
||||||
-> IO (Either String ())
|
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||||
|
IO (Either String ())
|
||||||
buildIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
buildIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||||
where
|
where
|
||||||
options = CompileOptions
|
options =
|
||||||
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir
|
CompileOptions
|
||||||
, isBuild = True
|
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir,
|
||||||
}
|
isBuild = True
|
||||||
|
}
|
||||||
|
@ -1,11 +1,12 @@
|
|||||||
module Command.Call where
|
module Command.Call where
|
||||||
|
|
||||||
data Call = New String -- project name
|
data Call
|
||||||
| Start
|
= New String -- project name
|
||||||
| Clean
|
| Start
|
||||||
| Compile
|
| Clean
|
||||||
| Db [String] -- db args
|
| Compile
|
||||||
| Build
|
| Db [String] -- db args
|
||||||
| Version
|
| Build
|
||||||
| Telemetry
|
| Version
|
||||||
| Unknown [String] -- all args
|
| Telemetry
|
||||||
|
| Unknown [String] -- all args
|
||||||
|
@ -1,25 +1,27 @@
|
|||||||
module Command.Clean
|
module Command.Clean
|
||||||
( clean
|
( clean,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import qualified Cli.Common as Common
|
||||||
import System.Directory (doesDirectoryExist,
|
import Command (Command)
|
||||||
removeDirectoryRecursive)
|
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||||
import System.IO (hFlush, stdout)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import qualified StrongPath as SP
|
||||||
import qualified Cli.Common as Common
|
import System.Directory
|
||||||
import Command (Command)
|
( doesDirectoryExist,
|
||||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
removeDirectoryRecursive,
|
||||||
import qualified StrongPath as SP
|
)
|
||||||
|
import System.IO (hFlush, stdout)
|
||||||
|
|
||||||
clean :: Command ()
|
clean :: Command ()
|
||||||
clean = do
|
clean = do
|
||||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||||
let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir
|
let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir
|
||||||
liftIO $ putStrLn "Deleting .wasp/ directory..." >> hFlush stdout
|
liftIO $ putStrLn "Deleting .wasp/ directory..." >> hFlush stdout
|
||||||
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
|
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
|
||||||
if doesDotWaspDirExist
|
if doesDotWaspDirExist
|
||||||
then liftIO $ do removeDirectoryRecursive dotWaspDirFp
|
then liftIO $ do
|
||||||
putStrLn "Deleted .wasp/ directory."
|
removeDirectoryRecursive dotWaspDirFp
|
||||||
else liftIO $ putStrLn "Nothing to delete: .wasp directory does not exist."
|
putStrLn "Deleted .wasp/ directory."
|
||||||
|
else liftIO $ putStrLn "Nothing to delete: .wasp directory does not exist."
|
||||||
|
@ -1,55 +1,62 @@
|
|||||||
module Command.Compile
|
module Command.Compile
|
||||||
( compileIO
|
( compileIO,
|
||||||
, compile
|
compile,
|
||||||
, compileIOWithOptions
|
compileIOWithOptions,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Control.Monad.Except (runExceptT, throwError)
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
|
||||||
|
|
||||||
import qualified Cli.Common
|
import qualified Cli.Common
|
||||||
import Command (Command, CommandError (..))
|
import Command (Command, CommandError (..))
|
||||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
import Command.Common
|
||||||
waspSaysC)
|
( findWaspProjectRootDirFromCwd,
|
||||||
import Command.Db.Migrate (MigrationDirCopyDirection (..),
|
waspSaysC,
|
||||||
copyDbMigrationsDir)
|
)
|
||||||
import Common (WaspProjectDir)
|
import Command.Db.Migrate
|
||||||
import CompileOptions (CompileOptions (..))
|
( MigrationDirCopyDirection (..),
|
||||||
|
copyDbMigrationsDir,
|
||||||
|
)
|
||||||
|
import Common (WaspProjectDir)
|
||||||
|
import CompileOptions (CompileOptions (..))
|
||||||
|
import Control.Monad.Except (runExceptT, throwError)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Lib
|
import qualified Lib
|
||||||
import StrongPath (Abs, Dir, Path, (</>))
|
import StrongPath (Abs, Dir, Path, (</>))
|
||||||
|
|
||||||
|
|
||||||
compile :: Command ()
|
compile :: Command ()
|
||||||
compile = do
|
compile = do
|
||||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||||
let outDir = waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
let outDir =
|
||||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
||||||
|
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||||
|
|
||||||
waspSaysC "Compiling wasp code..."
|
waspSaysC "Compiling wasp code..."
|
||||||
compilationResult <- liftIO $ compileIO waspProjectDir outDir
|
compilationResult <- liftIO $ compileIO waspProjectDir outDir
|
||||||
case compilationResult of
|
case compilationResult of
|
||||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
||||||
|
|
||||||
-- | Compiles Wasp source code in waspProjectDir directory and generates a project
|
-- | Compiles Wasp source code in waspProjectDir directory and generates a project
|
||||||
-- in given outDir directory.
|
-- in given outDir directory.
|
||||||
compileIO :: Path Abs (Dir WaspProjectDir)
|
compileIO ::
|
||||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
Path Abs (Dir WaspProjectDir) ->
|
||||||
-> IO (Either String ())
|
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||||
|
IO (Either String ())
|
||||||
compileIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
compileIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||||
where
|
where
|
||||||
options = CompileOptions
|
options =
|
||||||
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir
|
CompileOptions
|
||||||
, isBuild = False
|
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir,
|
||||||
|
isBuild = False
|
||||||
}
|
}
|
||||||
|
|
||||||
compileIOWithOptions :: CompileOptions
|
compileIOWithOptions ::
|
||||||
-> Path Abs (Dir Cli.Common.WaspProjectDir)
|
CompileOptions ->
|
||||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
Path Abs (Dir Cli.Common.WaspProjectDir) ->
|
||||||
-> IO (Either String ())
|
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||||
|
IO (Either String ())
|
||||||
compileIOWithOptions options waspProjectDir outDir = runExceptT $ do
|
compileIOWithOptions options waspProjectDir outDir = runExceptT $ do
|
||||||
-- TODO: Use throwIO instead of Either to return exceptions?
|
-- TODO: Use throwIO instead of Either to return exceptions?
|
||||||
liftIO (Lib.compile waspProjectDir outDir options)
|
liftIO (Lib.compile waspProjectDir outDir options)
|
||||||
>>= either throwError return
|
>>= either throwError return
|
||||||
liftIO (copyDbMigrationsDir CopyMigDirDown waspProjectDir outDir)
|
liftIO (copyDbMigrationsDir CopyMigDirDown waspProjectDir outDir)
|
||||||
>>= maybe (return ()) (throwError . ("Copying migration folder failed: " ++))
|
>>= maybe (return ()) (throwError . ("Copying migration folder failed: " ++))
|
||||||
|
@ -1,22 +1,22 @@
|
|||||||
module Command.Db
|
module Command.Db
|
||||||
( runDbCommand
|
( runDbCommand,
|
||||||
, studio
|
studio,
|
||||||
) where
|
)
|
||||||
|
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.Concurrent (newChan)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Concurrent.Async (concurrently)
|
||||||
import Control.Monad.Except (throwError)
|
import Control.Monad.Except (throwError)
|
||||||
import System.Exit (ExitCode (..))
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
|
||||||
import StrongPath ((</>))
|
|
||||||
import Generator.ServerGenerator.Setup (setupServer)
|
|
||||||
import Generator.DbGenerator.Jobs (runStudio)
|
import Generator.DbGenerator.Jobs (runStudio)
|
||||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||||
import Command (Command, CommandError(..), runCommand)
|
import Generator.ServerGenerator.Setup (setupServer)
|
||||||
import Command.Compile (compile)
|
import StrongPath ((</>))
|
||||||
import Command.Common (findWaspProjectRootDirFromCwd, waspSaysC)
|
import System.Exit (ExitCode (..))
|
||||||
import qualified Cli.Common as Common
|
|
||||||
|
|
||||||
runDbCommand :: Command a -> IO ()
|
runDbCommand :: Command a -> IO ()
|
||||||
runDbCommand = runCommand . makeDbCommand
|
runDbCommand = runCommand . makeDbCommand
|
||||||
@ -27,38 +27,40 @@ runDbCommand = runCommand . makeDbCommand
|
|||||||
-- All the commands that operate on db should be created using this function.
|
-- All the commands that operate on db should be created using this function.
|
||||||
makeDbCommand :: Command a -> Command a
|
makeDbCommand :: Command a -> Command a
|
||||||
makeDbCommand cmd = do
|
makeDbCommand cmd = do
|
||||||
waspRoot <- findWaspProjectRootDirFromCwd
|
waspRoot <- findWaspProjectRootDirFromCwd
|
||||||
let genProjectDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </>
|
let genProjectDir =
|
||||||
Common.generatedCodeDirInDotWaspDir
|
waspRoot </> Common.dotWaspDirInWaspProjectDir
|
||||||
|
</> Common.generatedCodeDirInDotWaspDir
|
||||||
|
|
||||||
-- NOTE(matija): First we need make sure the code is generated.
|
-- NOTE(matija): First we need make sure the code is generated.
|
||||||
compile
|
compile
|
||||||
|
|
||||||
waspSaysC "\nSetting up database..."
|
waspSaysC "\nSetting up database..."
|
||||||
chan <- liftIO newChan
|
chan <- liftIO newChan
|
||||||
-- NOTE(matija): What we do here is make sure that Prisma CLI is installed because db commands
|
-- 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
|
-- (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.
|
-- this function more lightweight if needed.
|
||||||
(_, dbSetupResult) <- liftIO (concurrently (readJobMessagesAndPrintThemPrefixed chan) (setupServer genProjectDir chan))
|
(_, dbSetupResult) <- liftIO (concurrently (readJobMessagesAndPrintThemPrefixed chan) (setupServer genProjectDir chan))
|
||||||
case dbSetupResult of
|
case dbSetupResult of
|
||||||
ExitSuccess -> waspSaysC "\nDatabase successfully set up!" >> cmd
|
ExitSuccess -> waspSaysC "\nDatabase successfully set up!" >> cmd
|
||||||
exitCode -> throwError $ CommandError $ dbSetupFailedMessage exitCode
|
exitCode -> throwError $ CommandError $ dbSetupFailedMessage exitCode
|
||||||
|
where
|
||||||
where
|
dbSetupFailedMessage exitCode =
|
||||||
dbSetupFailedMessage exitCode = "\nDatabase setup failed" ++
|
"\nDatabase setup failed"
|
||||||
case exitCode of
|
++ case exitCode of
|
||||||
ExitFailure code -> ": " ++ show code
|
ExitFailure code -> ": " ++ show code
|
||||||
_ -> ""
|
_ -> ""
|
||||||
|
|
||||||
-- TODO(matija): should we extract this into a separate file, like we did for migrate?
|
-- TODO(matija): should we extract this into a separate file, like we did for migrate?
|
||||||
studio :: Command ()
|
studio :: Command ()
|
||||||
studio = do
|
studio = do
|
||||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||||
let genProjectDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
let genProjectDir =
|
||||||
</> Common.generatedCodeDirInDotWaspDir
|
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||||
|
</> Common.generatedCodeDirInDotWaspDir
|
||||||
|
|
||||||
waspSaysC "Running studio..."
|
waspSaysC "Running studio..."
|
||||||
chan <- liftIO newChan
|
chan <- liftIO newChan
|
||||||
|
|
||||||
_ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan)
|
_ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan)
|
||||||
error "This should never happen, studio should never stop."
|
error "This should never happen, studio should never stop."
|
||||||
|
@ -1,100 +1,107 @@
|
|||||||
module Command.Db.Migrate
|
module Command.Db.Migrate
|
||||||
( migrateDev
|
( migrateDev,
|
||||||
, copyDbMigrationsDir
|
copyDbMigrationsDir,
|
||||||
, MigrationDirCopyDirection(..)
|
MigrationDirCopyDirection (..),
|
||||||
) where
|
)
|
||||||
|
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 qualified Cli.Common
|
||||||
import StrongPath (Abs, Dir, Path, (</>))
|
import Command (Command, CommandError (..))
|
||||||
import qualified StrongPath as SP
|
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.
|
-- Wasp generator interface.
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import Generator.DbGenerator (dbRootDirInProjectRootDir)
|
import Generator.DbGenerator (dbRootDirInProjectRootDir)
|
||||||
import qualified Generator.DbGenerator.Operations as DbOps
|
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 :: Command ()
|
||||||
migrateDev = do
|
migrateDev = do
|
||||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||||
let genProjectRootDir = waspProjectDir
|
let genProjectRootDir =
|
||||||
</> Cli.Common.dotWaspDirInWaspProjectDir
|
waspProjectDir
|
||||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
</> Cli.Common.dotWaspDirInWaspProjectDir
|
||||||
|
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||||
|
|
||||||
-- TODO(matija): It might make sense that this (copying migrations folder from source to
|
-- 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
|
-- 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
|
-- 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.
|
-- 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
|
-- 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
|
-- 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
|
-- 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).
|
-- migrations doing the same thing (which might result in conflict, e.g. during db creation).
|
||||||
waspSaysC "Copying migrations folder from Wasp to Prisma project..."
|
waspSaysC "Copying migrations folder from Wasp to Prisma project..."
|
||||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirDown
|
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirDown
|
||||||
|
|
||||||
waspSaysC "Performing migration..."
|
waspSaysC "Performing migration..."
|
||||||
migrateResult <- liftIO $ DbOps.migrateDev genProjectRootDir
|
migrateResult <- liftIO $ DbOps.migrateDev genProjectRootDir
|
||||||
case migrateResult of
|
case migrateResult of
|
||||||
Left migrateError ->
|
Left migrateError ->
|
||||||
throwError $ CommandError $ "Migrate dev failed: " <> migrateError
|
throwError $ CommandError $ "Migrate dev failed: " <> migrateError
|
||||||
Right () -> waspSaysC "Migration done."
|
Right () -> waspSaysC "Migration done."
|
||||||
|
|
||||||
waspSaysC "Copying migrations folder from Prisma to Wasp project..."
|
waspSaysC "Copying migrations folder from Prisma to Wasp project..."
|
||||||
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirUp
|
copyDbMigrationDir waspProjectDir genProjectRootDir CopyMigDirUp
|
||||||
|
|
||||||
waspSaysC "All done!"
|
waspSaysC "All done!"
|
||||||
where
|
where
|
||||||
copyDbMigrationDir waspProjectDir genProjectRootDir copyDirection = do
|
copyDbMigrationDir waspProjectDir genProjectRootDir copyDirection = do
|
||||||
copyDbMigDirResult <-
|
copyDbMigDirResult <-
|
||||||
liftIO $ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir
|
liftIO $ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir
|
||||||
case copyDbMigDirResult of
|
case copyDbMigDirResult of
|
||||||
Nothing -> waspSaysC "Done copying migrations folder."
|
Nothing -> waspSaysC "Done copying migrations folder."
|
||||||
Just err -> throwError $ CommandError $ "Copying migration folder failed: " ++ err
|
Just err -> throwError $ CommandError $ "Copying migration folder failed: " ++ err
|
||||||
|
|
||||||
|
|
||||||
data MigrationDirCopyDirection = CopyMigDirUp | CopyMigDirDown deriving (Eq)
|
data MigrationDirCopyDirection = CopyMigDirUp | CopyMigDirDown deriving (Eq)
|
||||||
|
|
||||||
-- | Copy migrations directory between Wasp source and the generated project.
|
-- | Copy migrations directory between Wasp source and the generated project.
|
||||||
copyDbMigrationsDir
|
copyDbMigrationsDir ::
|
||||||
:: MigrationDirCopyDirection -- ^ Copy direction (source -> gen or gen-> source)
|
-- | Copy direction (source -> gen or gen-> source)
|
||||||
-> Path Abs (Dir WaspProjectDir)
|
MigrationDirCopyDirection ->
|
||||||
-> Path Abs (Dir ProjectRootDir)
|
Path Abs (Dir WaspProjectDir) ->
|
||||||
-> IO (Maybe String)
|
Path Abs (Dir ProjectRootDir) ->
|
||||||
|
IO (Maybe String)
|
||||||
copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir = do
|
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).
|
-- Migration folder in Wasp source (seen by Wasp dev and versioned).
|
||||||
let dbMigrationsDirInWaspProjectDirAbs = waspProjectDir </> dbMigrationsDirInDbRootDir
|
let dbMigrationsDirInWaspProjectDirAbs = waspProjectDir </> dbMigrationsDirInDbRootDir
|
||||||
|
|
||||||
-- Migration folder in the generated code.
|
-- Migration folder in the generated code.
|
||||||
let dbMigrationsDirInGenProjectDirAbs = genProjectRootDir </> dbRootDirInProjectRootDir
|
let dbMigrationsDirInGenProjectDirAbs =
|
||||||
</> dbMigrationsDirInDbRootDir
|
genProjectRootDir </> dbRootDirInProjectRootDir
|
||||||
|
</> dbMigrationsDirInDbRootDir
|
||||||
|
|
||||||
let src = if copyDirection == CopyMigDirUp
|
let src =
|
||||||
then dbMigrationsDirInGenProjectDirAbs
|
if copyDirection == CopyMigDirUp
|
||||||
else dbMigrationsDirInWaspProjectDirAbs
|
then dbMigrationsDirInGenProjectDirAbs
|
||||||
|
else dbMigrationsDirInWaspProjectDirAbs
|
||||||
|
|
||||||
let target = if copyDirection == CopyMigDirUp
|
let target =
|
||||||
then dbMigrationsDirInWaspProjectDirAbs
|
if copyDirection == CopyMigDirUp
|
||||||
else dbMigrationsDirInGenProjectDirAbs
|
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
|
|
||||||
|
|
||||||
|
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
|
module Command.Start
|
||||||
( start
|
( start,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Concurrent.Async (race)
|
import qualified Cli.Common as Common
|
||||||
import Control.Monad.Except (throwError)
|
import Command (Command, CommandError (..))
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Command.Common
|
||||||
|
( findWaspProjectRootDirFromCwd,
|
||||||
import qualified Cli.Common as Common
|
waspSaysC,
|
||||||
import Command (Command, CommandError (..))
|
)
|
||||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
import Command.Compile (compileIO)
|
||||||
waspSaysC)
|
import Command.Watch (watch)
|
||||||
import Command.Compile (compileIO)
|
import Control.Concurrent.Async (race)
|
||||||
import Command.Watch (watch)
|
import Control.Monad.Except (throwError)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Lib
|
import qualified Lib
|
||||||
import StrongPath ((</>))
|
import StrongPath ((</>))
|
||||||
|
|
||||||
|
|
||||||
-- | Does initial compile of wasp code and then runs the generated project.
|
-- | 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.
|
-- It also listens for any file changes and recompiles and restarts generated project accordingly.
|
||||||
start :: Command ()
|
start :: Command ()
|
||||||
start = do
|
start = do
|
||||||
waspRoot <- findWaspProjectRootDirFromCwd
|
waspRoot <- findWaspProjectRootDirFromCwd
|
||||||
let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir
|
let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir
|
||||||
|
|
||||||
waspSaysC "Compiling wasp code..."
|
waspSaysC "Compiling wasp code..."
|
||||||
compilationResult <- liftIO $ compileIO waspRoot outDir
|
compilationResult <- liftIO $ compileIO waspRoot outDir
|
||||||
case compilationResult of
|
case compilationResult of
|
||||||
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError
|
||||||
Right () -> waspSaysC "Code has been successfully compiled, project has been generated.\n"
|
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.
|
-- 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.
|
-- 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
|
-- 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.
|
-- 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
|
-- 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.
|
-- 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.
|
-- Right now we have setup/installation being called, but it has not support for being "smart" yet.
|
||||||
waspSaysC "Setting up generated project..."
|
waspSaysC "Setting up generated project..."
|
||||||
setupResult <- liftIO $ Lib.setup outDir
|
setupResult <- liftIO $ Lib.setup outDir
|
||||||
case setupResult of
|
case setupResult of
|
||||||
Left setupError -> throwError $ CommandError $ "\nSetup failed: " ++ setupError
|
Left setupError -> throwError $ CommandError $ "\nSetup failed: " ++ setupError
|
||||||
Right () -> waspSaysC "\nSetup successful.\n"
|
Right () -> waspSaysC "\nSetup successful.\n"
|
||||||
|
|
||||||
waspSaysC "\nListening for file changes..."
|
waspSaysC "\nListening for file changes..."
|
||||||
waspSaysC "Starting up generated project..."
|
waspSaysC "Starting up generated project..."
|
||||||
watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Lib.start outDir)
|
watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Lib.start outDir)
|
||||||
case watchOrStartResult of
|
case watchOrStartResult of
|
||||||
Left () -> error "This should never happen, listening for file changes should never end but it did."
|
Left () -> error "This should never happen, listening for file changes should never end but it did."
|
||||||
Right startResult -> case startResult of
|
Right startResult -> case startResult of
|
||||||
Left startError -> throwError $ CommandError $ "Start failed: " ++ startError
|
Left startError -> throwError $ CommandError $ "Start failed: " ++ startError
|
||||||
Right () -> error "This should never happen, start should never end but it did."
|
Right () -> error "This should never happen, start should never end but it did."
|
||||||
|
@ -1,22 +1,22 @@
|
|||||||
module Command.Telemetry
|
module Command.Telemetry
|
||||||
( considerSendingData
|
( considerSendingData,
|
||||||
, telemetry
|
telemetry,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Monad (when, unless)
|
import Command (Command, CommandError (..))
|
||||||
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 qualified Command.Call
|
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.Project as TlmProject
|
||||||
import qualified Command.Telemetry.User as TlmUser
|
import qualified Command.Telemetry.User as TlmUser
|
||||||
import qualified StrongPath as SP
|
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 :: IO Bool
|
||||||
isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
|
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.
|
-- | Prints basic information about the stauts of telemetry.
|
||||||
telemetry :: Command ()
|
telemetry :: Command ()
|
||||||
telemetry = do
|
telemetry = do
|
||||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||||
waspSaysC $ "Telemetry is currently: " <> (if telemetryDisabled
|
waspSaysC $
|
||||||
then "DISABLED"
|
"Telemetry is currently: "
|
||||||
else "ENABLED")
|
<> ( if telemetryDisabled
|
||||||
|
then "DISABLED"
|
||||||
|
else "ENABLED"
|
||||||
|
)
|
||||||
|
|
||||||
unless telemetryDisabled $ do
|
unless telemetryDisabled $ do
|
||||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||||
waspSaysC $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath
|
waspSaysC $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath
|
||||||
|
|
||||||
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||||
for_ maybeProjectHash $ \projectHash -> do
|
for_ maybeProjectHash $ \projectHash -> do
|
||||||
maybeProjectCache <- liftIO $ TlmProject.readProjectTelemetryFile telemetryCacheDirPath projectHash
|
maybeProjectCache <- liftIO $ TlmProject.readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||||
for_ maybeProjectCache $ \projectCache -> do
|
for_ maybeProjectCache $ \projectCache -> do
|
||||||
let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache
|
let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache
|
||||||
for_ maybeTimeOfLastSending $ \timeOfLastSending -> do
|
for_ maybeTimeOfLastSending $ \timeOfLastSending -> do
|
||||||
waspSaysC $ "Last time telemetry data was sent for this project: " ++ show timeOfLastSending
|
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.
|
-- | 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.
|
-- 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.
|
-- If env var WASP_TELEMETRY_DISABLE is set, nothing happens.
|
||||||
considerSendingData :: Command.Call.Call -> Command ()
|
considerSendingData :: Command.Call.Call -> Command ()
|
||||||
considerSendingData cmdCall = (`catchError` const (return ())) $ do
|
considerSendingData cmdCall = (`catchError` const (return ())) $ do
|
||||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||||
when telemetryDisabled $ throwError $ CommandError "Telemetry disabled by user."
|
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)
|
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
|
||||||
for_ maybeProjectHash $ \projectHash -> do
|
for_ maybeProjectHash $ \projectHash -> do
|
||||||
liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall
|
liftIO $ TlmProject.considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall
|
||||||
|
@ -1,15 +1,14 @@
|
|||||||
module Command.Telemetry.Common
|
module Command.Telemetry.Common
|
||||||
( TelemetryCacheDir
|
( TelemetryCacheDir,
|
||||||
, ensureTelemetryCacheDirExists
|
ensureTelemetryCacheDirExists,
|
||||||
, getTelemetryCacheDirPath
|
getTelemetryCacheDirPath,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Path (reldir)
|
|
||||||
import qualified System.Directory as SD
|
|
||||||
|
|
||||||
import StrongPath (Abs, Dir, Path)
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
|
|
||||||
|
import Path (reldir)
|
||||||
|
import StrongPath (Abs, Dir, Path)
|
||||||
|
import qualified StrongPath as SP
|
||||||
|
import qualified System.Directory as SD
|
||||||
|
|
||||||
data UserCacheDir
|
data UserCacheDir
|
||||||
|
|
||||||
@ -20,11 +19,11 @@ data TelemetryCacheDir
|
|||||||
|
|
||||||
ensureTelemetryCacheDirExists :: IO (Path Abs (Dir TelemetryCacheDir))
|
ensureTelemetryCacheDirExists :: IO (Path Abs (Dir TelemetryCacheDir))
|
||||||
ensureTelemetryCacheDirExists = do
|
ensureTelemetryCacheDirExists = do
|
||||||
userCacheDirPath <- getUserCacheDirPath
|
userCacheDirPath <- getUserCacheDirPath
|
||||||
SD.createDirectoryIfMissing False $ SP.toFilePath userCacheDirPath
|
SD.createDirectoryIfMissing False $ SP.toFilePath userCacheDirPath
|
||||||
let telemetryCacheDirPath = getTelemetryCacheDirPath userCacheDirPath
|
let telemetryCacheDirPath = getTelemetryCacheDirPath userCacheDirPath
|
||||||
SD.createDirectoryIfMissing True $ SP.toFilePath telemetryCacheDirPath
|
SD.createDirectoryIfMissing True $ SP.toFilePath telemetryCacheDirPath
|
||||||
return telemetryCacheDirPath
|
return telemetryCacheDirPath
|
||||||
|
|
||||||
getTelemetryCacheDirPath :: Path Abs (Dir UserCacheDir) -> Path Abs (Dir TelemetryCacheDir)
|
getTelemetryCacheDirPath :: Path Abs (Dir UserCacheDir) -> Path Abs (Dir TelemetryCacheDir)
|
||||||
getTelemetryCacheDirPath userCacheDirPath = userCacheDirPath SP.</> SP.fromPathRelDir [reldir|wasp/telemetry|]
|
getTelemetryCacheDirPath userCacheDirPath = userCacheDirPath SP.</> SP.fromPathRelDir [reldir|wasp/telemetry|]
|
||||||
|
@ -1,73 +1,74 @@
|
|||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
module Command.Telemetry.Project
|
module Command.Telemetry.Project
|
||||||
( getWaspProjectPathHash
|
( getWaspProjectPathHash,
|
||||||
, considerSendingData
|
considerSendingData,
|
||||||
, readProjectTelemetryFile
|
readProjectTelemetryFile,
|
||||||
, getTimeOfLastTelemetryDataSent
|
getTimeOfLastTelemetryDataSent,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
import Command (Command)
|
||||||
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 qualified Command.Call
|
import qualified Command.Call
|
||||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||||
import Command.Telemetry.User (UserSignature (..))
|
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||||
import StrongPath (Abs, Dir, File, Path)
|
import Command.Telemetry.User (UserSignature (..))
|
||||||
import qualified StrongPath as SP
|
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 :: Path Abs (Dir TelemetryCacheDir) -> UserSignature -> ProjectHash -> Command.Call.Call -> IO ()
|
||||||
considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
|
considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
|
||||||
projectCache <- readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash
|
projectCache <- readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||||
|
|
||||||
let relevantLastCheckIn = case cmdCall of
|
let relevantLastCheckIn = case cmdCall of
|
||||||
Command.Call.Build -> _lastCheckInBuild projectCache
|
Command.Call.Build -> _lastCheckInBuild projectCache
|
||||||
_ -> _lastCheckIn projectCache
|
_ -> _lastCheckIn projectCache
|
||||||
|
|
||||||
shouldSendData <- case relevantLastCheckIn of
|
shouldSendData <- case relevantLastCheckIn of
|
||||||
Nothing -> return True
|
Nothing -> return True
|
||||||
Just lastCheckIn -> isOlderThan12Hours lastCheckIn
|
Just lastCheckIn -> isOlderThan12Hours lastCheckIn
|
||||||
|
|
||||||
when shouldSendData $ do
|
when shouldSendData $ do
|
||||||
sendTelemetryData $ getProjectTelemetryData userSignature projectHash cmdCall
|
sendTelemetryData $ getProjectTelemetryData userSignature projectHash cmdCall
|
||||||
projectCache' <- newProjectCache projectCache
|
projectCache' <- newProjectCache projectCache
|
||||||
writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache'
|
writeProjectTelemetryFile telemetryCacheDirPath projectHash projectCache'
|
||||||
where
|
where
|
||||||
isOlderThan12Hours :: T.UTCTime -> IO Bool
|
isOlderThan12Hours :: T.UTCTime -> IO Bool
|
||||||
isOlderThan12Hours time = do
|
isOlderThan12Hours time = do
|
||||||
now <- T.getCurrentTime
|
now <- T.getCurrentTime
|
||||||
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
|
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
|
||||||
return $ let numSecondsInHour = 3600
|
return $
|
||||||
in secondsSinceLastCheckIn > 12 * numSecondsInHour
|
let numSecondsInHour = 3600
|
||||||
|
in secondsSinceLastCheckIn > 12 * numSecondsInHour
|
||||||
|
|
||||||
newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
|
newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
|
||||||
newProjectCache currentProjectCache = do
|
newProjectCache currentProjectCache = do
|
||||||
now <- T.getCurrentTime
|
now <- T.getCurrentTime
|
||||||
return currentProjectCache
|
return
|
||||||
{ _lastCheckIn = Just now
|
currentProjectCache
|
||||||
, _lastCheckInBuild = case cmdCall of
|
{ _lastCheckIn = Just now,
|
||||||
Command.Call.Build -> Just now
|
_lastCheckInBuild = case cmdCall of
|
||||||
_ -> _lastCheckInBuild currentProjectCache
|
Command.Call.Build -> Just now
|
||||||
}
|
_ -> _lastCheckInBuild currentProjectCache
|
||||||
|
}
|
||||||
|
|
||||||
-- * Project hash.
|
-- * Project hash.
|
||||||
|
|
||||||
newtype ProjectHash = ProjectHash { _projectHashValue :: String } deriving (Show)
|
newtype ProjectHash = ProjectHash {_projectHashValue :: String} deriving (Show)
|
||||||
|
|
||||||
getWaspProjectPathHash :: Command ProjectHash
|
getWaspProjectPathHash :: Command ProjectHash
|
||||||
getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> findWaspProjectRootDirFromCwd
|
getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> findWaspProjectRootDirFromCwd
|
||||||
@ -78,16 +79,17 @@ getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> find
|
|||||||
-- * Project telemetry cache.
|
-- * Project telemetry cache.
|
||||||
|
|
||||||
data ProjectTelemetryCache = ProjectTelemetryCache
|
data ProjectTelemetryCache = ProjectTelemetryCache
|
||||||
{ _lastCheckIn :: Maybe T.UTCTime -- Last time when CLI was called for this project, any command.
|
{ _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.
|
_lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
instance Aeson.ToJSON ProjectTelemetryCache
|
instance Aeson.ToJSON ProjectTelemetryCache
|
||||||
|
|
||||||
instance Aeson.FromJSON ProjectTelemetryCache
|
instance Aeson.FromJSON ProjectTelemetryCache
|
||||||
|
|
||||||
initialCache :: ProjectTelemetryCache
|
initialCache :: ProjectTelemetryCache
|
||||||
initialCache = ProjectTelemetryCache { _lastCheckIn = Nothing, _lastCheckInBuild = Nothing }
|
initialCache = ProjectTelemetryCache {_lastCheckIn = Nothing, _lastCheckInBuild = Nothing}
|
||||||
|
|
||||||
-- * Project telemetry cache file.
|
-- * Project telemetry cache file.
|
||||||
|
|
||||||
@ -96,66 +98,71 @@ getTimeOfLastTelemetryDataSent cache = maximum [_lastCheckIn cache, _lastCheckIn
|
|||||||
|
|
||||||
readProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO (Maybe ProjectTelemetryCache)
|
readProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO (Maybe ProjectTelemetryCache)
|
||||||
readProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
readProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
||||||
fileExists <- SD.doesFileExist filePathFP
|
fileExists <- SD.doesFileExist filePathFP
|
||||||
if fileExists then readCacheFile else return Nothing
|
if fileExists then readCacheFile else return Nothing
|
||||||
where
|
where
|
||||||
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
||||||
readCacheFile = Aeson.decode . ByteStringLazyUTF8.fromString <$> readFile filePathFP
|
readCacheFile = Aeson.decode . ByteStringLazyUTF8.fromString <$> readFile filePathFP
|
||||||
|
|
||||||
readOrCreateProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO ProjectTelemetryCache
|
readOrCreateProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> IO ProjectTelemetryCache
|
||||||
readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
readOrCreateProjectTelemetryFile telemetryCacheDirPath projectHash = do
|
||||||
maybeProjectTelemetryCache <- readProjectTelemetryFile telemetryCacheDirPath projectHash
|
maybeProjectTelemetryCache <- readProjectTelemetryFile telemetryCacheDirPath projectHash
|
||||||
case maybeProjectTelemetryCache of
|
case maybeProjectTelemetryCache of
|
||||||
Just cache -> return cache
|
Just cache -> return cache
|
||||||
Nothing -> writeProjectTelemetryFile telemetryCacheDirPath projectHash initialCache >> return initialCache
|
Nothing -> writeProjectTelemetryFile telemetryCacheDirPath projectHash initialCache >> return initialCache
|
||||||
|
|
||||||
writeProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> ProjectTelemetryCache -> IO ()
|
writeProjectTelemetryFile :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> ProjectTelemetryCache -> IO ()
|
||||||
writeProjectTelemetryFile telemetryCacheDirPath projectHash cache = do
|
writeProjectTelemetryFile telemetryCacheDirPath projectHash cache = do
|
||||||
writeFile filePathFP (ByteStringLazyUTF8.toString $ Aeson.encode cache)
|
writeFile filePathFP (ByteStringLazyUTF8.toString $ Aeson.encode cache)
|
||||||
where
|
where
|
||||||
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
filePathFP = SP.toFilePath $ getProjectTelemetryFilePath telemetryCacheDirPath projectHash
|
||||||
|
|
||||||
getProjectTelemetryFilePath :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> Path Abs File
|
getProjectTelemetryFilePath :: Path Abs (Dir TelemetryCacheDir) -> ProjectHash -> Path Abs File
|
||||||
getProjectTelemetryFilePath telemetryCacheDir (ProjectHash projectHash) =
|
getProjectTelemetryFilePath telemetryCacheDir (ProjectHash projectHash) =
|
||||||
telemetryCacheDir SP.</> fromJust (SP.parseRelFile $ "project-" ++ projectHash)
|
telemetryCacheDir SP.</> fromJust (SP.parseRelFile $ "project-" ++ projectHash)
|
||||||
|
|
||||||
-- * Telemetry data.
|
-- * Telemetry data.
|
||||||
|
|
||||||
data ProjectTelemetryData = ProjectTelemetryData
|
data ProjectTelemetryData = ProjectTelemetryData
|
||||||
{ _userSignature :: UserSignature
|
{ _userSignature :: UserSignature,
|
||||||
, _projectHash :: ProjectHash
|
_projectHash :: ProjectHash,
|
||||||
, _waspVersion :: String
|
_waspVersion :: String,
|
||||||
, _os :: String
|
_os :: String,
|
||||||
, _isBuild :: Bool
|
_isBuild :: Bool
|
||||||
} deriving (Show)
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
getProjectTelemetryData :: UserSignature -> ProjectHash -> Command.Call.Call -> ProjectTelemetryData
|
getProjectTelemetryData :: UserSignature -> ProjectHash -> Command.Call.Call -> ProjectTelemetryData
|
||||||
getProjectTelemetryData userSignature projectHash cmdCall = ProjectTelemetryData
|
getProjectTelemetryData userSignature projectHash cmdCall =
|
||||||
{ _userSignature = userSignature
|
ProjectTelemetryData
|
||||||
, _projectHash = projectHash
|
{ _userSignature = userSignature,
|
||||||
, _waspVersion = showVersion version
|
_projectHash = projectHash,
|
||||||
, _os = System.Info.os
|
_waspVersion = showVersion version,
|
||||||
, _isBuild = case cmdCall of
|
_os = System.Info.os,
|
||||||
Command.Call.Build -> True
|
_isBuild = case cmdCall of
|
||||||
_ -> False
|
Command.Call.Build -> True
|
||||||
|
_ -> False
|
||||||
}
|
}
|
||||||
|
|
||||||
sendTelemetryData :: ProjectTelemetryData -> IO ()
|
sendTelemetryData :: ProjectTelemetryData -> IO ()
|
||||||
sendTelemetryData telemetryData = do
|
sendTelemetryData telemetryData = do
|
||||||
let reqBodyJson = Aeson.object
|
let reqBodyJson =
|
||||||
[ -- PostHog api_key is public so it is ok that we have it here.
|
Aeson.object
|
||||||
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String)
|
[ -- PostHog api_key is public so it is ok that we have it here.
|
||||||
, "event" .= ("cli" :: String)
|
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String),
|
||||||
, "properties" .= Aeson.object
|
"event" .= ("cli" :: String),
|
||||||
|
"properties"
|
||||||
|
.= Aeson.object
|
||||||
[ -- distinct_id is special PostHog value, used as user id.
|
[ -- distinct_id is special PostHog value, used as user id.
|
||||||
"distinct_id" .= _userSignatureValue (_userSignature telemetryData)
|
"distinct_id" .= _userSignatureValue (_userSignature telemetryData),
|
||||||
-- Following are our custom metrics:
|
-- Following are our custom metrics:
|
||||||
, "project_hash" .= _projectHashValue (_projectHash telemetryData)
|
"project_hash" .= _projectHashValue (_projectHash telemetryData),
|
||||||
, "wasp_version" .= _waspVersion telemetryData
|
"wasp_version" .= _waspVersion telemetryData,
|
||||||
, "os" .= _os telemetryData
|
"os" .= _os telemetryData,
|
||||||
, "is_build" .= _isBuild telemetryData
|
"is_build" .= _isBuild telemetryData
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
request = HTTP.setRequestBodyJSON reqBodyJson $
|
request =
|
||||||
HTTP.parseRequest_ "POST https://app.posthog.com/capture"
|
HTTP.setRequestBodyJSON reqBodyJson $
|
||||||
void $ HTTP.httpNoBody request
|
HTTP.parseRequest_ "POST https://app.posthog.com/capture"
|
||||||
|
void $ HTTP.httpNoBody request
|
||||||
|
@ -1,34 +1,33 @@
|
|||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
|
||||||
module Command.Telemetry.User
|
module Command.Telemetry.User
|
||||||
( UserSignature(..)
|
( UserSignature (..),
|
||||||
, readOrCreateUserSignatureFile
|
readOrCreateUserSignatureFile,
|
||||||
) where
|
)
|
||||||
|
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
|
|
||||||
|
|
||||||
|
|
||||||
|
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.
|
-- 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 :: Path Abs (Dir TelemetryCacheDir) -> IO UserSignature
|
||||||
readOrCreateUserSignatureFile telemetryCacheDirPath = do
|
readOrCreateUserSignatureFile telemetryCacheDirPath = do
|
||||||
let filePath = getUserSignatureFilePath telemetryCacheDirPath
|
let filePath = getUserSignatureFilePath telemetryCacheDirPath
|
||||||
let filePathFP = SP.toFilePath filePath
|
let filePathFP = SP.toFilePath filePath
|
||||||
fileExists <- SD.doesFileExist filePathFP
|
fileExists <- SD.doesFileExist filePathFP
|
||||||
UserSignature <$> if fileExists
|
UserSignature
|
||||||
then readFile filePathFP
|
<$> if fileExists
|
||||||
else do userSignature <- show <$> UUID.nextRandom
|
then readFile filePathFP
|
||||||
writeFile filePathFP userSignature
|
else do
|
||||||
return userSignature
|
userSignature <- show <$> UUID.nextRandom
|
||||||
|
writeFile filePathFP userSignature
|
||||||
|
return userSignature
|
||||||
|
|
||||||
getUserSignatureFilePath :: Path Abs (Dir TelemetryCacheDir) -> Path Abs File
|
getUserSignatureFilePath :: Path Abs (Dir TelemetryCacheDir) -> Path Abs File
|
||||||
getUserSignatureFilePath telemetryCacheDir = telemetryCacheDir SP.</> SP.fromPathRelFile [relfile|signature|]
|
getUserSignatureFilePath telemetryCacheDir = telemetryCacheDir SP.</> SP.fromPathRelFile [relfile|signature|]
|
||||||
|
|
||||||
|
@ -1,20 +1,19 @@
|
|||||||
module Command.Watch
|
module Command.Watch
|
||||||
( watch
|
( watch,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
import Cli.Common (waspSays)
|
||||||
import Data.List (isSuffixOf)
|
import qualified Cli.Common as Common
|
||||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
import Command.Compile (compileIO)
|
||||||
import qualified System.FilePath as FP
|
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||||
import qualified System.FSNotify as FSN
|
import Data.List (isSuffixOf)
|
||||||
|
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||||
import Cli.Common (waspSays)
|
|
||||||
import qualified Cli.Common as Common
|
|
||||||
import Command.Compile (compileIO)
|
|
||||||
import qualified Lib
|
import qualified Lib
|
||||||
import StrongPath (Abs, Dir, Path, (</>))
|
import StrongPath (Abs, Dir, Path, (</>))
|
||||||
import qualified StrongPath as SP
|
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
|
-- 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.
|
-- 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
|
-- 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
|
-- .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.
|
-- 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,
|
-- | 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.
|
-- compiles Wasp source files in waspProjectDir and regenerates files in outDir.
|
||||||
watch :: Path Abs (Dir Common.WaspProjectDir) -> Path Abs (Dir Lib.ProjectRootDir) -> IO ()
|
watch :: Path Abs (Dir Common.WaspProjectDir) -> Path Abs (Dir Lib.ProjectRootDir) -> IO ()
|
||||||
watch waspProjectDir outDir = FSN.withManager $ \mgr -> do
|
watch waspProjectDir outDir = FSN.withManager $ \mgr -> do
|
||||||
currentTime <- getCurrentTime
|
currentTime <- getCurrentTime
|
||||||
chan <- newChan
|
chan <- newChan
|
||||||
_ <- FSN.watchDirChan mgr (SP.toFilePath waspProjectDir) eventFilter chan
|
_ <- FSN.watchDirChan mgr (SP.toFilePath waspProjectDir) eventFilter chan
|
||||||
_ <- FSN.watchTreeChan mgr (SP.toFilePath $ waspProjectDir </> Common.extCodeDirInWaspProjectDir) eventFilter chan
|
_ <- FSN.watchTreeChan mgr (SP.toFilePath $ waspProjectDir </> Common.extCodeDirInWaspProjectDir) eventFilter chan
|
||||||
listenForEvents chan currentTime
|
listenForEvents chan currentTime
|
||||||
where
|
where
|
||||||
listenForEvents :: Chan FSN.Event -> UTCTime -> IO ()
|
listenForEvents :: Chan FSN.Event -> UTCTime -> IO ()
|
||||||
listenForEvents chan lastCompileTime = do
|
listenForEvents chan lastCompileTime = do
|
||||||
event <- readChan chan
|
event <- readChan chan
|
||||||
let eventTime = FSN.eventTime event
|
let eventTime = FSN.eventTime event
|
||||||
if eventTime < lastCompileTime
|
if eventTime < lastCompileTime
|
||||||
-- If event happened before last compilation started, skip it.
|
then -- If event happened before last compilation started, skip it.
|
||||||
then listenForEvents chan lastCompileTime
|
listenForEvents chan lastCompileTime
|
||||||
else do
|
else do
|
||||||
currentTime <- getCurrentTime
|
currentTime <- getCurrentTime
|
||||||
recompile
|
recompile
|
||||||
listenForEvents chan currentTime
|
listenForEvents chan currentTime
|
||||||
|
|
||||||
recompile :: IO ()
|
recompile :: IO ()
|
||||||
recompile = do
|
recompile = do
|
||||||
waspSays "Recompiling on file change..."
|
waspSays "Recompiling on file change..."
|
||||||
compilationResult <- compileIO waspProjectDir outDir
|
compilationResult <- compileIO waspProjectDir outDir
|
||||||
case compilationResult of
|
case compilationResult of
|
||||||
Left err -> waspSays $ "Recompilation on file change failed: " ++ err
|
Left err -> waspSays $ "Recompilation on file change failed: " ++ err
|
||||||
Right () -> waspSays "Recompilation on file change succeeded."
|
Right () -> waspSays "Recompilation on file change succeeded."
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
-- TODO: This is a hardcoded approach to ignoring most of the common tmp files that editors
|
-- 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,
|
-- 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
|
-- so better approach would be probably to use information from .gitignore instead, or
|
||||||
-- maybe combining the two somehow.
|
-- maybe combining the two somehow.
|
||||||
eventFilter :: FSN.Event -> Bool
|
eventFilter :: FSN.Event -> Bool
|
||||||
eventFilter event =
|
eventFilter event =
|
||||||
let filename = FP.takeFileName $ FSN.eventPath event
|
let filename = FP.takeFileName $ FSN.eventPath event
|
||||||
in not (null filename)
|
in not (null filename)
|
||||||
&& not (take 2 filename == ".#") -- Ignore emacs lock files.
|
&& not (take 2 filename == ".#") -- Ignore emacs lock files.
|
||||||
&& not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files.
|
&& not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files.
|
||||||
&& not (last filename == '~') -- Ignore emacs and vim backup files.
|
&& not (last filename == '~') -- Ignore emacs and vim backup files.
|
||||||
&& not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files.
|
&& not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files.
|
||||||
&& not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files.
|
&& not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files.
|
||||||
|
@ -1,84 +1,85 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Command (runCommand)
|
||||||
import qualified Control.Concurrent.Async as Async
|
import Command.Build (build)
|
||||||
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 qualified Command.Call
|
import qualified Command.Call
|
||||||
import Command.Clean (clean)
|
import Command.Clean (clean)
|
||||||
import Command.Compile (compile)
|
import Command.Compile (compile)
|
||||||
import Command.CreateNewProject (createNewProject)
|
import Command.CreateNewProject (createNewProject)
|
||||||
import Command.Db (runDbCommand, studio)
|
import Command.Db (runDbCommand, studio)
|
||||||
import qualified Command.Db.Migrate
|
import qualified Command.Db.Migrate
|
||||||
import Command.Start (start)
|
import Command.Start (start)
|
||||||
import qualified Command.Telemetry as Telemetry
|
import qualified Command.Telemetry as Telemetry
|
||||||
import qualified Util.Terminal as Term
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
let commandCall = case args of
|
let commandCall = case args of
|
||||||
["new", projectName] -> Command.Call.New projectName
|
["new", projectName] -> Command.Call.New projectName
|
||||||
["start"] -> Command.Call.Start
|
["start"] -> Command.Call.Start
|
||||||
["clean"] -> Command.Call.Clean
|
["clean"] -> Command.Call.Clean
|
||||||
["compile"] -> Command.Call.Compile
|
["compile"] -> Command.Call.Compile
|
||||||
("db":dbArgs) -> Command.Call.Db dbArgs
|
("db" : dbArgs) -> Command.Call.Db dbArgs
|
||||||
["version"] -> Command.Call.Version
|
["version"] -> Command.Call.Version
|
||||||
["build"] -> Command.Call.Build
|
["build"] -> Command.Call.Build
|
||||||
["telemetry"] -> Command.Call.Telemetry
|
["telemetry"] -> Command.Call.Telemetry
|
||||||
_ -> Command.Call.Unknown args
|
_ -> Command.Call.Unknown args
|
||||||
|
|
||||||
telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall
|
telemetryThread <- Async.async $ runCommand $ Telemetry.considerSendingData commandCall
|
||||||
|
|
||||||
case commandCall of
|
case commandCall of
|
||||||
Command.Call.New projectName -> runCommand $ createNewProject projectName
|
Command.Call.New projectName -> runCommand $ createNewProject projectName
|
||||||
Command.Call.Start -> runCommand start
|
Command.Call.Start -> runCommand start
|
||||||
Command.Call.Clean -> runCommand clean
|
Command.Call.Clean -> runCommand clean
|
||||||
Command.Call.Compile -> runCommand compile
|
Command.Call.Compile -> runCommand compile
|
||||||
Command.Call.Db dbArgs -> dbCli dbArgs
|
Command.Call.Db dbArgs -> dbCli dbArgs
|
||||||
Command.Call.Version -> printVersion
|
Command.Call.Version -> printVersion
|
||||||
Command.Call.Build -> runCommand build
|
Command.Call.Build -> runCommand build
|
||||||
Command.Call.Telemetry -> runCommand Telemetry.telemetry
|
Command.Call.Telemetry -> runCommand Telemetry.telemetry
|
||||||
Command.Call.Unknown _ -> printUsage
|
Command.Call.Unknown _ -> printUsage
|
||||||
|
|
||||||
-- If sending of telemetry data is still not done 1 second since commmand finished, abort it.
|
-- 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.
|
-- We also make sure here to catch all errors that might get thrown and silence them.
|
||||||
void $ Async.race (threadDelaySeconds 1) (Async.waitCatch telemetryThread)
|
void $ Async.race (threadDelaySeconds 1) (Async.waitCatch telemetryThread)
|
||||||
where
|
where
|
||||||
threadDelaySeconds = let microsecondsInASecond = 1000000
|
threadDelaySeconds =
|
||||||
in threadDelay . (* microsecondsInASecond)
|
let microsecondsInASecond = 1000000
|
||||||
|
in threadDelay . (* microsecondsInASecond)
|
||||||
|
|
||||||
printUsage :: IO ()
|
printUsage :: IO ()
|
||||||
printUsage = putStrLn $ unlines
|
printUsage =
|
||||||
[ title "USAGE"
|
putStrLn $
|
||||||
, " wasp <command> [command-args]"
|
unlines
|
||||||
, ""
|
[ title "USAGE",
|
||||||
, title "COMMANDS"
|
" wasp <command> [command-args]",
|
||||||
, title " GENERAL"
|
"",
|
||||||
, cmd " new <project-name> Creates new Wasp project."
|
title "COMMANDS",
|
||||||
, cmd " version Prints current version of CLI."
|
title " GENERAL",
|
||||||
, title " IN PROJECT"
|
cmd " new <project-name> Creates new Wasp project.",
|
||||||
, cmd " start Runs Wasp app in development mode, watching for file changes."
|
cmd " version Prints current version of CLI.",
|
||||||
, cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info."
|
title " IN PROJECT",
|
||||||
, cmd " clean Deletes all generated code and other cached artifacts. Wasp equivalent of 'have you tried closing and opening it again?'."
|
cmd " start Runs Wasp app in development mode, watching for file changes.",
|
||||||
, cmd " build Generates full web app code, ready for deployment. Use when deploying or ejecting."
|
cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info.",
|
||||||
, cmd " telemetry Prints telemetry status."
|
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.",
|
||||||
, title "EXAMPLES"
|
cmd " telemetry Prints telemetry status.",
|
||||||
, " wasp new MyApp"
|
"",
|
||||||
, " wasp start"
|
title "EXAMPLES",
|
||||||
, " wasp db migrate-dev"
|
" wasp new MyApp",
|
||||||
, ""
|
" wasp start",
|
||||||
, Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs"
|
" wasp db migrate-dev",
|
||||||
, Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
"",
|
||||||
]
|
Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs",
|
||||||
|
Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
||||||
|
]
|
||||||
|
|
||||||
printVersion :: IO ()
|
printVersion :: IO ()
|
||||||
printVersion = putStrLn $ showVersion version
|
printVersion = putStrLn $ showVersion version
|
||||||
@ -86,27 +87,29 @@ printVersion = putStrLn $ showVersion version
|
|||||||
-- TODO(matija): maybe extract to a separate module, e.g. DbCli.hs?
|
-- TODO(matija): maybe extract to a separate module, e.g. DbCli.hs?
|
||||||
dbCli :: [String] -> IO ()
|
dbCli :: [String] -> IO ()
|
||||||
dbCli args = case args of
|
dbCli args = case args of
|
||||||
["migrate-dev"] -> runDbCommand Command.Db.Migrate.migrateDev
|
["migrate-dev"] -> runDbCommand Command.Db.Migrate.migrateDev
|
||||||
["studio"] -> runDbCommand studio
|
["studio"] -> runDbCommand studio
|
||||||
_ -> printDbUsage
|
_ -> printDbUsage
|
||||||
|
|
||||||
printDbUsage :: IO ()
|
printDbUsage :: IO ()
|
||||||
printDbUsage = putStrLn $ unlines
|
printDbUsage =
|
||||||
[ title "USAGE"
|
putStrLn $
|
||||||
, " wasp db <command> [command-args]"
|
unlines
|
||||||
, ""
|
[ title "USAGE",
|
||||||
, title "COMMANDS"
|
" wasp db <command> [command-args]",
|
||||||
, cmd (
|
"",
|
||||||
" migrate-dev Ensures dev database corresponds to the current state of schema(entities):\n" <>
|
title "COMMANDS",
|
||||||
" - Generates a new migration if there are changes in the schema.\n" <>
|
cmd
|
||||||
" - Applies any pending migrations to the database."
|
( " 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"
|
||||||
, cmd " studio GUI for inspecting your database."
|
<> " - Applies any pending migrations to the database."
|
||||||
, ""
|
),
|
||||||
, title "EXAMPLES"
|
cmd " studio GUI for inspecting your database.",
|
||||||
, " wasp db migrate-dev"
|
"",
|
||||||
, " wasp db studio"
|
title "EXAMPLES",
|
||||||
]
|
" wasp db migrate-dev",
|
||||||
|
" wasp db studio"
|
||||||
|
]
|
||||||
|
|
||||||
title :: String -> String
|
title :: String -> String
|
||||||
title = Term.applyStyles [Term.Bold]
|
title = Term.applyStyles [Term.Bold]
|
||||||
@ -118,4 +121,4 @@ mapFirstWord :: (String -> String) -> String -> String
|
|||||||
mapFirstWord f s = beforeFirstWord ++ f firstWord ++ afterFirstWord
|
mapFirstWord f s = beforeFirstWord ++ f firstWord ++ afterFirstWord
|
||||||
where
|
where
|
||||||
(beforeFirstWord, firstWordAndAfter) = span isSpace s
|
(beforeFirstWord, firstWordAndAfter) = span isSpace s
|
||||||
(firstWord, afterFirstWord) = break isSpace firstWordAndAfter
|
(firstWord, afterFirstWord) = break isSpace firstWordAndAfter
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
module Common
|
module Common
|
||||||
( WaspProjectDir
|
( WaspProjectDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
data WaspProjectDir -- Root dir of Wasp project, containing source files.
|
data WaspProjectDir -- Root dir of Wasp project, containing source files.
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module CompileOptions
|
module CompileOptions
|
||||||
( CompileOptions(..)
|
( CompileOptions (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import StrongPath (Path, Abs, Dir)
|
|
||||||
import ExternalCode(SourceExternalCodeDir)
|
|
||||||
|
|
||||||
|
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?
|
-- 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?
|
-- 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!
|
-- Maybe it is, even more than this!
|
||||||
data CompileOptions = CompileOptions
|
data CompileOptions = CompileOptions
|
||||||
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||||
, isBuild :: !Bool
|
isBuild :: !Bool
|
||||||
}
|
}
|
||||||
|
@ -1,13 +1,12 @@
|
|||||||
module Data
|
module Data
|
||||||
( DataDir
|
( DataDir,
|
||||||
, getAbsDataDirPath
|
getAbsDataDirPath,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import StrongPath (Abs, Dir, Path)
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
|
|
||||||
import qualified Paths_waspc
|
import qualified Paths_waspc
|
||||||
|
import StrongPath (Abs, Dir, Path)
|
||||||
|
import qualified StrongPath as SP
|
||||||
|
|
||||||
data DataDir
|
data DataDir
|
||||||
|
|
||||||
|
@ -1,39 +1,40 @@
|
|||||||
module ExternalCode
|
module ExternalCode
|
||||||
( File
|
( File,
|
||||||
, filePathInExtCodeDir
|
filePathInExtCodeDir,
|
||||||
, fileAbsPath
|
fileAbsPath,
|
||||||
, fileText
|
fileText,
|
||||||
, readFiles
|
readFiles,
|
||||||
, SourceExternalCodeDir
|
SourceExternalCodeDir,
|
||||||
) where
|
)
|
||||||
|
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.Maybe (catMaybes)
|
||||||
import Data.Text (Text)
|
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 Path as P
|
||||||
|
import StrongPath (Abs, Dir, Path, Rel, (</>))
|
||||||
import qualified Util.IO
|
|
||||||
import StrongPath (Path, Abs, Rel, Dir, (</>))
|
|
||||||
import qualified StrongPath as SP
|
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.
|
-- | External code directory in Wasp source, from which external code files are read.
|
||||||
data SourceExternalCodeDir
|
data SourceExternalCodeDir
|
||||||
|
|
||||||
data File = File
|
data File = File
|
||||||
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File)
|
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File),
|
||||||
, _extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
_extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||||
, _text :: TextL.Text -- ^ File content. It will throw error when evaluated if file is not textual file.
|
-- | File content. It will throw error when evaluated if file is not textual file.
|
||||||
}
|
_text :: TextL.Text
|
||||||
|
}
|
||||||
|
|
||||||
instance Show File where
|
instance Show File where
|
||||||
show = show . _pathInExtCodeDir
|
show = show . _pathInExtCodeDir
|
||||||
|
|
||||||
instance Eq File where
|
instance Eq File where
|
||||||
f1 == f2 = _pathInExtCodeDir f1 == _pathInExtCodeDir f2
|
f1 == f2 = _pathInExtCodeDir f1 == _pathInExtCodeDir f2
|
||||||
|
|
||||||
-- | Returns path relative to the external code directory.
|
-- | Returns path relative to the external code directory.
|
||||||
filePathInExtCodeDir :: File -> Path (Rel SourceExternalCodeDir) SP.File
|
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.
|
-- except files ignores by the specified waspignore file.
|
||||||
readFiles :: Path Abs (Dir SourceExternalCodeDir) -> IO [File]
|
readFiles :: Path Abs (Dir SourceExternalCodeDir) -> IO [File]
|
||||||
readFiles extCodeDirPath = do
|
readFiles extCodeDirPath = do
|
||||||
let waspignoreFilePath = extCodeDirPath </> waspignorePathInExtCodeDir
|
let waspignoreFilePath = extCodeDirPath </> waspignorePathInExtCodeDir
|
||||||
waspignoreFile <- readWaspignoreFile waspignoreFilePath
|
waspignoreFile <- readWaspignoreFile waspignoreFilePath
|
||||||
relFilePaths <- filter (not . ignores waspignoreFile . SP.toFilePath) .
|
relFilePaths <-
|
||||||
map SP.fromPathRelFile <$>
|
filter (not . ignores waspignoreFile . SP.toFilePath)
|
||||||
Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
. map SP.fromPathRelFile
|
||||||
let absFilePaths = map (extCodeDirPath </>) relFilePaths
|
<$> Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
||||||
-- NOTE: We read text from all the files, regardless if they are text files or not, because
|
let absFilePaths = map (extCodeDirPath </>) relFilePaths
|
||||||
-- we don't know if they are a text file or not.
|
-- NOTE: We read text from all the files, regardless if they are text files or not, because
|
||||||
-- Since we do lazy reading (Text.Lazy), this is not a problem as long as we don't try to use
|
-- we don't know if they are a text file or not.
|
||||||
-- text of a file that is actually not a text file -> then we will get an error when Haskell
|
-- Since we do lazy reading (Text.Lazy), this is not a problem as long as we don't try to use
|
||||||
-- actually tries to read that file.
|
-- text of a file that is actually not a text file -> then we will get an error when Haskell
|
||||||
-- TODO: We are doing lazy IO here, and there is an idea of it being a thing to avoid, due to no
|
-- actually tries to read that file.
|
||||||
-- control over when resources are released and similar.
|
-- TODO: We are doing lazy IO here, and there is an idea of it being a thing to avoid, due to no
|
||||||
-- If we do figure out that this is causing us problems, we could do the following refactoring:
|
-- control over when resources are released and similar.
|
||||||
-- Don't read files at this point, just list them, and Wasp will contain just list of filepaths.
|
-- If we do figure out that this is causing us problems, we could do the following refactoring:
|
||||||
-- Modify TextFileDraft so that it also takes text transformation function (Text -> Text),
|
-- Don't read files at this point, just list them, and Wasp will contain just list of filepaths.
|
||||||
-- or create new file draft that will support that.
|
-- Modify TextFileDraft so that it also takes text transformation function (Text -> Text),
|
||||||
-- In generator, when creating TextFileDraft, give it function/logic for text transformation,
|
-- or create new file draft that will support that.
|
||||||
-- and it will be taken care of when draft will be written to the disk.
|
-- In generator, when creating TextFileDraft, give it function/logic for text transformation,
|
||||||
fileTexts <- catMaybes <$> mapM (tryReadFile . SP.toFilePath) absFilePaths
|
-- and it will be taken care of when draft will be written to the disk.
|
||||||
let files = map (\(path, text) -> File path extCodeDirPath text) (zip relFilePaths fileTexts)
|
fileTexts <- catMaybes <$> mapM (tryReadFile . SP.toFilePath) absFilePaths
|
||||||
return files
|
let files = map (\(path, text) -> File path extCodeDirPath text) (zip relFilePaths fileTexts)
|
||||||
where
|
return files
|
||||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
where
|
||||||
-- but then got deleted before actual reading was invoked.
|
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||||
-- That would make this function crash, so we just ignore those errors.
|
-- but then got deleted before actual reading was invoked.
|
||||||
tryReadFile :: FilePath -> IO (Maybe TextL.Text)
|
-- That would make this function crash, so we just ignore those errors.
|
||||||
tryReadFile fp = (Just <$> TextL.IO.readFile fp) `catch` (\e -> if isDoesNotExistError e
|
tryReadFile :: FilePath -> IO (Maybe TextL.Text)
|
||||||
then return Nothing
|
tryReadFile fp =
|
||||||
else throwIO e)
|
(Just <$> TextL.IO.readFile fp)
|
||||||
|
`catch` ( \e ->
|
||||||
|
if isDoesNotExistError e
|
||||||
|
then return Nothing
|
||||||
|
else throwIO e
|
||||||
|
)
|
||||||
|
@ -1,30 +1,29 @@
|
|||||||
module Generator
|
module Generator
|
||||||
( writeWebAppCode
|
( writeWebAppCode,
|
||||||
, Generator.Setup.setup
|
Generator.Setup.setup,
|
||||||
, Generator.Start.start
|
Generator.Start.start,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import CompileOptions (CompileOptions)
|
||||||
import qualified Data.Text
|
import qualified Data.Text
|
||||||
import qualified Data.Text.IO
|
import qualified Data.Text.IO
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import qualified Data.Version
|
import qualified Data.Version
|
||||||
import qualified Path as P
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Paths_waspc
|
import Generator.DbGenerator (genDb)
|
||||||
|
import Generator.DockerGenerator (genDockerFiles)
|
||||||
import CompileOptions (CompileOptions)
|
import Generator.FileDraft (FileDraft, write)
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.ServerGenerator (genServer)
|
||||||
import Generator.DbGenerator (genDb)
|
|
||||||
import Generator.FileDraft (FileDraft, write)
|
|
||||||
import Generator.ServerGenerator (genServer)
|
|
||||||
import qualified Generator.ServerGenerator as ServerGenerator
|
import qualified Generator.ServerGenerator as ServerGenerator
|
||||||
import Generator.DockerGenerator (genDockerFiles)
|
|
||||||
import qualified Generator.Setup
|
import qualified Generator.Setup
|
||||||
import qualified Generator.Start
|
import qualified Generator.Start
|
||||||
import Generator.WebAppGenerator (generateWebApp)
|
import Generator.WebAppGenerator (generateWebApp)
|
||||||
import StrongPath (Abs, Dir, Path, (</>))
|
import qualified Path as P
|
||||||
import qualified StrongPath as SP
|
import qualified Paths_waspc
|
||||||
import Wasp (Wasp)
|
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.
|
-- | Generates web app code from given Wasp and writes it to given destination directory.
|
||||||
-- If dstDir does not exist yet, it will be created.
|
-- 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?
|
-- from user's machine. Maybe we just overwrite and we are good?
|
||||||
writeWebAppCode :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
writeWebAppCode :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
||||||
writeWebAppCode wasp dstDir compileOptions = do
|
writeWebAppCode wasp dstDir compileOptions = do
|
||||||
writeFileDrafts dstDir (generateWebApp wasp compileOptions)
|
writeFileDrafts dstDir (generateWebApp wasp compileOptions)
|
||||||
ServerGenerator.preCleanup wasp dstDir compileOptions
|
ServerGenerator.preCleanup wasp dstDir compileOptions
|
||||||
writeFileDrafts dstDir (genServer wasp compileOptions)
|
writeFileDrafts dstDir (genServer wasp compileOptions)
|
||||||
writeFileDrafts dstDir (genDb wasp compileOptions)
|
writeFileDrafts dstDir (genDb wasp compileOptions)
|
||||||
writeFileDrafts dstDir (genDockerFiles wasp compileOptions)
|
writeFileDrafts dstDir (genDockerFiles wasp compileOptions)
|
||||||
writeDotWaspInfo dstDir
|
writeDotWaspInfo dstDir
|
||||||
|
|
||||||
-- | Writes file drafts while using given destination dir as root dir.
|
-- | Writes file drafts while using given destination dir as root dir.
|
||||||
-- TODO(martin): We could/should parallelize this.
|
-- 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.
|
-- | Writes .waspinfo, which contains some basic metadata about how/when wasp generated the code.
|
||||||
writeDotWaspInfo :: Path Abs (Dir ProjectRootDir) -> IO ()
|
writeDotWaspInfo :: Path Abs (Dir ProjectRootDir) -> IO ()
|
||||||
writeDotWaspInfo dstDir = do
|
writeDotWaspInfo dstDir = do
|
||||||
currentTime <- getCurrentTime
|
currentTime <- getCurrentTime
|
||||||
let version = Data.Version.showVersion Paths_waspc.version
|
let version = Data.Version.showVersion Paths_waspc.version
|
||||||
let content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ."
|
let content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ."
|
||||||
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
||||||
Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content)
|
Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content)
|
||||||
|
@ -1,8 +1,9 @@
|
|||||||
module Generator.Common
|
module Generator.Common
|
||||||
( ProjectRootDir
|
( ProjectRootDir,
|
||||||
, nodeVersion
|
nodeVersion,
|
||||||
, nodeVersionAsText
|
nodeVersionAsText,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
@ -16,4 +17,5 @@ nodeVersion = (12, 18, 0) -- Latest LTS version.
|
|||||||
|
|
||||||
nodeVersionAsText :: String
|
nodeVersionAsText :: String
|
||||||
nodeVersionAsText = printf "%d.%d.%d" major minor patch
|
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
|
module Generator.DbGenerator
|
||||||
( genDb
|
( genDb,
|
||||||
, dbRootDirInProjectRootDir
|
dbRootDirInProjectRootDir,
|
||||||
, dbSchemaFileInProjectRootDir
|
dbSchemaFileInProjectRootDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import CompileOptions (CompileOptions)
|
||||||
import qualified Path as P
|
import Data.Aeson (object, (.=))
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Generator.Common (ProjectRootDir)
|
||||||
import CompileOptions (CompileOptions)
|
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Templates (TemplatesDir)
|
||||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
import qualified Path as P
|
||||||
import Generator.Templates (TemplatesDir)
|
|
||||||
import qualified Psl.Ast.Model
|
import qualified Psl.Ast.Model
|
||||||
import qualified Psl.Generator.Model
|
import qualified Psl.Generator.Model
|
||||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||||
import qualified StrongPath as SP
|
import qualified StrongPath as SP
|
||||||
import Wasp (Wasp)
|
import Wasp (Wasp)
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
import qualified Wasp.Db
|
import qualified Wasp.Db
|
||||||
import Wasp.Entity (Entity)
|
import Wasp.Entity (Entity)
|
||||||
import qualified Wasp.Entity
|
import qualified Wasp.Entity
|
||||||
|
|
||||||
-- * Path definitions
|
-- * Path definitions
|
||||||
|
|
||||||
data DbRootDir
|
data DbRootDir
|
||||||
|
|
||||||
data DbTemplatesDir
|
data DbTemplatesDir
|
||||||
|
|
||||||
dbRootDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir DbRootDir)
|
dbRootDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir DbRootDir)
|
||||||
@ -48,29 +49,32 @@ dbSchemaFileInProjectRootDir = dbRootDirInProjectRootDir </> dbSchemaFileInDbRoo
|
|||||||
|
|
||||||
genDb :: Wasp -> CompileOptions -> [FileDraft]
|
genDb :: Wasp -> CompileOptions -> [FileDraft]
|
||||||
genDb wasp _ =
|
genDb wasp _ =
|
||||||
[ genPrismaSchema wasp
|
[ genPrismaSchema wasp
|
||||||
]
|
]
|
||||||
|
|
||||||
genPrismaSchema :: Wasp -> FileDraft
|
genPrismaSchema :: Wasp -> FileDraft
|
||||||
genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templateData)
|
genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templateData)
|
||||||
where
|
where
|
||||||
dstPath = dbSchemaFileInProjectRootDir
|
dstPath = dbSchemaFileInProjectRootDir
|
||||||
tmplSrcPath = dbTemplatesDirInTemplatesDir </> dbSchemaFileInDbTemplatesDir
|
tmplSrcPath = dbTemplatesDirInTemplatesDir </> dbSchemaFileInDbTemplatesDir
|
||||||
|
|
||||||
templateData = object
|
templateData =
|
||||||
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp)
|
object
|
||||||
, "datasourceProvider" .= (datasourceProvider :: String)
|
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp),
|
||||||
, "datasourceUrl" .= (datasourceUrl :: String)
|
"datasourceProvider" .= (datasourceProvider :: String),
|
||||||
]
|
"datasourceUrl" .= (datasourceUrl :: String)
|
||||||
|
]
|
||||||
|
|
||||||
dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp
|
dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp
|
||||||
(datasourceProvider, datasourceUrl) = case dbSystem of
|
(datasourceProvider, datasourceUrl) = case dbSystem of
|
||||||
Wasp.Db.PostgreSQL -> ("postgresql", "env(\"DATABASE_URL\")")
|
Wasp.Db.PostgreSQL -> ("postgresql", "env(\"DATABASE_URL\")")
|
||||||
-- TODO: Report this error with some better mechanism, not `error`.
|
-- TODO: Report this error with some better mechanism, not `error`.
|
||||||
Wasp.Db.SQLite -> if Wasp.getIsBuild wasp
|
Wasp.Db.SQLite ->
|
||||||
then error "SQLite is not supported in production. Set db.system to smth else."
|
if Wasp.getIsBuild wasp
|
||||||
else ("sqlite", "\"file:./dev.db\"")
|
then error "SQLite is not supported in production. Set db.system to smth else."
|
||||||
|
else ("sqlite", "\"file:./dev.db\"")
|
||||||
|
|
||||||
entityToPslModelSchema :: Entity -> String
|
entityToPslModelSchema :: Entity -> String
|
||||||
entityToPslModelSchema entity = Psl.Generator.Model.generateModel $
|
entityToPslModelSchema entity =
|
||||||
Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody 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
|
module Generator.DbGenerator.Jobs
|
||||||
( migrateDev
|
( migrateDev,
|
||||||
, runStudio
|
runStudio,
|
||||||
) where
|
)
|
||||||
|
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)
|
|
||||||
|
|
||||||
|
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 :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
migrateDev projectDir = do
|
migrateDev projectDir = do
|
||||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||||
|
|
||||||
-- NOTE(matija): We are running this command from server's root dir since that is where
|
-- NOTE(matija): We are running this command from server's root dir since that is where
|
||||||
-- Prisma packages (cli and client) are currently installed.
|
-- Prisma packages (cli and client) are currently installed.
|
||||||
runNodeCommandAsJob serverDir "npx"
|
runNodeCommandAsJob
|
||||||
[ "prisma", "migrate", "dev"
|
serverDir
|
||||||
, "--schema", SP.toFilePath schemaFile
|
"npx"
|
||||||
] J.Db
|
[ "prisma",
|
||||||
|
"migrate",
|
||||||
|
"dev",
|
||||||
|
"--schema",
|
||||||
|
SP.toFilePath schemaFile
|
||||||
|
]
|
||||||
|
J.Db
|
||||||
|
|
||||||
-- | Runs `prisma studio` - Prisma's db inspector.
|
-- | Runs `prisma studio` - Prisma's db inspector.
|
||||||
runStudio :: Path Abs (Dir ProjectRootDir) -> J.Job
|
runStudio :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
runStudio projectDir = do
|
runStudio projectDir = do
|
||||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||||
|
|
||||||
runNodeCommandAsJob serverDir "npx"
|
runNodeCommandAsJob
|
||||||
[ "prisma", "studio"
|
serverDir
|
||||||
, "--schema", SP.toFilePath schemaFile
|
"npx"
|
||||||
] J.Db
|
[ "prisma",
|
||||||
|
"studio",
|
||||||
|
"--schema",
|
||||||
|
SP.toFilePath schemaFile
|
||||||
|
]
|
||||||
|
J.Db
|
||||||
|
@ -1,30 +1,32 @@
|
|||||||
module Generator.DbGenerator.Operations
|
module Generator.DbGenerator.Operations
|
||||||
( migrateDev
|
( migrateDev,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Concurrent (Chan, newChan, readChan)
|
import Control.Concurrent (Chan, newChan, readChan)
|
||||||
import Control.Concurrent.Async (concurrently)
|
import Control.Concurrent.Async (concurrently)
|
||||||
import System.Exit (ExitCode (..))
|
|
||||||
|
|
||||||
import StrongPath (Abs, Dir, Path)
|
|
||||||
import Generator.Common (ProjectRootDir)
|
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 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 JobMessage -> IO ()
|
||||||
printJobMsgsUntilExitReceived chan = do
|
printJobMsgsUntilExitReceived chan = do
|
||||||
jobMsg <- readChan chan
|
jobMsg <- readChan chan
|
||||||
case J._data jobMsg of
|
case J._data jobMsg of
|
||||||
J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan
|
J.JobOutput {} -> printJobMessage jobMsg >> printJobMsgsUntilExitReceived chan
|
||||||
J.JobExit {} -> return ()
|
J.JobExit {} -> return ()
|
||||||
|
|
||||||
migrateDev :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
migrateDev :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||||
migrateDev projectDir = do
|
migrateDev projectDir = do
|
||||||
chan <- newChan
|
chan <- newChan
|
||||||
(_, dbExitCode) <- concurrently (printJobMsgsUntilExitReceived chan)
|
(_, dbExitCode) <-
|
||||||
(DbJobs.migrateDev projectDir chan)
|
concurrently
|
||||||
case dbExitCode of
|
(printJobMsgsUntilExitReceived chan)
|
||||||
ExitSuccess -> return (Right ())
|
(DbJobs.migrateDev projectDir chan)
|
||||||
ExitFailure code -> return $ Left $ "Migrate (dev) failed with exit code: " ++ show code
|
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
|
module Generator.DockerGenerator
|
||||||
( genDockerFiles
|
( genDockerFiles,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import CompileOptions (CompileOptions)
|
||||||
import qualified Path as P
|
import Data.Aeson (object, (.=))
|
||||||
import StrongPath (File, Path, Rel)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified StrongPath as SP
|
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||||
|
import Generator.Templates (TemplatesDir)
|
||||||
import CompileOptions (CompileOptions)
|
import qualified Path as P
|
||||||
import Generator.Common (ProjectRootDir)
|
import StrongPath (File, Path, Rel)
|
||||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
import qualified StrongPath as SP
|
||||||
import Generator.Templates (TemplatesDir)
|
import Wasp (Wasp)
|
||||||
import Wasp (Wasp)
|
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
|
|
||||||
genDockerFiles :: Wasp -> CompileOptions -> [FileDraft]
|
genDockerFiles :: Wasp -> CompileOptions -> [FileDraft]
|
||||||
genDockerFiles wasp _ = concat
|
genDockerFiles wasp _ =
|
||||||
[ [genDockerfile wasp]
|
concat
|
||||||
, [genDockerignore wasp]
|
[ [genDockerfile wasp],
|
||||||
|
[genDockerignore wasp]
|
||||||
]
|
]
|
||||||
|
|
||||||
-- TODO: Inject paths to server and db files/dirs, right now they are hardcoded in the templates.
|
-- TODO: Inject paths to server and db files/dirs, right now they are hardcoded in the templates.
|
||||||
genDockerfile :: Wasp -> FileDraft
|
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 ProjectRootDir) File)
|
||||||
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel TemplatesDir) File)
|
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel TemplatesDir) File)
|
||||||
(Just $ object
|
( Just $
|
||||||
[ "usingPrisma" .= not (null $ Wasp.getPSLEntities wasp)
|
object
|
||||||
])
|
[ "usingPrisma" .= not (null $ Wasp.getPSLEntities wasp)
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
genDockerignore :: Wasp -> FileDraft
|
genDockerignore :: Wasp -> FileDraft
|
||||||
genDockerignore _ = createTemplateFileDraft
|
genDockerignore _ =
|
||||||
|
createTemplateFileDraft
|
||||||
(SP.fromPathRelFile [P.relfile|.dockerignore|] :: Path (Rel ProjectRootDir) File)
|
(SP.fromPathRelFile [P.relfile|.dockerignore|] :: Path (Rel ProjectRootDir) File)
|
||||||
(SP.fromPathRelFile [P.relfile|dockerignore|] :: Path (Rel TemplatesDir) File)
|
(SP.fromPathRelFile [P.relfile|dockerignore|] :: Path (Rel TemplatesDir) File)
|
||||||
Nothing
|
Nothing
|
||||||
|
@ -1,39 +1,38 @@
|
|||||||
module Generator.ExternalCodeGenerator
|
module Generator.ExternalCodeGenerator
|
||||||
( generateExternalCodeDir
|
( generateExternalCodeDir,
|
||||||
) where
|
)
|
||||||
|
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 ExternalCode as EC
|
||||||
import qualified Generator.FileDraft as FD
|
|
||||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
import qualified Generator.ExternalCodeGenerator.Common as C
|
||||||
import Generator.ExternalCodeGenerator.Js (generateJsFile)
|
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.
|
-- | 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.
|
-- It might not just copy them but also do some changes on them, as needed.
|
||||||
generateExternalCodeDir :: C.ExternalCodeGeneratorStrategy
|
generateExternalCodeDir ::
|
||||||
-> Wasp
|
C.ExternalCodeGeneratorStrategy ->
|
||||||
-> [FD.FileDraft]
|
Wasp ->
|
||||||
|
[FD.FileDraft]
|
||||||
generateExternalCodeDir strategy wasp =
|
generateExternalCodeDir strategy wasp =
|
||||||
map (generateFile strategy) (Wasp.getExternalCodeFiles wasp)
|
map (generateFile strategy) (Wasp.getExternalCodeFiles wasp)
|
||||||
|
|
||||||
generateFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
generateFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||||
generateFile strategy file
|
generateFile strategy file
|
||||||
| extension `elem` [".js", ".jsx"] = generateJsFile strategy file
|
| extension `elem` [".js", ".jsx"] = generateJsFile strategy file
|
||||||
| otherwise = let relDstPath = (C._extCodeDirInProjectRootDir strategy)
|
| otherwise =
|
||||||
</> dstPathInGenExtCodeDir
|
let relDstPath =
|
||||||
absSrcPath = EC.fileAbsPath file
|
(C._extCodeDirInProjectRootDir strategy)
|
||||||
in FD.createCopyFileDraft relDstPath absSrcPath
|
</> dstPathInGenExtCodeDir
|
||||||
|
absSrcPath = EC.fileAbsPath file
|
||||||
|
in FD.createCopyFileDraft relDstPath absSrcPath
|
||||||
where
|
where
|
||||||
dstPathInGenExtCodeDir :: Path (Rel C.GeneratedExternalCodeDir) File
|
dstPathInGenExtCodeDir :: Path (Rel C.GeneratedExternalCodeDir) File
|
||||||
dstPathInGenExtCodeDir = C.castRelPathFromSrcToGenExtCodeDir $ EC.filePathInExtCodeDir file
|
dstPathInGenExtCodeDir = C.castRelPathFromSrcToGenExtCodeDir $ EC.filePathInExtCodeDir file
|
||||||
|
|
||||||
extension = FP.takeExtension $ SP.toFilePath $ EC.filePathInExtCodeDir file
|
extension = FP.takeExtension $ SP.toFilePath $ EC.filePathInExtCodeDir file
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,17 +1,17 @@
|
|||||||
module Generator.ExternalCodeGenerator.Common
|
module Generator.ExternalCodeGenerator.Common
|
||||||
( ExternalCodeGeneratorStrategy(..)
|
( ExternalCodeGeneratorStrategy (..),
|
||||||
, GeneratedExternalCodeDir
|
GeneratedExternalCodeDir,
|
||||||
, castRelPathFromSrcToGenExtCodeDir
|
castRelPathFromSrcToGenExtCodeDir,
|
||||||
, asGenExtFile
|
asGenExtFile,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Text (Text)
|
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 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.
|
-- | Path to the directory where ext code will be generated.
|
||||||
data GeneratedExternalCodeDir
|
data GeneratedExternalCodeDir
|
||||||
@ -23,9 +23,9 @@ castRelPathFromSrcToGenExtCodeDir :: Path (Rel SourceExternalCodeDir) a -> Path
|
|||||||
castRelPathFromSrcToGenExtCodeDir = SP.castRel
|
castRelPathFromSrcToGenExtCodeDir = SP.castRel
|
||||||
|
|
||||||
data ExternalCodeGeneratorStrategy = ExternalCodeGeneratorStrategy
|
data ExternalCodeGeneratorStrategy = ExternalCodeGeneratorStrategy
|
||||||
{ -- | Takes a path where the external code js file will be generated.
|
{ -- | 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
|
-- Also takes text of the file. Returns text where special @wasp imports have been replaced with
|
||||||
-- imports that will work.
|
-- imports that will work.
|
||||||
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text
|
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text,
|
||||||
, _extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
_extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
||||||
}
|
}
|
||||||
|
@ -1,20 +1,19 @@
|
|||||||
module Generator.ExternalCodeGenerator.Js
|
module Generator.ExternalCodeGenerator.Js
|
||||||
( generateJsFile
|
( generateJsFile,
|
||||||
, resolveJsFileWaspImportsForExtCodeDir
|
resolveJsFileWaspImportsForExtCodeDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Text.Regex.TDFA as TR
|
|
||||||
import Data.Text (Text, unpack)
|
import Data.Text (Text, unpack)
|
||||||
|
import qualified Data.Text as T
|
||||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
import Path.Extra (reversePosixPath, toPosixFilePath)
|
|
||||||
import qualified Generator.FileDraft as FD
|
|
||||||
import qualified ExternalCode as EC
|
import qualified ExternalCode as EC
|
||||||
import Generator.ExternalCodeGenerator.Common (GeneratedExternalCodeDir)
|
import Generator.ExternalCodeGenerator.Common (GeneratedExternalCodeDir)
|
||||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
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 :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||||
generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
||||||
@ -29,14 +28,18 @@ generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
|||||||
dstPath = (C._extCodeDirInProjectRootDir strategy) </> filePathInGenExtCodeDir
|
dstPath = (C._extCodeDirInProjectRootDir strategy) </> filePathInGenExtCodeDir
|
||||||
|
|
||||||
-- | Replaces imports that start with "@wasp/" with imports that start from the src dir of the app.
|
-- | Replaces imports that start with "@wasp/" with imports that start from the src dir of the app.
|
||||||
resolveJsFileWaspImportsForExtCodeDir
|
resolveJsFileWaspImportsForExtCodeDir ::
|
||||||
:: Path (Rel ()) (Dir GeneratedExternalCodeDir) -- ^ Relative path of ext code dir in src dir of app (web app, server (app), ...)
|
-- | 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.
|
Path (Rel ()) (Dir GeneratedExternalCodeDir) ->
|
||||||
-> Text -- ^ Original text of the file.
|
-- | Path where this JS file will be generated.
|
||||||
-> Text -- ^ Text of the file with special "@wasp" imports resolved (replaced with normal JS imports).
|
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 =
|
resolveJsFileWaspImportsForExtCodeDir extCodeDirInAppSrcDir jsFileDstPathInExtCodeDir jsFileText =
|
||||||
let matches = concat (unpack jsFileText TR.=~ ("(from +['\"]@wasp/)" :: String) :: [[String]])
|
let matches = concat (unpack jsFileText TR.=~ ("(from +['\"]@wasp/)" :: String) :: [[String]])
|
||||||
in foldr replaceFromWasp jsFileText matches
|
in foldr replaceFromWasp jsFileText matches
|
||||||
where
|
where
|
||||||
replaceFromWasp fromWasp = T.replace (T.pack fromWasp) (T.pack $ transformFromWasp fromWasp)
|
replaceFromWasp fromWasp = T.replace (T.pack fromWasp) (T.pack $ transformFromWasp fromWasp)
|
||||||
transformFromWasp fromWasp = (reverse $ drop (length ("@wasp/" :: String)) $ reverse fromWasp) ++ pathPrefix ++ "/"
|
transformFromWasp fromWasp = (reverse $ drop (length ("@wasp/" :: String)) $ reverse fromWasp) ++ pathPrefix ++ "/"
|
||||||
|
@ -1,65 +1,68 @@
|
|||||||
module Generator.FileDraft
|
module Generator.FileDraft
|
||||||
( FileDraft(..)
|
( FileDraft (..),
|
||||||
, Writeable(..)
|
Writeable (..),
|
||||||
, createTemplateFileDraft
|
createTemplateFileDraft,
|
||||||
, createCopyFileDraft
|
createCopyFileDraft,
|
||||||
, createCopyFileDraftIfExists
|
createCopyFileDraftIfExists,
|
||||||
, createTextFileDraft
|
createTextFileDraft,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import StrongPath (Path, Abs, Rel, File)
|
|
||||||
import Generator.Templates (TemplatesDir)
|
|
||||||
import Generator.Common (ProjectRootDir)
|
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.CopyFileDraft as CopyFD
|
||||||
|
import qualified Generator.FileDraft.TemplateFileDraft as TmplFD
|
||||||
import qualified Generator.FileDraft.TextFileDraft as TextFD
|
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,
|
-- | FileDraft unites different file draft types into a single type,
|
||||||
-- so that in the rest of the system they can be passed around as heterogeneous
|
-- so that in the rest of the system they can be passed around as heterogeneous
|
||||||
-- collection when needed.
|
-- collection when needed.
|
||||||
data FileDraft
|
data FileDraft
|
||||||
= FileDraftTemplateFd TmplFD.TemplateFileDraft
|
= FileDraftTemplateFd TmplFD.TemplateFileDraft
|
||||||
| FileDraftCopyFd CopyFD.CopyFileDraft
|
| FileDraftCopyFd CopyFD.CopyFileDraft
|
||||||
| FileDraftTextFd TextFD.TextFileDraft
|
| FileDraftTextFd TextFD.TextFileDraft
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance Writeable FileDraft where
|
instance Writeable FileDraft where
|
||||||
write dstDir (FileDraftTemplateFd draft) = write dstDir draft
|
write dstDir (FileDraftTemplateFd draft) = write dstDir draft
|
||||||
write dstDir (FileDraftCopyFd draft) = write dstDir draft
|
write dstDir (FileDraftCopyFd draft) = write dstDir draft
|
||||||
write dstDir (FileDraftTextFd draft) = write dstDir draft
|
write dstDir (FileDraftTextFd draft) = write dstDir draft
|
||||||
|
|
||||||
|
createTemplateFileDraft ::
|
||||||
createTemplateFileDraft :: Path (Rel ProjectRootDir) File
|
Path (Rel ProjectRootDir) File ->
|
||||||
-> Path (Rel TemplatesDir) File
|
Path (Rel TemplatesDir) File ->
|
||||||
-> Maybe Aeson.Value
|
Maybe Aeson.Value ->
|
||||||
-> FileDraft
|
FileDraft
|
||||||
createTemplateFileDraft dstPath tmplSrcPath tmplData =
|
createTemplateFileDraft dstPath tmplSrcPath tmplData =
|
||||||
FileDraftTemplateFd $ TmplFD.TemplateFileDraft { TmplFD._dstPath = dstPath
|
FileDraftTemplateFd $
|
||||||
, TmplFD._srcPathInTmplDir = tmplSrcPath
|
TmplFD.TemplateFileDraft
|
||||||
, TmplFD._tmplData = tmplData
|
{ TmplFD._dstPath = dstPath,
|
||||||
}
|
TmplFD._srcPathInTmplDir = tmplSrcPath,
|
||||||
|
TmplFD._tmplData = tmplData
|
||||||
|
}
|
||||||
|
|
||||||
createCopyFileDraft :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
createCopyFileDraft :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||||
createCopyFileDraft dstPath srcPath =
|
createCopyFileDraft dstPath srcPath =
|
||||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
FileDraftCopyFd $
|
||||||
{ CopyFD._dstPath = dstPath
|
CopyFD.CopyFileDraft
|
||||||
, CopyFD._srcPath = srcPath
|
{ CopyFD._dstPath = dstPath,
|
||||||
, CopyFD._failIfSrcDoesNotExist = True
|
CopyFD._srcPath = srcPath,
|
||||||
}
|
CopyFD._failIfSrcDoesNotExist = True
|
||||||
|
}
|
||||||
|
|
||||||
createCopyFileDraftIfExists :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
createCopyFileDraftIfExists :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||||
createCopyFileDraftIfExists dstPath srcPath =
|
createCopyFileDraftIfExists dstPath srcPath =
|
||||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
FileDraftCopyFd $
|
||||||
{ CopyFD._dstPath = dstPath
|
CopyFD.CopyFileDraft
|
||||||
, CopyFD._srcPath = srcPath
|
{ CopyFD._dstPath = dstPath,
|
||||||
, CopyFD._failIfSrcDoesNotExist = False
|
CopyFD._srcPath = srcPath,
|
||||||
}
|
CopyFD._failIfSrcDoesNotExist = False
|
||||||
|
}
|
||||||
|
|
||||||
createTextFileDraft :: Path (Rel ProjectRootDir) File -> Text -> FileDraft
|
createTextFileDraft :: Path (Rel ProjectRootDir) File -> Text -> FileDraft
|
||||||
createTextFileDraft dstPath content =
|
createTextFileDraft dstPath content =
|
||||||
FileDraftTextFd $ TextFD.TextFileDraft { TextFD._dstPath = dstPath, TextFD._content = content}
|
FileDraftTextFd $ TextFD.TextFileDraft {TextFD._dstPath = dstPath, TextFD._content = content}
|
||||||
|
@ -1,44 +1,49 @@
|
|||||||
module Generator.FileDraft.CopyFileDraft
|
module Generator.FileDraft.CopyFileDraft
|
||||||
( CopyFileDraft(..)
|
( CopyFileDraft (..),
|
||||||
) where
|
)
|
||||||
|
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
|
|
||||||
|
|
||||||
|
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.
|
-- | File draft based purely on another file, that is just copied.
|
||||||
data CopyFileDraft = CopyFileDraft
|
data CopyFileDraft = CopyFileDraft
|
||||||
{ -- | Path where the file will be copied to.
|
{ -- | Path where the file will be copied to.
|
||||||
_dstPath :: !(Path (Rel ProjectRootDir) File)
|
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||||
-- | Absolute path of source file to copy.
|
-- | Absolute path of source file to copy.
|
||||||
, _srcPath :: !(Path Abs File)
|
_srcPath :: !(Path Abs File),
|
||||||
, _failIfSrcDoesNotExist :: Bool
|
_failIfSrcDoesNotExist :: Bool
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance Writeable CopyFileDraft where
|
instance Writeable CopyFileDraft where
|
||||||
write absDstDirPath draft = do
|
write absDstDirPath draft = do
|
||||||
srcFileExists <- doesFileExist srcFilePath
|
srcFileExists <- doesFileExist srcFilePath
|
||||||
if srcFileExists
|
if srcFileExists
|
||||||
then do
|
then do
|
||||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||||
copyFile srcFilePath (SP.toFilePath absDraftDstPath)
|
copyFile srcFilePath (SP.toFilePath absDraftDstPath)
|
||||||
else
|
else
|
||||||
when
|
when
|
||||||
(_failIfSrcDoesNotExist draft)
|
(_failIfSrcDoesNotExist draft)
|
||||||
(throwIO $ mkIOError
|
( throwIO $
|
||||||
doesNotExistErrorType
|
mkIOError
|
||||||
"Source file of CopyFileDraft does not exist."
|
doesNotExistErrorType
|
||||||
Nothing
|
"Source file of CopyFileDraft does not exist."
|
||||||
(Just srcFilePath)
|
Nothing
|
||||||
)
|
(Just srcFilePath)
|
||||||
where
|
)
|
||||||
srcFilePath = SP.toFilePath $ _srcPath draft
|
where
|
||||||
absDraftDstPath = absDstDirPath </> _dstPath draft
|
srcFilePath = SP.toFilePath $ _srcPath draft
|
||||||
|
absDraftDstPath = absDstDirPath </> _dstPath draft
|
||||||
|
@ -1,34 +1,37 @@
|
|||||||
module Generator.FileDraft.TemplateFileDraft
|
module Generator.FileDraft.TemplateFileDraft
|
||||||
( TemplateFileDraft(..)
|
( TemplateFileDraft (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
|
|
||||||
import StrongPath (Path, Abs, Rel, File, (</>))
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import Generator.FileDraft.Writeable
|
import Generator.FileDraft.Writeable
|
||||||
import Generator.FileDraft.WriteableMonad
|
import Generator.FileDraft.WriteableMonad
|
||||||
import Generator.Templates (TemplatesDir)
|
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.
|
-- | File draft based on template file that gets combined with data.
|
||||||
data TemplateFileDraft = TemplateFileDraft
|
data TemplateFileDraft = TemplateFileDraft
|
||||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
{ -- | Path where file will be generated.
|
||||||
, _srcPathInTmplDir :: !(Path (Rel TemplatesDir) File) -- ^ Path of template source file.
|
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||||
, _tmplData :: Maybe Aeson.Value -- ^ Data to be fed to the template while rendering it.
|
-- | Path of template source file.
|
||||||
}
|
_srcPathInTmplDir :: !(Path (Rel TemplatesDir) File),
|
||||||
deriving (Show, Eq)
|
-- | Data to be fed to the template while rendering it.
|
||||||
|
_tmplData :: Maybe Aeson.Value
|
||||||
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance Writeable TemplateFileDraft where
|
instance Writeable TemplateFileDraft where
|
||||||
write absDstDirPath draft = do
|
write absDstDirPath draft = do
|
||||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||||
case _tmplData draft of
|
case _tmplData draft of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
absDraftSrcPath <- getTemplateFileAbsPath (_srcPathInTmplDir draft)
|
absDraftSrcPath <- getTemplateFileAbsPath (_srcPathInTmplDir draft)
|
||||||
copyFile (SP.toFilePath absDraftSrcPath) (SP.toFilePath absDraftDstPath)
|
copyFile (SP.toFilePath absDraftSrcPath) (SP.toFilePath absDraftDstPath)
|
||||||
Just tmplData -> do
|
Just tmplData -> do
|
||||||
content <- compileAndRenderTemplate (_srcPathInTmplDir draft) tmplData
|
content <- compileAndRenderTemplate (_srcPathInTmplDir draft) tmplData
|
||||||
writeFileFromText (SP.toFilePath absDraftDstPath) content
|
writeFileFromText (SP.toFilePath absDraftDstPath) content
|
||||||
where
|
where
|
||||||
absDraftDstPath :: Path Abs File
|
absDraftDstPath :: Path Abs File
|
||||||
absDraftDstPath = absDstDirPath </> (_dstPath draft)
|
absDraftDstPath = absDstDirPath </> (_dstPath draft)
|
||||||
|
@ -1,26 +1,26 @@
|
|||||||
module Generator.FileDraft.TextFileDraft
|
module Generator.FileDraft.TextFileDraft
|
||||||
( TextFileDraft(..)
|
( TextFileDraft (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import StrongPath (Path, Rel, File, (</>))
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import Generator.FileDraft.Writeable
|
import Generator.FileDraft.Writeable
|
||||||
import Generator.FileDraft.WriteableMonad
|
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.
|
-- | File draft based on text, that is to be written to file when time comes.
|
||||||
data TextFileDraft = TextFileDraft
|
data TextFileDraft = TextFileDraft
|
||||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
{ -- | Path where file will be generated.
|
||||||
, _content :: Text
|
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||||
}
|
_content :: Text
|
||||||
deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance Writeable TextFileDraft where
|
instance Writeable TextFileDraft where
|
||||||
write dstDir draft = do
|
write dstDir draft = do
|
||||||
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
createDirectoryIfMissing True (SP.toFilePath $ SP.parent absDraftDstPath)
|
||||||
writeFileFromText (SP.toFilePath absDraftDstPath) (_content draft)
|
writeFileFromText (SP.toFilePath absDraftDstPath) (_content draft)
|
||||||
where
|
where
|
||||||
absDraftDstPath = dstDir </> (_dstPath draft)
|
absDraftDstPath = dstDir </> (_dstPath draft)
|
||||||
|
@ -1,15 +1,16 @@
|
|||||||
module Generator.FileDraft.Writeable
|
module Generator.FileDraft.Writeable
|
||||||
( Writeable(..)
|
( Writeable (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import StrongPath (Path, Abs, Dir)
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import Generator.FileDraft.WriteableMonad
|
import Generator.FileDraft.WriteableMonad
|
||||||
|
import StrongPath (Abs, Dir, Path)
|
||||||
|
|
||||||
class Writeable w where
|
class Writeable w where
|
||||||
-- | Write file somewhere in the provided project root directory.
|
-- | Write file somewhere in the provided project root directory.
|
||||||
write :: (WriteableMonad m)
|
write ::
|
||||||
=> Path Abs (Dir ProjectRootDir)
|
(WriteableMonad m) =>
|
||||||
-> w
|
Path Abs (Dir ProjectRootDir) ->
|
||||||
-> m ()
|
w ->
|
||||||
|
m ()
|
||||||
|
@ -1,67 +1,77 @@
|
|||||||
module Generator.FileDraft.WriteableMonad
|
module Generator.FileDraft.WriteableMonad
|
||||||
( WriteableMonad(..)
|
( WriteableMonad (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Monad.IO.Class (MonadIO)
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
import Data.Aeson as Aeson
|
import Data.Aeson as Aeson
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text.IO
|
import qualified Data.Text.IO
|
||||||
|
import qualified Generator.Templates as Templates
|
||||||
|
import StrongPath (Abs, Dir, File, Path, Rel)
|
||||||
import qualified System.Directory
|
import qualified System.Directory
|
||||||
import System.IO.Error (isDoesNotExistError)
|
import System.IO.Error (isDoesNotExistError)
|
||||||
import UnliftIO.Exception (Exception, catch)
|
import UnliftIO.Exception (Exception, catch)
|
||||||
import qualified UnliftIO.Exception as E
|
import qualified UnliftIO.Exception as E
|
||||||
|
|
||||||
import qualified Generator.Templates as Templates
|
|
||||||
import StrongPath (Abs, Dir, File, Path, Rel)
|
|
||||||
|
|
||||||
|
|
||||||
-- TODO: Should we use DI via data instead of typeclasses?
|
-- TODO: Should we use DI via data instead of typeclasses?
|
||||||
-- https://news.ycombinator.com/item?id=10392044
|
-- https://news.ycombinator.com/item?id=10392044
|
||||||
|
|
||||||
-- | Describes effects needed by File Drafts.
|
-- | Describes effects needed by File Drafts.
|
||||||
class (MonadIO m) => WriteableMonad m where
|
class (MonadIO m) => WriteableMonad m where
|
||||||
createDirectoryIfMissing
|
createDirectoryIfMissing ::
|
||||||
:: Bool -- ^ True if parents should also be created.
|
-- | True if parents should also be created.
|
||||||
-> FilePath -- ^ Path to the directory to create.
|
Bool ->
|
||||||
-> m ()
|
-- | Path to the directory to create.
|
||||||
|
FilePath ->
|
||||||
|
m ()
|
||||||
|
|
||||||
copyFile
|
copyFile ::
|
||||||
:: FilePath -- ^ Src path.
|
-- | Src path.
|
||||||
-> FilePath -- ^ Dst path.
|
FilePath ->
|
||||||
-> m ()
|
-- | Dst path.
|
||||||
|
FilePath ->
|
||||||
|
m ()
|
||||||
|
|
||||||
doesFileExist :: FilePath -> m Bool
|
doesFileExist :: FilePath -> m Bool
|
||||||
|
|
||||||
writeFileFromText :: FilePath -> Text -> m ()
|
writeFileFromText :: FilePath -> Text -> m ()
|
||||||
|
|
||||||
getTemplateFileAbsPath
|
getTemplateFileAbsPath ::
|
||||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
-- | Template file path.
|
||||||
-> m (Path Abs File)
|
Path (Rel Templates.TemplatesDir) File ->
|
||||||
|
m (Path Abs File)
|
||||||
|
|
||||||
getTemplatesDirAbsPath :: m (Path Abs (Dir Templates.TemplatesDir))
|
getTemplatesDirAbsPath :: m (Path Abs (Dir Templates.TemplatesDir))
|
||||||
|
|
||||||
compileAndRenderTemplate
|
compileAndRenderTemplate ::
|
||||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
-- | Template file path.
|
||||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
Path (Rel Templates.TemplatesDir) File ->
|
||||||
-> m Text
|
-- | 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
|
instance WriteableMonad IO where
|
||||||
createDirectoryIfMissing = System.Directory.createDirectoryIfMissing
|
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)
|
|
||||||
|
|
||||||
doesFileExist = System.Directory.doesFileExist
|
-- TODO(matija): we should rename this function to make it clear it won't throw an exception when
|
||||||
writeFileFromText = Data.Text.IO.writeFile
|
-- a file does not exist.
|
||||||
getTemplateFileAbsPath = Templates.getTemplateFileAbsPath
|
copyFile src dst = do
|
||||||
getTemplatesDirAbsPath = Templates.getTemplatesDirAbsPath
|
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||||
compileAndRenderTemplate = Templates.compileAndRenderTemplate
|
-- when the filedraft was created but then got deleted before actual copying was invoked.
|
||||||
throwIO = E.throwIO
|
-- 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
|
module Generator.Job
|
||||||
( Job
|
( Job,
|
||||||
, JobMessage (..)
|
JobMessage (..),
|
||||||
, JobMessageData (..)
|
JobMessageData (..),
|
||||||
, JobOutputType (..)
|
JobOutputType (..),
|
||||||
, JobType (..)
|
JobType (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Control.Concurrent (Chan)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import System.Exit (ExitCode)
|
|
||||||
|
|
||||||
|
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
|
-- | Job is an IO action that communicates progress by writing messages to given channel
|
||||||
-- until it is done, when it returns exit code.
|
-- until it is done, when it returns exit code.
|
||||||
type Job = Chan JobMessage -> IO ExitCode
|
type Job = Chan JobMessage -> IO ExitCode
|
||||||
|
|
||||||
data JobMessage = JobMessage
|
data JobMessage = JobMessage
|
||||||
{ _data :: JobMessageData
|
{ _data :: JobMessageData,
|
||||||
, _jobType :: JobType
|
_jobType :: JobType
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
data JobMessageData = JobOutput Text JobOutputType
|
data JobMessageData
|
||||||
| JobExit ExitCode
|
= JobOutput Text JobOutputType
|
||||||
deriving (Show)
|
| JobExit ExitCode
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
data JobOutputType = Stdout | Stderr deriving (Show, Eq)
|
data JobOutputType = Stdout | Stderr deriving (Show, Eq)
|
||||||
|
|
||||||
|
@ -1,67 +1,67 @@
|
|||||||
module Generator.Job.IO
|
module Generator.Job.IO
|
||||||
( readJobMessagesAndPrintThemPrefixed
|
( readJobMessagesAndPrintThemPrefixed,
|
||||||
, printPrefixedJobMessage
|
printPrefixedJobMessage,
|
||||||
, printJobMessage
|
printJobMessage,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Concurrent (Chan, readChan)
|
import Control.Concurrent (Chan, readChan)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T.IO
|
import qualified Data.Text.IO as T.IO
|
||||||
import System.Exit (ExitCode (..))
|
import qualified Generator.Job as J
|
||||||
import System.IO (Handle, hFlush, stderr, stdout)
|
import System.Exit (ExitCode (..))
|
||||||
|
import System.IO (Handle, hFlush, stderr, stdout)
|
||||||
import qualified Generator.Job as J
|
import qualified Util.Terminal as Term
|
||||||
import qualified Util.Terminal as Term
|
|
||||||
|
|
||||||
readJobMessagesAndPrintThemPrefixed :: Chan J.JobMessage -> IO ()
|
readJobMessagesAndPrintThemPrefixed :: Chan J.JobMessage -> IO ()
|
||||||
readJobMessagesAndPrintThemPrefixed =
|
readJobMessagesAndPrintThemPrefixed =
|
||||||
let go prevJobMsg chan = do
|
let go prevJobMsg chan = do
|
||||||
jobMsg <- readChan chan
|
jobMsg <- readChan chan
|
||||||
case J._data jobMsg of
|
case J._data jobMsg of
|
||||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg >> go (Just jobMsg) chan
|
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg >> go (Just jobMsg) chan
|
||||||
J.JobExit {} -> return ()
|
J.JobExit {} -> return ()
|
||||||
in go Nothing
|
in go Nothing
|
||||||
|
|
||||||
printPrefixedJobMessage :: Maybe J.JobMessage -> J.JobMessage -> IO ()
|
printPrefixedJobMessage :: Maybe J.JobMessage -> J.JobMessage -> IO ()
|
||||||
printPrefixedJobMessage maybePrevJobMessage jobMessage = do
|
printPrefixedJobMessage maybePrevJobMessage jobMessage = do
|
||||||
let outHandle = getJobMessageOutHandle jobMessage
|
let outHandle = getJobMessageOutHandle jobMessage
|
||||||
prefix = makeJobMessagePrefix jobMessage
|
prefix = makeJobMessagePrefix jobMessage
|
||||||
content = getJobMessageContent jobMessage
|
content = getJobMessageContent jobMessage
|
||||||
|
|
||||||
let maybeAddPrefixAtStart =
|
let maybeAddPrefixAtStart =
|
||||||
((if (J._jobType <$> maybePrevJobMessage) /= Just (J._jobType jobMessage) then "\n" <> prefix else "") <>)
|
((if (J._jobType <$> maybePrevJobMessage) /= Just (J._jobType jobMessage) then "\n" <> prefix else "") <>)
|
||||||
addPrefixAfterSubstr substr = T.intercalate (substr <> prefix) . T.splitOn substr
|
addPrefixAfterSubstr substr = T.intercalate (substr <> prefix) . T.splitOn substr
|
||||||
addPrefix = maybeAddPrefixAtStart . addPrefixAfterSubstr "\n" . addPrefixAfterSubstr "\r"
|
addPrefix = maybeAddPrefixAtStart . addPrefixAfterSubstr "\n" . addPrefixAfterSubstr "\r"
|
||||||
|
|
||||||
T.IO.hPutStr outHandle $ addPrefix content
|
T.IO.hPutStr outHandle $ addPrefix content
|
||||||
hFlush outHandle
|
hFlush outHandle
|
||||||
|
|
||||||
printJobMessage :: J.JobMessage -> IO ()
|
printJobMessage :: J.JobMessage -> IO ()
|
||||||
printJobMessage jobMsg = do
|
printJobMessage jobMsg = do
|
||||||
let outHandle = getJobMessageOutHandle jobMsg
|
let outHandle = getJobMessageOutHandle jobMsg
|
||||||
let message = getJobMessageContent jobMsg
|
let message = getJobMessageContent jobMsg
|
||||||
T.IO.hPutStr outHandle message
|
T.IO.hPutStr outHandle message
|
||||||
hFlush outHandle
|
hFlush outHandle
|
||||||
|
|
||||||
makeJobMessagePrefix :: J.JobMessage -> T.Text
|
makeJobMessagePrefix :: J.JobMessage -> T.Text
|
||||||
makeJobMessagePrefix jobMsg =
|
makeJobMessagePrefix jobMsg =
|
||||||
case J._jobType jobMsg of
|
case J._jobType jobMsg of
|
||||||
J.Server -> T.pack $ Term.applyStyles [Term.Magenta] "Server"
|
J.Server -> T.pack $ Term.applyStyles [Term.Magenta] "Server"
|
||||||
J.WebApp -> T.pack $ Term.applyStyles [Term.Cyan] "Web app"
|
J.WebApp -> T.pack $ Term.applyStyles [Term.Cyan] "Web app"
|
||||||
J.Db -> T.pack $ Term.applyStyles [Term.White] "Db"
|
J.Db -> T.pack $ Term.applyStyles [Term.White] "Db"
|
||||||
<> (if getJobMessageOutHandle jobMsg == stderr then " (stderr)" else "")
|
<> (if getJobMessageOutHandle jobMsg == stderr then " (stderr)" else "")
|
||||||
<> ": "
|
<> ": "
|
||||||
|
|
||||||
getJobMessageOutHandle :: J.JobMessage -> Handle
|
getJobMessageOutHandle :: J.JobMessage -> Handle
|
||||||
getJobMessageOutHandle jobMsg = case J._data jobMsg of
|
getJobMessageOutHandle jobMsg = case J._data jobMsg of
|
||||||
J.JobOutput _ outputType ->
|
J.JobOutput _ outputType ->
|
||||||
case outputType of
|
case outputType of
|
||||||
J.Stdout -> stdout
|
J.Stdout -> stdout
|
||||||
J.Stderr -> stderr
|
J.Stderr -> stderr
|
||||||
J.JobExit _ -> stdout
|
J.JobExit _ -> stdout
|
||||||
|
|
||||||
getJobMessageContent :: J.JobMessage -> T.Text
|
getJobMessageContent :: J.JobMessage -> T.Text
|
||||||
getJobMessageContent jobMsg = case J._data jobMsg of
|
getJobMessageContent jobMsg = case J._data jobMsg of
|
||||||
J.JobOutput output _ -> output
|
J.JobOutput output _ -> output
|
||||||
J.JobExit ExitSuccess -> "Job exited successfully."
|
J.JobExit ExitSuccess -> "Job exited successfully."
|
||||||
J.JobExit (ExitFailure exitCode) -> T.pack $ "Job failed with exit code " <> show exitCode
|
J.JobExit (ExitFailure exitCode) -> T.pack $ "Job failed with exit code " <> show exitCode
|
||||||
|
@ -1,28 +1,28 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Generator.Job.Process
|
module Generator.Job.Process
|
||||||
( runProcessAsJob
|
( runProcessAsJob,
|
||||||
, runNodeCommandAsJob
|
runNodeCommandAsJob,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Concurrent (writeChan)
|
import Control.Concurrent (writeChan)
|
||||||
import Control.Concurrent.Async (Concurrently (..))
|
import Control.Concurrent.Async (Concurrently (..))
|
||||||
import UnliftIO.Exception (bracket)
|
import Data.Conduit (runConduit, (.|))
|
||||||
import Data.Conduit (runConduit, (.|))
|
import qualified Data.Conduit.List as CL
|
||||||
import qualified Data.Conduit.List as CL
|
import qualified Data.Conduit.Process as CP
|
||||||
import qualified Data.Conduit.Process as CP
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text as T
|
import Data.Text.Encoding (decodeUtf8)
|
||||||
import Data.Text.Encoding (decodeUtf8)
|
import qualified Generator.Common as C
|
||||||
import System.Exit (ExitCode (..))
|
import qualified Generator.Job as J
|
||||||
import System.IO.Error (catchIOError, isDoesNotExistError)
|
import StrongPath (Abs, Dir, Path)
|
||||||
import qualified System.Process as P
|
import qualified StrongPath as SP
|
||||||
import Text.Read (readMaybe)
|
import System.Exit (ExitCode (..))
|
||||||
import qualified Text.Regex.TDFA as R
|
import System.IO.Error (catchIOError, isDoesNotExistError)
|
||||||
|
import qualified System.Process as P
|
||||||
import qualified Generator.Common as C
|
import Text.Read (readMaybe)
|
||||||
import qualified Generator.Job as J
|
import qualified Text.Regex.TDFA as R
|
||||||
import StrongPath (Abs, Dir, Path)
|
import UnliftIO.Exception (bracket)
|
||||||
import qualified StrongPath as SP
|
|
||||||
|
|
||||||
-- TODO:
|
-- TODO:
|
||||||
-- Switch from Data.Conduit.Process to Data.Conduit.Process.Typed.
|
-- 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.
|
-- 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.
|
-- Makes sure to terminate the process if exception occurs.
|
||||||
runProcessAsJob :: P.CreateProcess -> J.JobType -> J.Job
|
runProcessAsJob :: P.CreateProcess -> J.JobType -> J.Job
|
||||||
runProcessAsJob process jobType chan = bracket
|
runProcessAsJob process jobType chan =
|
||||||
|
bracket
|
||||||
(CP.streamingProcess process)
|
(CP.streamingProcess process)
|
||||||
(\(_, _, _, sph) -> terminateStreamingProcess sph)
|
(\(_, _, _, sph) -> terminateStreamingProcess sph)
|
||||||
runStreamingProcessAsJob
|
runStreamingProcessAsJob
|
||||||
where
|
where
|
||||||
runStreamingProcessAsJob (CP.Inherited, stdoutStream, stderrStream, processHandle) = do
|
runStreamingProcessAsJob (CP.Inherited, stdoutStream, stderrStream, processHandle) = do
|
||||||
let forwardStdoutToChan = runConduit $ stdoutStream .| CL.mapM_
|
let forwardStdoutToChan =
|
||||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stdout
|
runConduit $
|
||||||
, J._jobType = jobType })
|
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_
|
let forwardStderrToChan =
|
||||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stderr
|
runConduit $
|
||||||
, J._jobType = jobType })
|
stderrStream
|
||||||
|
.| CL.mapM_
|
||||||
|
( \bs ->
|
||||||
|
writeChan chan $
|
||||||
|
J.JobMessage
|
||||||
|
{ J._data = J.JobOutput (decodeUtf8 bs) J.Stderr,
|
||||||
|
J._jobType = jobType
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
exitCode <- runConcurrently $
|
exitCode <-
|
||||||
Concurrently forwardStdoutToChan *>
|
runConcurrently $
|
||||||
Concurrently forwardStderrToChan *>
|
Concurrently forwardStdoutToChan
|
||||||
Concurrently (CP.waitForStreamingProcess processHandle)
|
*> Concurrently forwardStderrToChan
|
||||||
|
*> Concurrently (CP.waitForStreamingProcess processHandle)
|
||||||
|
|
||||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
writeChan chan $
|
||||||
, J._jobType = jobType }
|
J.JobMessage
|
||||||
|
{ J._data = J.JobExit exitCode,
|
||||||
|
J._jobType = jobType
|
||||||
|
}
|
||||||
|
|
||||||
return exitCode
|
return exitCode
|
||||||
|
|
||||||
terminateStreamingProcess streamingProcessHandle = do
|
terminateStreamingProcess streamingProcessHandle = do
|
||||||
let processHandle = CP.streamingProcessHandleRaw streamingProcessHandle
|
let processHandle = CP.streamingProcessHandleRaw streamingProcessHandle
|
||||||
P.terminateProcess processHandle
|
P.terminateProcess processHandle
|
||||||
return $ ExitFailure 1
|
return $ ExitFailure 1
|
||||||
|
|
||||||
runNodeCommandAsJob :: Path Abs (Dir a) -> String -> [String] -> J.JobType -> J.Job
|
runNodeCommandAsJob :: Path Abs (Dir a) -> String -> [String] -> J.JobType -> J.Job
|
||||||
runNodeCommandAsJob fromDir command args jobType chan = do
|
runNodeCommandAsJob fromDir command args jobType chan = do
|
||||||
errorOrNodeVersion <- getNodeVersion
|
errorOrNodeVersion <- getNodeVersion
|
||||||
case errorOrNodeVersion of
|
case errorOrNodeVersion of
|
||||||
Left errorMsg -> exitWithError (ExitFailure 1) (T.pack errorMsg)
|
Left errorMsg -> exitWithError (ExitFailure 1) (T.pack errorMsg)
|
||||||
Right nodeVersion -> if nodeVersion < C.nodeVersion
|
Right nodeVersion ->
|
||||||
then exitWithError (ExitFailure 1)
|
if nodeVersion < C.nodeVersion
|
||||||
(T.pack $ "Your node version is too low. " ++ waspNodeRequirementMessage)
|
then
|
||||||
else do
|
exitWithError
|
||||||
let process = (P.proc command args) { P.cwd = Just $ SP.toFilePath fromDir }
|
(ExitFailure 1)
|
||||||
runProcessAsJob process jobType chan
|
(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
|
where
|
||||||
exitWithError exitCode errorMsg = do
|
exitWithError exitCode errorMsg = do
|
||||||
writeChan chan $ J.JobMessage
|
writeChan chan $
|
||||||
{ J._data = J.JobOutput errorMsg J.Stderr
|
J.JobMessage
|
||||||
, J._jobType = jobType }
|
{ J._data = J.JobOutput errorMsg J.Stderr,
|
||||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
J._jobType = jobType
|
||||||
, J._jobType = jobType }
|
}
|
||||||
return exitCode
|
writeChan chan $
|
||||||
|
J.JobMessage
|
||||||
|
{ J._data = J.JobExit exitCode,
|
||||||
|
J._jobType = jobType
|
||||||
|
}
|
||||||
|
return exitCode
|
||||||
|
|
||||||
getNodeVersion :: IO (Either String (Int, Int, Int))
|
getNodeVersion :: IO (Either String (Int, Int, Int))
|
||||||
getNodeVersion = do
|
getNodeVersion = do
|
||||||
(exitCode, stdout, stderr) <- P.readProcessWithExitCode "node" ["--version"] ""
|
(exitCode, stdout, stderr) <-
|
||||||
`catchIOError` (\e -> if isDoesNotExistError e
|
P.readProcessWithExitCode "node" ["--version"] ""
|
||||||
then return (ExitFailure 1, "", "Command 'node' not found.")
|
`catchIOError` ( \e ->
|
||||||
else ioError e)
|
if isDoesNotExistError e
|
||||||
return $ case exitCode of
|
then return (ExitFailure 1, "", "Command 'node' not found.")
|
||||||
ExitFailure _ -> Left ("Running 'node --version' failed: " ++ stderr
|
else ioError e
|
||||||
++ " " ++ waspNodeRequirementMessage)
|
)
|
||||||
ExitSuccess -> case parseNodeVersion stdout of
|
return $ case exitCode of
|
||||||
Nothing -> Left ("Wasp failed to parse node version."
|
ExitFailure _ ->
|
||||||
++ " This is most likely a bug in Wasp, please file an issue.")
|
Left
|
||||||
Just version -> Right version
|
( "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 :: String -> Maybe (Int, Int, Int)
|
||||||
parseNodeVersion nodeVersionStr =
|
parseNodeVersion nodeVersionStr =
|
||||||
case nodeVersionStr R.=~ ("v([^\\.]+).([^\\.]+).(.+)" :: String) of
|
case nodeVersionStr R.=~ ("v([^\\.]+).([^\\.]+).(.+)" :: String) of
|
||||||
((_ , _, _, [majorStr, minorStr, patchStr]) :: (String, String, String, [String])) -> do
|
((_, _, _, [majorStr, minorStr, patchStr]) :: (String, String, String, [String])) -> do
|
||||||
major <- readMaybe majorStr
|
major <- readMaybe majorStr
|
||||||
minor <- readMaybe minorStr
|
minor <- readMaybe minorStr
|
||||||
patch <- readMaybe patchStr
|
patch <- readMaybe patchStr
|
||||||
return (major, minor, patch)
|
return (major, minor, patch)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
waspNodeRequirementMessage = "Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
waspNodeRequirementMessage =
|
||||||
++ " Check Wasp docs for more details: https://wasp-lang.dev/docs#requirements ."
|
"Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
||||||
|
++ " Check Wasp docs for more details: https://wasp-lang.dev/docs#requirements ."
|
||||||
|
@ -1,14 +1,13 @@
|
|||||||
module Generator.PackageJsonGenerator
|
module Generator.PackageJsonGenerator
|
||||||
( resolveNpmDeps
|
( resolveNpmDeps,
|
||||||
, toPackageJsonDependenciesString
|
toPackageJsonDependenciesString,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.List (find, intercalate)
|
|
||||||
import Data.Maybe (fromJust, isJust)
|
|
||||||
|
|
||||||
|
import Data.List (find, intercalate)
|
||||||
|
import Data.Maybe (fromJust, isJust)
|
||||||
import qualified NpmDependency as ND
|
import qualified NpmDependency as ND
|
||||||
|
|
||||||
|
|
||||||
type NpmDependenciesConflictError = String
|
type NpmDependenciesConflictError = String
|
||||||
|
|
||||||
-- | Takes wasp npm dependencies and user npm dependencies and figures out how to
|
-- | Takes wasp npm dependencies and user npm dependencies and figures out how to
|
||||||
@ -18,41 +17,49 @@ type NpmDependenciesConflictError = String
|
|||||||
-- be different.
|
-- be different.
|
||||||
-- On error (Left), returns list of conflicting user deps together with the error message
|
-- On error (Left), returns list of conflicting user deps together with the error message
|
||||||
-- explaining what the error is.
|
-- explaining what the error is.
|
||||||
resolveNpmDeps
|
resolveNpmDeps ::
|
||||||
:: [ND.NpmDependency]
|
[ND.NpmDependency] ->
|
||||||
-> [ND.NpmDependency]
|
[ND.NpmDependency] ->
|
||||||
-> Either [(ND.NpmDependency, NpmDependenciesConflictError)]
|
Either
|
||||||
([ND.NpmDependency], [ND.NpmDependency])
|
[(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||||
resolveNpmDeps waspDeps userDeps = if null conflictingUserDeps
|
([ND.NpmDependency], [ND.NpmDependency])
|
||||||
|
resolveNpmDeps waspDeps userDeps =
|
||||||
|
if null conflictingUserDeps
|
||||||
then Right (waspDeps, userDepsNotInWaspDeps)
|
then Right (waspDeps, userDepsNotInWaspDeps)
|
||||||
else Left conflictingUserDeps
|
else Left conflictingUserDeps
|
||||||
where
|
where
|
||||||
conflictingUserDeps :: [(ND.NpmDependency, NpmDependenciesConflictError)]
|
conflictingUserDeps :: [(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||||
conflictingUserDeps = map (\(dep, err) -> (dep, fromJust err))
|
conflictingUserDeps =
|
||||||
$ filter (isJust . snd)
|
map (\(dep, err) -> (dep, fromJust err)) $
|
||||||
$ map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
filter (isJust . snd) $
|
||||||
|
map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
||||||
|
|
||||||
checkIfConflictingUserDep :: ND.NpmDependency -> Maybe NpmDependenciesConflictError
|
checkIfConflictingUserDep :: ND.NpmDependency -> Maybe NpmDependenciesConflictError
|
||||||
checkIfConflictingUserDep userDep =
|
checkIfConflictingUserDep userDep =
|
||||||
let attachErrorMessage dep = "Error: Dependency conflict for user npm dependency ("
|
let attachErrorMessage dep =
|
||||||
++ ND._name dep ++ ", " ++ ND._version dep ++ "): "
|
"Error: Dependency conflict for user npm dependency ("
|
||||||
++ "Version must be set to the exactly the same version as"
|
++ ND._name dep
|
||||||
++ " the one wasp is using: "
|
++ ", "
|
||||||
++ ND._version dep
|
++ ND._version dep
|
||||||
in attachErrorMessage <$> find (areTwoDepsInConflict userDep) waspDeps
|
++ "): "
|
||||||
|
++ "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 :: ND.NpmDependency -> ND.NpmDependency -> Bool
|
||||||
areTwoDepsInConflict d1 d2 = ND._name d1 == ND._name d2
|
areTwoDepsInConflict d1 d2 =
|
||||||
&& ND._version d1 /= ND._version d2
|
ND._name d1 == ND._name d2
|
||||||
|
&& ND._version d1 /= ND._version d2
|
||||||
|
|
||||||
userDepsNotInWaspDeps :: [ND.NpmDependency]
|
userDepsNotInWaspDeps :: [ND.NpmDependency]
|
||||||
userDepsNotInWaspDeps = filter (not . isDepWithNameInWaspDeps . ND._name) userDeps
|
userDepsNotInWaspDeps = filter (not . isDepWithNameInWaspDeps . ND._name) userDeps
|
||||||
|
|
||||||
isDepWithNameInWaspDeps :: String -> Bool
|
isDepWithNameInWaspDeps :: String -> Bool
|
||||||
isDepWithNameInWaspDeps name = any ((name ==). ND._name) waspDeps
|
isDepWithNameInWaspDeps name = any ((name ==) . ND._name) waspDeps
|
||||||
|
|
||||||
toPackageJsonDependenciesString :: [ND.NpmDependency] -> String
|
toPackageJsonDependenciesString :: [ND.NpmDependency] -> String
|
||||||
toPackageJsonDependenciesString deps =
|
toPackageJsonDependenciesString deps =
|
||||||
"\"dependencies\": {"
|
"\"dependencies\": {"
|
||||||
++ intercalate ",\n " (map (\dep -> "\"" ++ ND._name dep ++ "\": \"" ++ ND._version dep ++ "\"") deps)
|
++ intercalate ",\n " (map (\dep -> "\"" ++ ND._name dep ++ "\": \"" ++ ND._version dep ++ "\"") deps)
|
||||||
++ "\n}"
|
++ "\n}"
|
||||||
|
@ -1,52 +1,58 @@
|
|||||||
module Generator.ServerGenerator
|
module Generator.ServerGenerator
|
||||||
( genServer
|
( genServer,
|
||||||
, preCleanup
|
preCleanup,
|
||||||
, operationsRouteInRootRouter
|
operationsRouteInRootRouter,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import CompileOptions (CompileOptions)
|
||||||
import Data.List (intercalate)
|
import Control.Monad (when)
|
||||||
import Data.Maybe (fromJust,
|
import Data.Aeson (object, (.=))
|
||||||
isJust)
|
import Data.List (intercalate)
|
||||||
import qualified Path as P
|
import Data.Maybe
|
||||||
import StrongPath ((</>), Path, Rel, File, Abs, Dir)
|
( fromJust,
|
||||||
import qualified StrongPath as SP
|
isJust,
|
||||||
import System.Directory (removeFile)
|
)
|
||||||
import UnliftIO.Exception (catch, throwIO)
|
import Generator.Common (ProjectRootDir, nodeVersionAsText)
|
||||||
import System.IO.Error (isDoesNotExistError)
|
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||||
import Control.Monad (when)
|
import Generator.FileDraft (FileDraft, createCopyFileDraft)
|
||||||
|
import Generator.PackageJsonGenerator
|
||||||
import CompileOptions (CompileOptions)
|
( resolveNpmDeps,
|
||||||
import Generator.Common (nodeVersionAsText, ProjectRootDir)
|
toPackageJsonDependenciesString,
|
||||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
)
|
||||||
import Generator.FileDraft (FileDraft, createCopyFileDraft)
|
import Generator.ServerGenerator.AuthG (genAuth)
|
||||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
import Generator.ServerGenerator.Common
|
||||||
toPackageJsonDependenciesString)
|
( asServerFile,
|
||||||
import Generator.ServerGenerator.AuthG (genAuth)
|
asTmplFile,
|
||||||
import Generator.ServerGenerator.Common (asServerFile,
|
)
|
||||||
asTmplFile)
|
import qualified Generator.ServerGenerator.Common as C
|
||||||
import qualified Generator.ServerGenerator.Common as C
|
import Generator.ServerGenerator.ConfigG (genConfigFile)
|
||||||
import Generator.ServerGenerator.ConfigG (genConfigFile)
|
|
||||||
import qualified Generator.ServerGenerator.ExternalCodeGenerator as ServerExternalCodeGenerator
|
import qualified Generator.ServerGenerator.ExternalCodeGenerator as ServerExternalCodeGenerator
|
||||||
import Generator.ServerGenerator.OperationsG (genOperations)
|
import Generator.ServerGenerator.OperationsG (genOperations)
|
||||||
import Generator.ServerGenerator.OperationsRoutesG (genOperationsRoutes)
|
import Generator.ServerGenerator.OperationsRoutesG (genOperationsRoutes)
|
||||||
import qualified NpmDependency as ND
|
import qualified NpmDependency as ND
|
||||||
import Wasp (Wasp, getAuth)
|
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
|
||||||
import qualified Wasp.Auth
|
import qualified Wasp.Auth
|
||||||
import qualified Wasp.NpmDependencies as WND
|
import qualified Wasp.NpmDependencies as WND
|
||||||
|
|
||||||
|
|
||||||
genServer :: Wasp -> CompileOptions -> [FileDraft]
|
genServer :: Wasp -> CompileOptions -> [FileDraft]
|
||||||
genServer wasp _ = concat
|
genServer wasp _ =
|
||||||
[ [genReadme wasp]
|
concat
|
||||||
, [genPackageJson wasp waspNpmDeps]
|
[ [genReadme wasp],
|
||||||
, [genNpmrc wasp]
|
[genPackageJson wasp waspNpmDeps],
|
||||||
, [genNvmrc wasp]
|
[genNpmrc wasp],
|
||||||
, [genGitignore wasp]
|
[genNvmrc wasp],
|
||||||
, genSrcDir wasp
|
[genGitignore wasp],
|
||||||
, generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp
|
genSrcDir wasp,
|
||||||
, genDotEnv wasp
|
generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp,
|
||||||
|
genDotEnv wasp
|
||||||
]
|
]
|
||||||
|
|
||||||
-- Cleanup to be performed before generating new server code.
|
-- Cleanup to be performed before generating new server code.
|
||||||
@ -56,22 +62,22 @@ genServer wasp _ = concat
|
|||||||
-- for progress of this.
|
-- for progress of this.
|
||||||
preCleanup :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
preCleanup :: Wasp -> Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO ()
|
||||||
preCleanup _ outDir _ = do
|
preCleanup _ outDir _ = do
|
||||||
-- If .env gets removed but there is old .env file in generated project from previous attempts,
|
-- If .env gets removed but there is old .env file in generated project from previous attempts,
|
||||||
-- we need to make sure we remove it.
|
-- we need to make sure we remove it.
|
||||||
removeFile dotEnvAbsFilePath
|
removeFile dotEnvAbsFilePath
|
||||||
`catch` \e -> when (not $ isDoesNotExistError e) $ throwIO e
|
`catch` \e -> when (not $ isDoesNotExistError e) $ throwIO e
|
||||||
where
|
where
|
||||||
dotEnvAbsFilePath = SP.toFilePath $ outDir </> C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir
|
dotEnvAbsFilePath = SP.toFilePath $ outDir </> C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir
|
||||||
|
|
||||||
genDotEnv :: Wasp -> [FileDraft]
|
genDotEnv :: Wasp -> [FileDraft]
|
||||||
genDotEnv wasp =
|
genDotEnv wasp =
|
||||||
case Wasp.getDotEnvFile wasp of
|
case Wasp.getDotEnvFile wasp of
|
||||||
Just srcFilePath ->
|
Just srcFilePath ->
|
||||||
[ createCopyFileDraft
|
[ createCopyFileDraft
|
||||||
(C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir)
|
(C.serverRootDirInProjectRootDir </> dotEnvInServerRootDir)
|
||||||
srcFilePath
|
srcFilePath
|
||||||
]
|
]
|
||||||
Nothing -> []
|
Nothing -> []
|
||||||
|
|
||||||
dotEnvInServerRootDir :: Path (Rel C.ServerRootDir) File
|
dotEnvInServerRootDir :: Path (Rel C.ServerRootDir) File
|
||||||
dotEnvInServerRootDir = asServerFile [P.relfile|.env|]
|
dotEnvInServerRootDir = asServerFile [P.relfile|.env|]
|
||||||
@ -80,101 +86,115 @@ genReadme :: Wasp -> FileDraft
|
|||||||
genReadme _ = C.copyTmplAsIs (asTmplFile [P.relfile|README.md|])
|
genReadme _ = C.copyTmplAsIs (asTmplFile [P.relfile|README.md|])
|
||||||
|
|
||||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
genPackageJson wasp waspDeps =
|
||||||
|
C.makeTemplateFD
|
||||||
(asTmplFile [P.relfile|package.json|])
|
(asTmplFile [P.relfile|package.json|])
|
||||||
(asServerFile [P.relfile|package.json|])
|
(asServerFile [P.relfile|package.json|])
|
||||||
(Just $ object
|
( Just $
|
||||||
[ "wasp" .= wasp
|
object
|
||||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
[ "wasp" .= wasp,
|
||||||
, "nodeVersion" .= nodeVersionAsText
|
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps),
|
||||||
, "startProductionScript" .= concat
|
"nodeVersion" .= nodeVersionAsText,
|
||||||
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else ""
|
"startProductionScript"
|
||||||
, "NODE_ENV=production node ./src/server.js"
|
.= concat
|
||||||
]
|
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else "",
|
||||||
])
|
"NODE_ENV=production node ./src/server.js"
|
||||||
|
]
|
||||||
|
]
|
||||||
|
)
|
||||||
where
|
where
|
||||||
(resolvedWaspDeps, resolvedUserDeps) =
|
(resolvedWaspDeps, resolvedUserDeps) =
|
||||||
case resolveNpmDeps waspDeps userDeps of
|
case resolveNpmDeps waspDeps userDeps of
|
||||||
Right deps -> deps
|
Right deps -> deps
|
||||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||||
|
|
||||||
userDeps :: [ND.NpmDependency]
|
userDeps :: [ND.NpmDependency]
|
||||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||||
|
|
||||||
waspNpmDeps :: [ND.NpmDependency]
|
waspNpmDeps :: [ND.NpmDependency]
|
||||||
waspNpmDeps = ND.fromList
|
waspNpmDeps =
|
||||||
[ ("cookie-parser", "~1.4.4")
|
ND.fromList
|
||||||
, ("cors", "^2.8.5")
|
[ ("cookie-parser", "~1.4.4"),
|
||||||
, ("debug", "~2.6.9")
|
("cors", "^2.8.5"),
|
||||||
, ("express", "~4.16.1")
|
("debug", "~2.6.9"),
|
||||||
, ("morgan", "~1.9.1")
|
("express", "~4.16.1"),
|
||||||
, ("@prisma/client", "2.21.0")
|
("morgan", "~1.9.1"),
|
||||||
, ("jsonwebtoken", "^8.5.1")
|
("@prisma/client", "2.21.0"),
|
||||||
, ("secure-password", "^4.0.0")
|
("jsonwebtoken", "^8.5.1"),
|
||||||
, ("dotenv", "8.2.0")
|
("secure-password", "^4.0.0"),
|
||||||
|
("dotenv", "8.2.0")
|
||||||
]
|
]
|
||||||
|
|
||||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||||
|
|
||||||
genNpmrc :: Wasp -> FileDraft
|
genNpmrc :: Wasp -> FileDraft
|
||||||
genNpmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|npmrc|])
|
genNpmrc _ =
|
||||||
(asServerFile [P.relfile|.npmrc|])
|
C.makeTemplateFD
|
||||||
Nothing
|
(asTmplFile [P.relfile|npmrc|])
|
||||||
|
(asServerFile [P.relfile|.npmrc|])
|
||||||
|
Nothing
|
||||||
|
|
||||||
genNvmrc :: Wasp -> FileDraft
|
genNvmrc :: Wasp -> FileDraft
|
||||||
genNvmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|nvmrc|])
|
genNvmrc _ =
|
||||||
(asServerFile [P.relfile|.nvmrc|])
|
C.makeTemplateFD
|
||||||
(Just (object ["nodeVersion" .= ('v' : nodeVersionAsText)]))
|
(asTmplFile [P.relfile|nvmrc|])
|
||||||
|
(asServerFile [P.relfile|.nvmrc|])
|
||||||
|
(Just (object ["nodeVersion" .= ('v' : nodeVersionAsText)]))
|
||||||
|
|
||||||
genGitignore :: Wasp -> FileDraft
|
genGitignore :: Wasp -> FileDraft
|
||||||
genGitignore _ = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
genGitignore _ =
|
||||||
(asServerFile [P.relfile|.gitignore|])
|
C.makeTemplateFD
|
||||||
Nothing
|
(asTmplFile [P.relfile|gitignore|])
|
||||||
|
(asServerFile [P.relfile|.gitignore|])
|
||||||
|
Nothing
|
||||||
|
|
||||||
genSrcDir :: Wasp -> [FileDraft]
|
genSrcDir :: Wasp -> [FileDraft]
|
||||||
genSrcDir wasp = concat
|
genSrcDir wasp =
|
||||||
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]]
|
concat
|
||||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]]
|
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]],
|
||||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]]
|
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]],
|
||||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]]
|
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]],
|
||||||
, [genDbClient wasp]
|
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]],
|
||||||
, [genConfigFile wasp]
|
[genDbClient wasp],
|
||||||
, genRoutesDir wasp
|
[genConfigFile wasp],
|
||||||
, genOperationsRoutes wasp
|
genRoutesDir wasp,
|
||||||
, genOperations wasp
|
genOperationsRoutes wasp,
|
||||||
, genAuth wasp
|
genOperations wasp,
|
||||||
|
genAuth wasp
|
||||||
]
|
]
|
||||||
|
|
||||||
genDbClient :: Wasp -> FileDraft
|
genDbClient :: Wasp -> FileDraft
|
||||||
genDbClient wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genDbClient wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
maybeAuth = getAuth wasp
|
maybeAuth = getAuth wasp
|
||||||
|
|
||||||
dbClientRelToSrcP = [P.relfile|dbClient.js|]
|
dbClientRelToSrcP = [P.relfile|dbClient.js|]
|
||||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> dbClientRelToSrcP
|
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> dbClientRelToSrcP
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> C.asServerSrcFile dbClientRelToSrcP
|
dstFile = C.serverSrcDirInServerRootDir </> C.asServerSrcFile dbClientRelToSrcP
|
||||||
|
|
||||||
tmplData =
|
tmplData =
|
||||||
if isJust maybeAuth
|
if isJust maybeAuth
|
||||||
then object
|
then
|
||||||
[ "isAuthEnabled" .= True
|
object
|
||||||
, "userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
[ "isAuthEnabled" .= True,
|
||||||
]
|
"userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
||||||
else object []
|
]
|
||||||
|
else object []
|
||||||
|
|
||||||
genRoutesDir :: Wasp -> [FileDraft]
|
genRoutesDir :: Wasp -> [FileDraft]
|
||||||
genRoutesDir wasp =
|
genRoutesDir wasp =
|
||||||
-- TODO(martin): We will probably want to extract "routes" path here same as we did with "src", to avoid hardcoding,
|
-- 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.
|
-- but I did not bother with it yet since it is used only here for now.
|
||||||
[ C.makeTemplateFD
|
[ C.makeTemplateFD
|
||||||
(asTmplFile [P.relfile|src/routes/index.js|])
|
(asTmplFile [P.relfile|src/routes/index.js|])
|
||||||
(asServerFile [P.relfile|src/routes/index.js|])
|
(asServerFile [P.relfile|src/routes/index.js|])
|
||||||
(Just $ object
|
( Just $
|
||||||
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter
|
object
|
||||||
, "isAuthEnabled" .= isJust (getAuth wasp)
|
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter,
|
||||||
|
"isAuthEnabled" .= isJust (getAuth wasp)
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
operationsRouteInRootRouter :: String
|
operationsRouteInRootRouter :: String
|
||||||
operationsRouteInRootRouter = "operations"
|
operationsRouteInRootRouter = "operations"
|
||||||
|
@ -1,41 +1,44 @@
|
|||||||
module Generator.ServerGenerator.AuthG
|
module Generator.ServerGenerator.AuthG
|
||||||
( genAuth
|
( genAuth,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Aeson (object, (.=))
|
||||||
|
import Generator.FileDraft (FileDraft)
|
||||||
|
import qualified Generator.ServerGenerator.Common as C
|
||||||
import qualified Path as P
|
import qualified Path as P
|
||||||
import Data.Aeson (object, (.=))
|
import StrongPath ((</>))
|
||||||
|
|
||||||
import qualified Util
|
import qualified Util
|
||||||
import Wasp (Wasp, getAuth)
|
import Wasp (Wasp, getAuth)
|
||||||
import qualified Wasp.Auth
|
import qualified Wasp.Auth
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import qualified Generator.ServerGenerator.Common as C
|
|
||||||
import StrongPath ((</>))
|
|
||||||
|
|
||||||
genAuth :: Wasp -> [FileDraft]
|
genAuth :: Wasp -> [FileDraft]
|
||||||
genAuth wasp = case maybeAuth of
|
genAuth wasp = case maybeAuth of
|
||||||
Just auth -> [ genCoreAuth auth
|
Just auth ->
|
||||||
-- Auth routes
|
[ genCoreAuth auth,
|
||||||
, genAuthRoutesIndex
|
-- Auth routes
|
||||||
, genLoginRoute auth
|
genAuthRoutesIndex,
|
||||||
, genSignupRoute auth
|
genLoginRoute auth,
|
||||||
, genMeRoute auth
|
genSignupRoute auth,
|
||||||
]
|
genMeRoute auth
|
||||||
Nothing -> []
|
]
|
||||||
where
|
Nothing -> []
|
||||||
maybeAuth = getAuth wasp
|
where
|
||||||
|
maybeAuth = getAuth wasp
|
||||||
|
|
||||||
-- | Generates core/auth file which contains auth middleware and createUser() function.
|
-- | Generates core/auth file which contains auth middleware and createUser() function.
|
||||||
genCoreAuth :: Wasp.Auth.Auth -> FileDraft
|
genCoreAuth :: Wasp.Auth.Auth -> FileDraft
|
||||||
genCoreAuth auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genCoreAuth auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
coreAuthRelToSrc = [P.relfile|core/auth.js|]
|
coreAuthRelToSrc = [P.relfile|core/auth.js|]
|
||||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> coreAuthRelToSrc
|
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> coreAuthRelToSrc
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile coreAuthRelToSrc)
|
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile coreAuthRelToSrc)
|
||||||
|
|
||||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
tmplData =
|
||||||
[ "userEntityUpper" .= userEntity
|
let userEntity = (Wasp.Auth._userEntity auth)
|
||||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
in object
|
||||||
|
[ "userEntityUpper" .= userEntity,
|
||||||
|
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||||
]
|
]
|
||||||
|
|
||||||
genAuthRoutesIndex :: FileDraft
|
genAuthRoutesIndex :: FileDraft
|
||||||
@ -43,34 +46,38 @@ genAuthRoutesIndex = C.copySrcTmplAsIs (C.asTmplSrcFile [P.relfile|routes/auth/i
|
|||||||
|
|
||||||
genLoginRoute :: Wasp.Auth.Auth -> FileDraft
|
genLoginRoute :: Wasp.Auth.Auth -> FileDraft
|
||||||
genLoginRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genLoginRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
loginRouteRelToSrc = [P.relfile|routes/auth/login.js|]
|
loginRouteRelToSrc = [P.relfile|routes/auth/login.js|]
|
||||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> loginRouteRelToSrc
|
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> loginRouteRelToSrc
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile loginRouteRelToSrc)
|
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile loginRouteRelToSrc)
|
||||||
|
|
||||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
tmplData =
|
||||||
[ "userEntityUpper" .= userEntity
|
let userEntity = (Wasp.Auth._userEntity auth)
|
||||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
in object
|
||||||
|
[ "userEntityUpper" .= userEntity,
|
||||||
|
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||||
]
|
]
|
||||||
|
|
||||||
genSignupRoute :: Wasp.Auth.Auth -> FileDraft
|
genSignupRoute :: Wasp.Auth.Auth -> FileDraft
|
||||||
genSignupRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genSignupRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
signupRouteRelToSrc = [P.relfile|routes/auth/signup.js|]
|
signupRouteRelToSrc = [P.relfile|routes/auth/signup.js|]
|
||||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> signupRouteRelToSrc
|
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> signupRouteRelToSrc
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile signupRouteRelToSrc)
|
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile signupRouteRelToSrc)
|
||||||
|
|
||||||
tmplData = object
|
tmplData =
|
||||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
object
|
||||||
]
|
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||||
|
]
|
||||||
|
|
||||||
genMeRoute :: Wasp.Auth.Auth -> FileDraft
|
genMeRoute :: Wasp.Auth.Auth -> FileDraft
|
||||||
genMeRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genMeRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
meRouteRelToSrc = [P.relfile|routes/auth/me.js|]
|
meRouteRelToSrc = [P.relfile|routes/auth/me.js|]
|
||||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> meRouteRelToSrc
|
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> meRouteRelToSrc
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile meRouteRelToSrc)
|
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile meRouteRelToSrc)
|
||||||
|
|
||||||
tmplData = object
|
tmplData =
|
||||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
object
|
||||||
]
|
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||||
|
]
|
||||||
|
@ -1,38 +1,39 @@
|
|||||||
module Generator.ServerGenerator.Common
|
module Generator.ServerGenerator.Common
|
||||||
( serverRootDirInProjectRootDir
|
( serverRootDirInProjectRootDir,
|
||||||
, serverSrcDirInServerRootDir
|
serverSrcDirInServerRootDir,
|
||||||
, serverSrcDirInProjectRootDir
|
serverSrcDirInProjectRootDir,
|
||||||
, copyTmplAsIs
|
copyTmplAsIs,
|
||||||
, makeSimpleTemplateFD
|
makeSimpleTemplateFD,
|
||||||
, makeTemplateFD
|
makeTemplateFD,
|
||||||
, copySrcTmplAsIs
|
copySrcTmplAsIs,
|
||||||
, srcDirInServerTemplatesDir
|
srcDirInServerTemplatesDir,
|
||||||
, asTmplFile
|
asTmplFile,
|
||||||
, asTmplSrcFile
|
asTmplSrcFile,
|
||||||
, asServerFile
|
asServerFile,
|
||||||
, asServerSrcFile
|
asServerSrcFile,
|
||||||
, ServerRootDir
|
ServerRootDir,
|
||||||
, ServerSrcDir
|
ServerSrcDir,
|
||||||
, ServerTemplatesDir
|
ServerTemplatesDir,
|
||||||
, ServerTemplatesSrcDir
|
ServerTemplatesSrcDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
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 qualified Path as P
|
||||||
|
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
|
||||||
import qualified StrongPath as SP
|
import qualified StrongPath as SP
|
||||||
import Wasp (Wasp)
|
import Wasp (Wasp)
|
||||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
|
||||||
import Generator.Common (ProjectRootDir)
|
|
||||||
import Generator.Templates (TemplatesDir)
|
|
||||||
|
|
||||||
|
|
||||||
data ServerRootDir
|
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 :: P.Path P.Rel P.File -> Path (Rel ServerTemplatesDir) File
|
||||||
asTmplFile = SP.fromPathRelFile
|
asTmplFile = SP.fromPathRelFile
|
||||||
@ -59,32 +60,36 @@ serverSrcDirInServerRootDir = SP.fromPathRelDir [P.reldir|src|]
|
|||||||
serverSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir ServerSrcDir)
|
serverSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir ServerSrcDir)
|
||||||
serverSrcDirInProjectRootDir = serverRootDirInProjectRootDir </> serverSrcDirInServerRootDir
|
serverSrcDirInProjectRootDir = serverRootDirInProjectRootDir </> serverSrcDirInServerRootDir
|
||||||
|
|
||||||
|
|
||||||
-- * Templates
|
-- * Templates
|
||||||
|
|
||||||
copyTmplAsIs :: Path (Rel ServerTemplatesDir) File -> FileDraft
|
copyTmplAsIs :: Path (Rel ServerTemplatesDir) File -> FileDraft
|
||||||
copyTmplAsIs srcPath = makeTemplateFD srcPath dstPath Nothing
|
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 :: Path (Rel ServerTemplatesDir) File -> Wasp -> FileDraft
|
||||||
makeSimpleTemplateFD srcPath wasp = makeTemplateFD srcPath dstPath (Just $ Aeson.toJSON wasp)
|
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
|
makeTemplateFD ::
|
||||||
-> Path (Rel ServerRootDir) File
|
Path (Rel ServerTemplatesDir) File ->
|
||||||
-> Maybe Aeson.Value
|
Path (Rel ServerRootDir) File ->
|
||||||
-> FileDraft
|
Maybe Aeson.Value ->
|
||||||
|
FileDraft
|
||||||
makeTemplateFD relSrcPath relDstPath tmplData =
|
makeTemplateFD relSrcPath relDstPath tmplData =
|
||||||
createTemplateFileDraft
|
createTemplateFileDraft
|
||||||
(serverRootDirInProjectRootDir </> relDstPath)
|
(serverRootDirInProjectRootDir </> relDstPath)
|
||||||
(serverTemplatesDirInTemplatesDir </> relSrcPath)
|
(serverTemplatesDirInTemplatesDir </> relSrcPath)
|
||||||
tmplData
|
tmplData
|
||||||
|
|
||||||
copySrcTmplAsIs :: Path (Rel ServerTemplatesSrcDir) File -> FileDraft
|
copySrcTmplAsIs :: Path (Rel ServerTemplatesSrcDir) File -> FileDraft
|
||||||
copySrcTmplAsIs pathInTemplatesSrcDir = makeTemplateFD srcPath dstPath Nothing
|
copySrcTmplAsIs pathInTemplatesSrcDir = makeTemplateFD srcPath dstPath Nothing
|
||||||
where srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
where
|
||||||
dstPath = serverSrcDirInServerRootDir
|
srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
||||||
</> ((SP.castRel pathInTemplatesSrcDir) :: Path (Rel ServerSrcDir) File)
|
dstPath =
|
||||||
|
serverSrcDirInServerRootDir
|
||||||
|
</> ((SP.castRel pathInTemplatesSrcDir) :: Path (Rel ServerSrcDir) File)
|
||||||
|
|
||||||
-- | Path where server app templates reside.
|
-- | Path where server app templates reside.
|
||||||
serverTemplatesDirInTemplatesDir :: Path (Rel TemplatesDir) (Dir ServerTemplatesDir)
|
serverTemplatesDirInTemplatesDir :: Path (Rel TemplatesDir) (Dir ServerTemplatesDir)
|
||||||
|
@ -1,25 +1,25 @@
|
|||||||
module Generator.ServerGenerator.ConfigG
|
module Generator.ServerGenerator.ConfigG
|
||||||
( genConfigFile
|
( genConfigFile,
|
||||||
, configFileInSrcDir
|
configFileInSrcDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import qualified Path as P
|
import Generator.FileDraft (FileDraft)
|
||||||
import StrongPath (File, Path, Rel, (</>))
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
|
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import qualified Generator.ServerGenerator.Common as C
|
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 -> FileDraft
|
||||||
genConfigFile wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genConfigFile wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
tmplFile = C.srcDirInServerTemplatesDir </> SP.castRel configFileInSrcDir
|
tmplFile = C.srcDirInServerTemplatesDir </> SP.castRel configFileInSrcDir
|
||||||
dstFile = C.serverSrcDirInServerRootDir </> configFileInSrcDir
|
dstFile = C.serverSrcDirInServerRootDir </> configFileInSrcDir
|
||||||
tmplData = object
|
tmplData =
|
||||||
|
object
|
||||||
[ "isAuthEnabled" .= isJust (getAuth wasp)
|
[ "isAuthEnabled" .= isJust (getAuth wasp)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -1,24 +1,26 @@
|
|||||||
module Generator.ServerGenerator.ExternalCodeGenerator
|
module Generator.ServerGenerator.ExternalCodeGenerator
|
||||||
( extCodeDirInServerSrcDir
|
( extCodeDirInServerSrcDir,
|
||||||
, generatorStrategy
|
generatorStrategy,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Path as P
|
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||||
|
|
||||||
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.Js (resolveJsFileWaspImportsForExtCodeDir)
|
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.
|
-- | Relative path to directory where external code will be generated.
|
||||||
extCodeDirInServerSrcDir :: Path (Rel C.ServerSrcDir) (Dir GeneratedExternalCodeDir)
|
extCodeDirInServerSrcDir :: Path (Rel C.ServerSrcDir) (Dir GeneratedExternalCodeDir)
|
||||||
extCodeDirInServerSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
extCodeDirInServerSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||||
|
|
||||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
generatorStrategy =
|
||||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir)
|
ExternalCodeGeneratorStrategy
|
||||||
, _extCodeDirInProjectRootDir = C.serverRootDirInProjectRootDir
|
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir),
|
||||||
</> C.serverSrcDirInServerRootDir
|
_extCodeDirInProjectRootDir =
|
||||||
</> extCodeDirInServerSrcDir
|
C.serverRootDirInProjectRootDir
|
||||||
|
</> C.serverSrcDirInServerRootDir
|
||||||
|
</> extCodeDirInServerSrcDir
|
||||||
}
|
}
|
||||||
|
@ -1,41 +1,43 @@
|
|||||||
module Generator.ServerGenerator.OperationsG
|
module Generator.ServerGenerator.OperationsG
|
||||||
( genOperations
|
( genOperations,
|
||||||
, queryFileInSrcDir
|
queryFileInSrcDir,
|
||||||
, actionFileInSrcDir
|
actionFileInSrcDir,
|
||||||
, operationFileInSrcDir
|
operationFileInSrcDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Maybe (fromJust, fromMaybe)
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
import qualified Path as P
|
import Generator.FileDraft (FileDraft)
|
||||||
|
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import qualified Generator.ServerGenerator.Common as C
|
import qualified Generator.ServerGenerator.Common as C
|
||||||
import StrongPath (File, Path, Rel, (</>))
|
import qualified Path as P
|
||||||
import qualified StrongPath as SP
|
import StrongPath (File, Path, Rel, (</>))
|
||||||
import Wasp (Wasp)
|
import qualified StrongPath as SP
|
||||||
|
import Wasp (Wasp)
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
import qualified Wasp.Action
|
import qualified Wasp.Action
|
||||||
import qualified Wasp.JsImport
|
import qualified Wasp.JsImport
|
||||||
import qualified Wasp.Operation
|
import qualified Wasp.Operation
|
||||||
import qualified Wasp.Query
|
import qualified Wasp.Query
|
||||||
|
|
||||||
|
|
||||||
genOperations :: Wasp -> [FileDraft]
|
genOperations :: Wasp -> [FileDraft]
|
||||||
genOperations wasp = concat
|
genOperations wasp =
|
||||||
[ genQueries wasp
|
concat
|
||||||
, genActions wasp
|
[ genQueries wasp,
|
||||||
|
genActions wasp
|
||||||
]
|
]
|
||||||
|
|
||||||
genQueries :: Wasp -> [FileDraft]
|
genQueries :: Wasp -> [FileDraft]
|
||||||
genQueries wasp = concat
|
genQueries wasp =
|
||||||
|
concat
|
||||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
||||||
]
|
]
|
||||||
|
|
||||||
genActions :: Wasp -> [FileDraft]
|
genActions :: Wasp -> [FileDraft]
|
||||||
genActions wasp = concat
|
genActions wasp =
|
||||||
|
concat
|
||||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -60,16 +62,18 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
|||||||
tmplData = operationTmplData operation
|
tmplData = operationTmplData operation
|
||||||
|
|
||||||
queryFileInSrcDir :: Wasp.Query.Query -> Path (Rel C.ServerSrcDir) File
|
queryFileInSrcDir :: Wasp.Query.Query -> Path (Rel C.ServerSrcDir) File
|
||||||
queryFileInSrcDir query = SP.fromPathRelFile $
|
queryFileInSrcDir query =
|
||||||
|
SP.fromPathRelFile $
|
||||||
[P.reldir|queries|]
|
[P.reldir|queries|]
|
||||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
-- 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")
|
P.</> fromJust (P.parseRelFile $ Wasp.Query._name query ++ ".js")
|
||||||
|
|
||||||
actionFileInSrcDir :: Wasp.Action.Action -> Path (Rel C.ServerSrcDir) File
|
actionFileInSrcDir :: Wasp.Action.Action -> Path (Rel C.ServerSrcDir) File
|
||||||
actionFileInSrcDir action = SP.fromPathRelFile $
|
actionFileInSrcDir action =
|
||||||
|
SP.fromPathRelFile $
|
||||||
[P.reldir|actions|]
|
[P.reldir|actions|]
|
||||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
-- 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")
|
P.</> fromJust (P.parseRelFile $ Wasp.Action._name action ++ ".js")
|
||||||
|
|
||||||
operationFileInSrcDir :: Wasp.Operation.Operation -> Path (Rel C.ServerSrcDir) File
|
operationFileInSrcDir :: Wasp.Operation.Operation -> Path (Rel C.ServerSrcDir) File
|
||||||
operationFileInSrcDir (Wasp.Operation.QueryOp query) = queryFileInSrcDir query
|
operationFileInSrcDir (Wasp.Operation.QueryOp query) = queryFileInSrcDir query
|
||||||
@ -80,35 +84,39 @@ relPosixPathFromOperationFileToExtSrcDir :: FilePath -- Posix
|
|||||||
relPosixPathFromOperationFileToExtSrcDir = "../ext-src/"
|
relPosixPathFromOperationFileToExtSrcDir = "../ext-src/"
|
||||||
|
|
||||||
operationTmplData :: Wasp.Operation.Operation -> Aeson.Value
|
operationTmplData :: Wasp.Operation.Operation -> Aeson.Value
|
||||||
operationTmplData operation = object
|
operationTmplData operation =
|
||||||
[ "jsFnImportStatement" .= importStmt
|
object
|
||||||
, "jsFnIdentifier" .= importIdentifier
|
[ "jsFnImportStatement" .= importStmt,
|
||||||
, "entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
"jsFnIdentifier" .= importIdentifier,
|
||||||
|
"entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
(importIdentifier, importStmt) =
|
(importIdentifier, importStmt) =
|
||||||
getImportDetailsForOperationUserJsFn operation relPosixPathFromOperationFileToExtSrcDir
|
getImportDetailsForOperationUserJsFn operation relPosixPathFromOperationFileToExtSrcDir
|
||||||
buildEntityData :: String -> Aeson.Value
|
buildEntityData :: String -> Aeson.Value
|
||||||
buildEntityData entityName = object [ "name" .= entityName
|
buildEntityData entityName =
|
||||||
, "prismaIdentifier" .= (toLower (head entityName) : tail 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,
|
-- | 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.
|
-- "user js function" meaning the one provided by user directly to wasp, untouched.
|
||||||
getImportDetailsForOperationUserJsFn
|
getImportDetailsForOperationUserJsFn ::
|
||||||
:: Wasp.Operation.Operation
|
Wasp.Operation.Operation ->
|
||||||
-> FilePath -- ^ Relative posix path from js file where you want to do importing to generated ext code dir.
|
-- | Relative posix path from js file where you want to do importing to generated ext code dir.
|
||||||
-- | (importIdentifier, importStmt)
|
-- | (importIdentifier, importStmt)
|
||||||
-- - importIdentifier -> Identifier via which you can access js function after you import it with 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.
|
-- - importStmt -> Import statement via which you should do the import.
|
||||||
-> (String, String)
|
FilePath ->
|
||||||
|
(String, String)
|
||||||
getImportDetailsForOperationUserJsFn operation relPosixPathToExtCodeDir = (importIdentifier, importStmt)
|
getImportDetailsForOperationUserJsFn operation relPosixPathToExtCodeDir = (importIdentifier, importStmt)
|
||||||
where
|
where
|
||||||
importStmt = "import " ++ importWhat ++ " from '" ++ importFrom ++ "'"
|
importStmt = "import " ++ importWhat ++ " from '" ++ importFrom ++ "'"
|
||||||
importFrom = relPosixPathToExtCodeDir ++ SP.toFilePath (Wasp.JsImport._from jsImport)
|
importFrom = relPosixPathToExtCodeDir ++ SP.toFilePath (Wasp.JsImport._from jsImport)
|
||||||
(importIdentifier, importWhat) =
|
(importIdentifier, importWhat) =
|
||||||
case (Wasp.JsImport._defaultImport jsImport, Wasp.JsImport._namedImports jsImport) of
|
case (Wasp.JsImport._defaultImport jsImport, Wasp.JsImport._namedImports jsImport) of
|
||||||
(Just defaultImport, []) -> (defaultImport, defaultImport)
|
(Just defaultImport, []) -> (defaultImport, defaultImport)
|
||||||
(Nothing, [namedImport]) -> (namedImport, "{ " ++ namedImport ++ " }")
|
(Nothing, [namedImport]) -> (namedImport, "{ " ++ namedImport ++ " }")
|
||||||
_ -> error "Expected either default import or single named import for operation (query/action) js function."
|
_ -> error "Expected either default import or single named import for operation (query/action) js function."
|
||||||
jsImport = Wasp.Operation.getJsFn operation
|
jsImport = Wasp.Operation.getJsFn operation
|
||||||
|
@ -1,63 +1,74 @@
|
|||||||
module Generator.ServerGenerator.OperationsRoutesG
|
module Generator.ServerGenerator.OperationsRoutesG
|
||||||
( genOperationsRoutes
|
( genOperationsRoutes,
|
||||||
, operationRouteInOperationsRouter
|
operationRouteInOperationsRouter,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import Data.Maybe (fromJust, isJust)
|
import Data.Maybe (fromJust, isJust)
|
||||||
import qualified Path as P
|
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 qualified System.FilePath.Posix as FPPosix
|
||||||
|
import qualified Util as U
|
||||||
import Generator.FileDraft (FileDraft)
|
import Wasp (Wasp, getAuth)
|
||||||
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 Wasp
|
import qualified Wasp
|
||||||
import qualified Wasp.Action
|
import qualified Wasp.Action
|
||||||
|
import qualified Wasp.Auth
|
||||||
import qualified Wasp.Operation
|
import qualified Wasp.Operation
|
||||||
import qualified Wasp.Query
|
import qualified Wasp.Query
|
||||||
import qualified Wasp.Auth
|
|
||||||
|
|
||||||
|
|
||||||
genOperationsRoutes :: Wasp -> [FileDraft]
|
genOperationsRoutes :: Wasp -> [FileDraft]
|
||||||
genOperationsRoutes wasp = concat
|
genOperationsRoutes wasp =
|
||||||
[ map (genActionRoute wasp) (Wasp.getActions wasp)
|
concat
|
||||||
, map (genQueryRoute wasp) (Wasp.getQueries wasp)
|
[ map (genActionRoute wasp) (Wasp.getActions wasp),
|
||||||
, [genOperationsRouter wasp]
|
map (genQueryRoute wasp) (Wasp.getQueries wasp),
|
||||||
|
[genOperationsRouter wasp]
|
||||||
]
|
]
|
||||||
|
|
||||||
genActionRoute :: Wasp -> Wasp.Action.Action -> FileDraft
|
genActionRoute :: Wasp -> Wasp.Action.Action -> FileDraft
|
||||||
genActionRoute wasp action = genOperationRoute wasp op tmplFile
|
genActionRoute wasp action = genOperationRoute wasp op tmplFile
|
||||||
where op = Wasp.Operation.ActionOp action
|
where
|
||||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_action.js|]
|
op = Wasp.Operation.ActionOp action
|
||||||
|
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_action.js|]
|
||||||
|
|
||||||
genQueryRoute :: Wasp -> Wasp.Query.Query -> FileDraft
|
genQueryRoute :: Wasp -> Wasp.Query.Query -> FileDraft
|
||||||
genQueryRoute wasp query = genOperationRoute wasp op tmplFile
|
genQueryRoute wasp query = genOperationRoute wasp op tmplFile
|
||||||
where op = Wasp.Operation.QueryOp query
|
where
|
||||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_query.js|]
|
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 -> Wasp.Operation.Operation -> Path (Rel C.ServerTemplatesDir) File -> FileDraft
|
||||||
genOperationRoute wasp operation tmplFile = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genOperationRoute wasp operation tmplFile = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
dstFile = operationsRoutesDirInServerRootDir </> operationRouteFileInOperationsRoutesDir operation
|
dstFile = operationsRoutesDirInServerRootDir </> operationRouteFileInOperationsRoutesDir operation
|
||||||
|
|
||||||
baseTmplData = object
|
baseTmplData =
|
||||||
[ "operationImportPath" .= operationImportPath
|
object
|
||||||
, "operationName" .= Wasp.Operation.getName operation
|
[ "operationImportPath" .= operationImportPath,
|
||||||
|
"operationName" .= Wasp.Operation.getName operation
|
||||||
]
|
]
|
||||||
|
|
||||||
tmplData = case (Wasp.getAuth wasp) of
|
tmplData = case (Wasp.getAuth wasp) of
|
||||||
Nothing -> baseTmplData
|
Nothing -> baseTmplData
|
||||||
Just auth -> U.jsonSet ("userEntityLower")
|
Just auth ->
|
||||||
(Aeson.toJSON (U.toLowerFirst $ Wasp.Auth._userEntity auth))
|
U.jsonSet
|
||||||
baseTmplData
|
("userEntityLower")
|
||||||
|
(Aeson.toJSON (U.toLowerFirst $ Wasp.Auth._userEntity auth))
|
||||||
|
baseTmplData
|
||||||
|
|
||||||
operationImportPath = relPosixPathFromOperationsRoutesDirToSrcDir
|
operationImportPath =
|
||||||
|
relPosixPathFromOperationsRoutesDirToSrcDir
|
||||||
FPPosix.</> SP.toFilePath (SP.relFileToPosix' $ operationFileInSrcDir operation)
|
FPPosix.</> SP.toFilePath (SP.relFileToPosix' $ operationFileInSrcDir operation)
|
||||||
|
|
||||||
data OperationsRoutesDir
|
data OperationsRoutesDir
|
||||||
@ -75,25 +86,26 @@ operationRouteFileInOperationsRoutesDir operation = fromJust $ SP.parseRelFile $
|
|||||||
relPosixPathFromOperationsRoutesDirToSrcDir :: FilePath -- Posix
|
relPosixPathFromOperationsRoutesDirToSrcDir :: FilePath -- Posix
|
||||||
relPosixPathFromOperationsRoutesDirToSrcDir = "../.."
|
relPosixPathFromOperationsRoutesDirToSrcDir = "../.."
|
||||||
|
|
||||||
|
|
||||||
genOperationsRouter :: Wasp -> FileDraft
|
genOperationsRouter :: Wasp -> FileDraft
|
||||||
genOperationsRouter wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genOperationsRouter wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/index.js|]
|
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/index.js|]
|
||||||
dstFile = operationsRoutesDirInServerRootDir </> SP.fromPathRelFile [P.relfile|index.js|]
|
dstFile = operationsRoutesDirInServerRootDir </> SP.fromPathRelFile [P.relfile|index.js|]
|
||||||
operations = map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
operations =
|
||||||
++ map Wasp.Operation.QueryOp (Wasp.getQueries wasp)
|
map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
||||||
tmplData = object
|
++ map Wasp.Operation.QueryOp (Wasp.getQueries wasp)
|
||||||
[ "operationRoutes" .= map makeOperationRoute operations
|
tmplData =
|
||||||
, "isAuthEnabled" .= (isJust $ getAuth wasp)
|
object
|
||||||
|
[ "operationRoutes" .= map makeOperationRoute operations,
|
||||||
|
"isAuthEnabled" .= (isJust $ getAuth wasp)
|
||||||
]
|
]
|
||||||
makeOperationRoute operation =
|
makeOperationRoute operation =
|
||||||
let operationName = Wasp.Operation.getName operation
|
let operationName = Wasp.Operation.getName operation
|
||||||
in object
|
in object
|
||||||
[ "importIdentifier" .= operationName
|
[ "importIdentifier" .= operationName,
|
||||||
, "importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation))
|
"importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation)),
|
||||||
, "routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
"routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
||||||
]
|
]
|
||||||
|
|
||||||
operationRouteInOperationsRouter :: Wasp.Operation.Operation -> String
|
operationRouteInOperationsRouter :: Wasp.Operation.Operation -> String
|
||||||
operationRouteInOperationsRouter = U.camelToKebabCase . Wasp.Operation.getName
|
operationRouteInOperationsRouter = U.camelToKebabCase . Wasp.Operation.getName
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module Generator.ServerGenerator.Setup
|
module Generator.ServerGenerator.Setup
|
||||||
( setupServer
|
( setupServer,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Generator.Job as J
|
import qualified Generator.Job as J
|
||||||
import Generator.Job.Process (runNodeCommandAsJob)
|
import Generator.Job.Process (runNodeCommandAsJob)
|
||||||
import qualified Generator.ServerGenerator.Common as Common
|
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 :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
setupServer projectDir = do
|
setupServer projectDir = do
|
||||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||||
runNodeCommandAsJob serverDir "npm" ["install"] J.Server
|
runNodeCommandAsJob serverDir "npm" ["install"] J.Server
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module Generator.ServerGenerator.Start
|
module Generator.ServerGenerator.Start
|
||||||
( startServer
|
( startServer,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Generator.Job as J
|
import qualified Generator.Job as J
|
||||||
import Generator.Job.Process (runNodeCommandAsJob)
|
import Generator.Job.Process (runNodeCommandAsJob)
|
||||||
import qualified Generator.ServerGenerator.Common as Common
|
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 :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
startServer projectDir = do
|
startServer projectDir = do
|
||||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||||
runNodeCommandAsJob serverDir "npm" ["start"] J.Server
|
runNodeCommandAsJob serverDir "npm" ["start"] J.Server
|
||||||
|
@ -1,47 +1,47 @@
|
|||||||
module Generator.Setup
|
module Generator.Setup
|
||||||
( setup
|
( setup,
|
||||||
) where
|
)
|
||||||
|
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)
|
|
||||||
|
|
||||||
|
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 :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||||
setup projectDir = do
|
setup projectDir = do
|
||||||
chan <- newChan
|
chan <- newChan
|
||||||
let runSetupJobs = concurrently (setupServer projectDir chan) (setupWebApp projectDir chan)
|
let runSetupJobs = concurrently (setupServer projectDir chan) (setupWebApp projectDir chan)
|
||||||
(_, result) <- concurrently (handleJobMessages chan) runSetupJobs
|
(_, result) <- concurrently (handleJobMessages chan) runSetupJobs
|
||||||
case result of
|
case result of
|
||||||
(ExitSuccess, ExitSuccess) -> return $ Right ()
|
(ExitSuccess, ExitSuccess) -> return $ Right ()
|
||||||
exitCodes -> return $ Left $ setupFailedMessage exitCodes
|
exitCodes -> return $ Left $ setupFailedMessage exitCodes
|
||||||
where
|
where
|
||||||
handleJobMessages = go Nothing (False, False)
|
handleJobMessages = go Nothing (False, False)
|
||||||
where
|
where
|
||||||
go :: Maybe J.JobMessage -> (Bool, Bool) -> Chan J.JobMessage -> IO ()
|
go :: Maybe J.JobMessage -> (Bool, Bool) -> Chan J.JobMessage -> IO ()
|
||||||
go _ (True, True) _ = return ()
|
go _ (True, True) _ = return ()
|
||||||
go prevJobMsg (isWebAppDone, isServerDone) chan = do
|
go prevJobMsg (isWebAppDone, isServerDone) chan = do
|
||||||
jobMsg <- readChan chan
|
jobMsg <- readChan chan
|
||||||
case J._data jobMsg of
|
case J._data jobMsg of
|
||||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg
|
J.JobOutput {} ->
|
||||||
>> go (Just jobMsg) (isWebAppDone, isServerDone) chan
|
printPrefixedJobMessage prevJobMsg jobMsg
|
||||||
J.JobExit {} -> case J._jobType jobMsg of
|
>> go (Just jobMsg) (isWebAppDone, isServerDone) chan
|
||||||
J.WebApp -> go (Just jobMsg) (True, isServerDone) chan
|
J.JobExit {} -> case J._jobType jobMsg of
|
||||||
J.Server -> go (Just jobMsg) (isWebAppDone, True) chan
|
J.WebApp -> go (Just jobMsg) (True, isServerDone) chan
|
||||||
J.Db -> error "This should never happen. No db job should be active."
|
J.Server -> go (Just jobMsg) (isWebAppDone, True) chan
|
||||||
|
J.Db -> error "This should never happen. No db job should be active."
|
||||||
|
|
||||||
setupFailedMessage (serverExitCode, webAppExitCode) =
|
setupFailedMessage (serverExitCode, webAppExitCode) =
|
||||||
let serverErrorMessage = case serverExitCode of
|
let serverErrorMessage = case serverExitCode of
|
||||||
ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "."
|
ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "."
|
||||||
_ -> ""
|
_ -> ""
|
||||||
webAppErrorMessage = case webAppExitCode of
|
webAppErrorMessage = case webAppExitCode of
|
||||||
ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "."
|
ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "."
|
||||||
_ -> ""
|
_ -> ""
|
||||||
in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage
|
in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage
|
||||||
|
@ -1,24 +1,23 @@
|
|||||||
module Generator.Start
|
module Generator.Start
|
||||||
( start
|
( start,
|
||||||
) where
|
)
|
||||||
|
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)
|
|
||||||
|
|
||||||
|
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.
|
-- | 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.
|
-- It will run as long as one of those processes does not fail.
|
||||||
start :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
start :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||||
start projectDir = do
|
start projectDir = do
|
||||||
chan <- newChan
|
chan <- newChan
|
||||||
let runStartJobs = race (startServer projectDir chan) (startWebApp projectDir chan)
|
let runStartJobs = race (startServer projectDir chan) (startWebApp projectDir chan)
|
||||||
(_, serverOrWebExitCode) <- concurrently (readJobMessagesAndPrintThemPrefixed chan) runStartJobs
|
(_, serverOrWebExitCode) <- concurrently (readJobMessagesAndPrintThemPrefixed chan) runStartJobs
|
||||||
case serverOrWebExitCode of
|
case serverOrWebExitCode of
|
||||||
Left serverExitCode -> return $ Left $ "Server failed with exit code " ++ show serverExitCode ++ "."
|
Left serverExitCode -> return $ Left $ "Server failed with exit code " ++ show serverExitCode ++ "."
|
||||||
Right webAppExitCode -> return $ Left $ "Web app failed with exit code " ++ show webAppExitCode ++ "."
|
Right webAppExitCode -> return $ Left $ "Web app failed with exit code " ++ show webAppExitCode ++ "."
|
||||||
|
@ -1,21 +1,20 @@
|
|||||||
module Generator.Templates
|
module Generator.Templates
|
||||||
( getTemplatesDirAbsPath
|
( getTemplatesDirAbsPath,
|
||||||
, getTemplateFileAbsPath
|
getTemplateFileAbsPath,
|
||||||
, compileAndRenderTemplate
|
compileAndRenderTemplate,
|
||||||
, TemplatesDir
|
TemplatesDir,
|
||||||
) where
|
)
|
||||||
|
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
|
|
||||||
|
|
||||||
import qualified Data
|
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 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
|
-- TODO: Write tests for this file! But first we need to decouple logic from IO
|
||||||
-- so that we can mock it.
|
-- so that we can mock it.
|
||||||
@ -34,44 +33,49 @@ getTemplateFileAbsPath relTmplFilePath = (</> relTmplFilePath) <$> getTemplatesD
|
|||||||
templatesDirPathInDataDir :: Path (Rel Data.DataDir) (Dir TemplatesDir)
|
templatesDirPathInDataDir :: Path (Rel Data.DataDir) (Dir TemplatesDir)
|
||||||
templatesDirPathInDataDir = SP.fromPathRelDir [P.reldir|Generator/templates|]
|
templatesDirPathInDataDir = SP.fromPathRelDir [P.reldir|Generator/templates|]
|
||||||
|
|
||||||
|
compileAndRenderTemplate ::
|
||||||
compileAndRenderTemplate
|
-- | Path to the template file.
|
||||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
Path (Rel TemplatesDir) File ->
|
||||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
-- | JSON to be provided as template data.
|
||||||
-> IO Text
|
Aeson.Value ->
|
||||||
|
IO Text
|
||||||
compileAndRenderTemplate relTmplPath tmplData = do
|
compileAndRenderTemplate relTmplPath tmplData = do
|
||||||
mustacheTemplate <- compileMustacheTemplate relTmplPath
|
mustacheTemplate <- compileMustacheTemplate relTmplPath
|
||||||
renderMustacheTemplate mustacheTemplate tmplData
|
renderMustacheTemplate mustacheTemplate tmplData
|
||||||
|
|
||||||
compileMustacheTemplate
|
compileMustacheTemplate ::
|
||||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
-- | Path to the template file.
|
||||||
-> IO Mustache.Template
|
Path (Rel TemplatesDir) File ->
|
||||||
|
IO Mustache.Template
|
||||||
compileMustacheTemplate relTmplPath = do
|
compileMustacheTemplate relTmplPath = do
|
||||||
templatesDirAbsPath <- getTemplatesDirAbsPath
|
templatesDirAbsPath <- getTemplatesDirAbsPath
|
||||||
absTmplPath <- getTemplateFileAbsPath relTmplPath
|
absTmplPath <- getTemplateFileAbsPath relTmplPath
|
||||||
eitherTemplate <- Mustache.automaticCompile [SP.toFilePath templatesDirAbsPath]
|
eitherTemplate <-
|
||||||
(SP.toFilePath absTmplPath)
|
Mustache.automaticCompile
|
||||||
return $ either raiseCompileError id eitherTemplate
|
[SP.toFilePath templatesDirAbsPath]
|
||||||
|
(SP.toFilePath absTmplPath)
|
||||||
|
return $ either raiseCompileError id eitherTemplate
|
||||||
where
|
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)
|
printf "Compilation of template %s failed. %s" (show relTmplPath) (show err)
|
||||||
|
|
||||||
areAllErrorsSectionDataNotFound :: [SubstitutionError] -> Bool
|
areAllErrorsSectionDataNotFound :: [SubstitutionError] -> Bool
|
||||||
areAllErrorsSectionDataNotFound = all isSectionDataNotFoundError
|
areAllErrorsSectionDataNotFound = all isSectionDataNotFoundError
|
||||||
where
|
where
|
||||||
isSectionDataNotFoundError e = case e of
|
isSectionDataNotFoundError e = case e of
|
||||||
SectionTargetNotFound _ -> True
|
SectionTargetNotFound _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
renderMustacheTemplate :: Mustache.Template -> Aeson.Value -> IO Text
|
renderMustacheTemplate :: Mustache.Template -> Aeson.Value -> IO Text
|
||||||
renderMustacheTemplate mustacheTemplate templateData = do
|
renderMustacheTemplate mustacheTemplate templateData = do
|
||||||
let mustacheTemplateData = Mustache.toMustache templateData
|
let mustacheTemplateData = Mustache.toMustache templateData
|
||||||
let (errors, fileText) =
|
let (errors, fileText) =
|
||||||
Mustache.checkedSubstituteValue mustacheTemplate mustacheTemplateData
|
Mustache.checkedSubstituteValue mustacheTemplate mustacheTemplateData
|
||||||
|
|
||||||
-- NOTE(matija): Mustache reports errors when object does
|
-- NOTE(matija): Mustache reports errors when object does
|
||||||
-- not have a property specified in the template, which we use to implement
|
-- not have a property specified in the template, which we use to implement
|
||||||
-- conditionals. This is why we ignore these errors.
|
-- conditionals. This is why we ignore these errors.
|
||||||
if null errors || areAllErrorsSectionDataNotFound errors
|
if null errors || areAllErrorsSectionDataNotFound errors
|
||||||
then return fileText
|
then return fileText
|
||||||
else error $ "Unexpected errors occured while rendering template: " ++ show errors
|
else error $ "Unexpected errors occured while rendering template: " ++ show errors
|
||||||
|
@ -1,103 +1,123 @@
|
|||||||
module Generator.WebAppGenerator
|
module Generator.WebAppGenerator
|
||||||
( generateWebApp
|
( generateWebApp,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (ToJSON (..),
|
import CompileOptions (CompileOptions)
|
||||||
object, (.=))
|
import Data.Aeson
|
||||||
import Data.List (intercalate)
|
( ToJSON (..),
|
||||||
import qualified Path as P
|
object,
|
||||||
|
(.=),
|
||||||
import CompileOptions (CompileOptions)
|
)
|
||||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
import Data.List (intercalate)
|
||||||
import Generator.FileDraft
|
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
import Generator.FileDraft
|
||||||
toPackageJsonDependenciesString)
|
import Generator.PackageJsonGenerator
|
||||||
import qualified Generator.WebAppGenerator.AuthG as AuthG
|
( resolveNpmDeps,
|
||||||
import Generator.WebAppGenerator.Common (asTmplFile,
|
toPackageJsonDependenciesString,
|
||||||
asWebAppFile,
|
)
|
||||||
asWebAppSrcFile)
|
import qualified Generator.WebAppGenerator.AuthG as AuthG
|
||||||
import qualified Generator.WebAppGenerator.Common as C
|
import Generator.WebAppGenerator.Common
|
||||||
|
( asTmplFile,
|
||||||
|
asWebAppFile,
|
||||||
|
asWebAppSrcFile,
|
||||||
|
)
|
||||||
|
import qualified Generator.WebAppGenerator.Common as C
|
||||||
import qualified Generator.WebAppGenerator.ExternalCodeGenerator as WebAppExternalCodeGenerator
|
import qualified Generator.WebAppGenerator.ExternalCodeGenerator as WebAppExternalCodeGenerator
|
||||||
import Generator.WebAppGenerator.OperationsGenerator (genOperations)
|
import Generator.WebAppGenerator.OperationsGenerator (genOperations)
|
||||||
import qualified Generator.WebAppGenerator.RouterGenerator as RouterGenerator
|
import qualified Generator.WebAppGenerator.RouterGenerator as RouterGenerator
|
||||||
import qualified NpmDependency as ND
|
import qualified NpmDependency as ND
|
||||||
import StrongPath (Dir, Path,
|
import qualified Path as P
|
||||||
Rel, (</>))
|
import StrongPath
|
||||||
|
( Dir,
|
||||||
|
Path,
|
||||||
|
Rel,
|
||||||
|
(</>),
|
||||||
|
)
|
||||||
import qualified StrongPath as SP
|
import qualified StrongPath as SP
|
||||||
import Wasp
|
import Wasp
|
||||||
import qualified Wasp.App
|
import qualified Wasp.App
|
||||||
import qualified Wasp.NpmDependencies as WND
|
import qualified Wasp.NpmDependencies as WND
|
||||||
|
|
||||||
|
|
||||||
generateWebApp :: Wasp -> CompileOptions -> [FileDraft]
|
generateWebApp :: Wasp -> CompileOptions -> [FileDraft]
|
||||||
generateWebApp wasp _ = concat
|
generateWebApp wasp _ =
|
||||||
[ [generateReadme wasp]
|
concat
|
||||||
, [genPackageJson wasp waspNpmDeps]
|
[ [generateReadme wasp],
|
||||||
, [generateGitignore wasp]
|
[genPackageJson wasp waspNpmDeps],
|
||||||
, generatePublicDir wasp
|
[generateGitignore wasp],
|
||||||
, generateSrcDir wasp
|
generatePublicDir wasp,
|
||||||
, generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp
|
generateSrcDir wasp,
|
||||||
, [C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp,
|
||||||
|
[C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
||||||
]
|
]
|
||||||
|
|
||||||
generateReadme :: Wasp -> FileDraft
|
generateReadme :: Wasp -> FileDraft
|
||||||
generateReadme wasp = C.makeSimpleTemplateFD (asTmplFile [P.relfile|README.md|]) wasp
|
generateReadme wasp = C.makeSimpleTemplateFD (asTmplFile [P.relfile|README.md|]) wasp
|
||||||
|
|
||||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
genPackageJson wasp waspDeps =
|
||||||
|
C.makeTemplateFD
|
||||||
(C.asTmplFile [P.relfile|package.json|])
|
(C.asTmplFile [P.relfile|package.json|])
|
||||||
(C.asWebAppFile [P.relfile|package.json|])
|
(C.asWebAppFile [P.relfile|package.json|])
|
||||||
(Just $ object
|
( Just $
|
||||||
[ "wasp" .= wasp
|
object
|
||||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
[ "wasp" .= wasp,
|
||||||
])
|
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||||
|
]
|
||||||
|
)
|
||||||
where
|
where
|
||||||
(resolvedWaspDeps, resolvedUserDeps) =
|
(resolvedWaspDeps, resolvedUserDeps) =
|
||||||
case resolveNpmDeps waspDeps userDeps of
|
case resolveNpmDeps waspDeps userDeps of
|
||||||
Right deps -> deps
|
Right deps -> deps
|
||||||
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
Left depsAndErrors -> error $ intercalate " ; " $ map snd depsAndErrors
|
||||||
|
|
||||||
userDeps :: [ND.NpmDependency]
|
userDeps :: [ND.NpmDependency]
|
||||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||||
|
|
||||||
waspNpmDeps :: [ND.NpmDependency]
|
waspNpmDeps :: [ND.NpmDependency]
|
||||||
waspNpmDeps = ND.fromList
|
waspNpmDeps =
|
||||||
[ ("axios", "^0.21.1")
|
ND.fromList
|
||||||
, ("lodash", "^4.17.15")
|
[ ("axios", "^0.21.1"),
|
||||||
, ("react", "^16.12.0")
|
("lodash", "^4.17.15"),
|
||||||
, ("react-dom", "^16.12.0")
|
("react", "^16.12.0"),
|
||||||
, ("react-query", "^2.14.1")
|
("react-dom", "^16.12.0"),
|
||||||
, ("react-router-dom", "^5.1.2")
|
("react-query", "^2.14.1"),
|
||||||
, ("react-scripts", "4.0.3")
|
("react-router-dom", "^5.1.2"),
|
||||||
, ("uuid", "^3.4.0")
|
("react-scripts", "4.0.3"),
|
||||||
|
("uuid", "^3.4.0")
|
||||||
]
|
]
|
||||||
|
|
||||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||||
|
|
||||||
generateGitignore :: Wasp -> FileDraft
|
generateGitignore :: Wasp -> FileDraft
|
||||||
generateGitignore wasp = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
generateGitignore wasp =
|
||||||
(asWebAppFile [P.relfile|.gitignore|])
|
C.makeTemplateFD
|
||||||
(Just $ toJSON wasp)
|
(asTmplFile [P.relfile|gitignore|])
|
||||||
|
(asWebAppFile [P.relfile|.gitignore|])
|
||||||
|
(Just $ toJSON wasp)
|
||||||
|
|
||||||
generatePublicDir :: Wasp -> [FileDraft]
|
generatePublicDir :: Wasp -> [FileDraft]
|
||||||
generatePublicDir wasp =
|
generatePublicDir wasp =
|
||||||
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|])
|
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|]) :
|
||||||
: generatePublicIndexHtml wasp
|
generatePublicIndexHtml wasp :
|
||||||
: map (\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
map
|
||||||
[ [P.relfile|manifest.json|]
|
(\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
||||||
]
|
[ [P.relfile|manifest.json|]
|
||||||
|
]
|
||||||
|
|
||||||
generatePublicIndexHtml :: Wasp -> FileDraft
|
generatePublicIndexHtml :: Wasp -> FileDraft
|
||||||
generatePublicIndexHtml wasp = C.makeTemplateFD
|
generatePublicIndexHtml wasp =
|
||||||
(asTmplFile $ [P.relfile|public/index.html|])
|
C.makeTemplateFD
|
||||||
|
(asTmplFile $ [P.relfile|public/index.html|])
|
||||||
targetPath
|
targetPath
|
||||||
(Just templateData)
|
(Just templateData)
|
||||||
where
|
where
|
||||||
targetPath = SP.fromPathRelFile [P.relfile|public/index.html|]
|
targetPath = SP.fromPathRelFile [P.relfile|public/index.html|]
|
||||||
templateData = object
|
templateData =
|
||||||
[ "title" .= (Wasp.App.appTitle $ getApp wasp)
|
object
|
||||||
, "head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
[ "title" .= (Wasp.App.appTitle $ getApp wasp),
|
||||||
]
|
"head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
||||||
|
]
|
||||||
|
|
||||||
-- * Src dir
|
-- * Src dir
|
||||||
|
|
||||||
@ -108,28 +128,34 @@ srcDir = C.webAppSrcDirInWebAppRootDir
|
|||||||
-- although they are not used anywhere outside.
|
-- although they are not used anywhere outside.
|
||||||
-- We could further "templatize" this file so only what is needed is generated.
|
-- 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.
|
-- | Generates api.js file which contains token management and configured api (e.g. axios) instance.
|
||||||
genApi :: FileDraft
|
genApi :: FileDraft
|
||||||
genApi = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/api.js|])
|
genApi = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/api.js|])
|
||||||
|
|
||||||
generateSrcDir :: Wasp -> [FileDraft]
|
generateSrcDir :: Wasp -> [FileDraft]
|
||||||
generateSrcDir wasp
|
generateSrcDir wasp =
|
||||||
= generateLogo
|
generateLogo :
|
||||||
: RouterGenerator.generateRouter wasp
|
RouterGenerator.generateRouter wasp :
|
||||||
: genApi
|
genApi :
|
||||||
: map makeSimpleSrcTemplateFD
|
map
|
||||||
[ [P.relfile|index.js|]
|
makeSimpleSrcTemplateFD
|
||||||
, [P.relfile|index.css|]
|
[ [P.relfile|index.js|],
|
||||||
, [P.relfile|serviceWorker.js|]
|
[P.relfile|index.css|],
|
||||||
, [P.relfile|config.js|]
|
[P.relfile|serviceWorker.js|],
|
||||||
, [P.relfile|queryCache.js|]
|
[P.relfile|config.js|],
|
||||||
]
|
[P.relfile|queryCache.js|]
|
||||||
|
]
|
||||||
++ genOperations wasp
|
++ genOperations wasp
|
||||||
++ AuthG.genAuth wasp
|
++ AuthG.genAuth wasp
|
||||||
where
|
where
|
||||||
generateLogo = C.makeTemplateFD (asTmplFile [P.relfile|src/logo.png|])
|
generateLogo =
|
||||||
(srcDir </> asWebAppSrcFile [P.relfile|logo.png|])
|
C.makeTemplateFD
|
||||||
Nothing
|
(asTmplFile [P.relfile|src/logo.png|])
|
||||||
makeSimpleSrcTemplateFD path = C.makeTemplateFD (asTmplFile $ [P.reldir|src|] P.</> path)
|
(srcDir </> asWebAppSrcFile [P.relfile|logo.png|])
|
||||||
(srcDir </> asWebAppSrcFile path)
|
Nothing
|
||||||
(Just $ toJSON wasp)
|
makeSimpleSrcTemplateFD path =
|
||||||
|
C.makeTemplateFD
|
||||||
|
(asTmplFile $ [P.reldir|src|] P.</> path)
|
||||||
|
(srcDir </> asWebAppSrcFile path)
|
||||||
|
(Just $ toJSON wasp)
|
||||||
|
@ -1,28 +1,29 @@
|
|||||||
module Generator.WebAppGenerator.AuthG
|
module Generator.WebAppGenerator.AuthG
|
||||||
( genAuth
|
( genAuth,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
|
import Generator.FileDraft (FileDraft)
|
||||||
|
import Generator.WebAppGenerator.Common as C
|
||||||
import qualified Path as P
|
import qualified Path as P
|
||||||
|
|
||||||
import StrongPath ((</>))
|
import StrongPath ((</>))
|
||||||
import Wasp (Wasp, getAuth)
|
import Wasp (Wasp, getAuth)
|
||||||
import qualified Wasp.Auth
|
import qualified Wasp.Auth
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import Generator.WebAppGenerator.Common as C
|
|
||||||
|
|
||||||
genAuth :: Wasp -> [FileDraft]
|
genAuth :: Wasp -> [FileDraft]
|
||||||
genAuth wasp = case maybeAuth of
|
genAuth wasp = case maybeAuth of
|
||||||
Just auth -> [ genSignup
|
Just auth ->
|
||||||
, genLogin
|
[ genSignup,
|
||||||
, genLogout
|
genLogin,
|
||||||
, genUseAuth
|
genLogout,
|
||||||
, genCreateAuthRequiredPage auth
|
genUseAuth,
|
||||||
]
|
genCreateAuthRequiredPage auth
|
||||||
++ genAuthForms
|
]
|
||||||
Nothing -> []
|
++ genAuthForms
|
||||||
where
|
Nothing -> []
|
||||||
maybeAuth = getAuth wasp
|
where
|
||||||
|
maybeAuth = getAuth wasp
|
||||||
|
|
||||||
-- | Generates file with signup function to be used by Wasp developer.
|
-- | Generates file with signup function to be used by Wasp developer.
|
||||||
genSignup :: FileDraft
|
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.
|
-- | Generates HOC that handles auth for the given page.
|
||||||
genCreateAuthRequiredPage :: Wasp.Auth.Auth -> FileDraft
|
genCreateAuthRequiredPage :: Wasp.Auth.Auth -> FileDraft
|
||||||
genCreateAuthRequiredPage auth = C.makeTemplateFD
|
genCreateAuthRequiredPage auth =
|
||||||
|
C.makeTemplateFD
|
||||||
(asTmplFile $ [P.reldir|src|] P.</> authReqPagePath)
|
(asTmplFile $ [P.reldir|src|] P.</> authReqPagePath)
|
||||||
targetPath
|
targetPath
|
||||||
(Just templateData)
|
(Just templateData)
|
||||||
where
|
where
|
||||||
authReqPagePath = [P.relfile|auth/pages/createAuthRequiredPage.js|]
|
authReqPagePath = [P.relfile|auth/pages/createAuthRequiredPage.js|]
|
||||||
targetPath = C.webAppSrcDirInWebAppRootDir </> (asWebAppSrcFile authReqPagePath)
|
targetPath = C.webAppSrcDirInWebAppRootDir </> (asWebAppSrcFile authReqPagePath)
|
||||||
templateData = object [ "onAuthFailedRedirectTo" .= (Wasp.Auth._onAuthFailedRedirectTo auth) ]
|
templateData = object ["onAuthFailedRedirectTo" .= (Wasp.Auth._onAuthFailedRedirectTo auth)]
|
||||||
|
|
||||||
-- | Generates React hook that Wasp developer can use in a component to get
|
-- | 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
|
-- 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 :: [FileDraft]
|
||||||
genAuthForms =
|
genAuthForms =
|
||||||
[ genLoginForm
|
[ genLoginForm,
|
||||||
, genSignupForm
|
genSignupForm
|
||||||
]
|
]
|
||||||
|
|
||||||
genLoginForm :: FileDraft
|
genLoginForm :: FileDraft
|
||||||
genLoginForm = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/forms/Login.js|])
|
genLoginForm = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/forms/Login.js|])
|
||||||
|
@ -1,34 +1,34 @@
|
|||||||
module Generator.WebAppGenerator.Common
|
module Generator.WebAppGenerator.Common
|
||||||
( webAppRootDirInProjectRootDir
|
( webAppRootDirInProjectRootDir,
|
||||||
, webAppSrcDirInWebAppRootDir
|
webAppSrcDirInWebAppRootDir,
|
||||||
, copyTmplAsIs
|
copyTmplAsIs,
|
||||||
, makeSimpleTemplateFD
|
makeSimpleTemplateFD,
|
||||||
, makeTemplateFD
|
makeTemplateFD,
|
||||||
, webAppSrcDirInProjectRootDir
|
webAppSrcDirInProjectRootDir,
|
||||||
, webAppTemplatesDirInTemplatesDir
|
webAppTemplatesDirInTemplatesDir,
|
||||||
, asTmplFile
|
asTmplFile,
|
||||||
, asWebAppFile
|
asWebAppFile,
|
||||||
, asWebAppSrcFile
|
asWebAppSrcFile,
|
||||||
, WebAppRootDir
|
WebAppRootDir,
|
||||||
, WebAppSrcDir
|
WebAppSrcDir,
|
||||||
, WebAppTemplatesDir
|
WebAppTemplatesDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
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.Common (ProjectRootDir)
|
||||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||||
import Generator.Templates (TemplatesDir)
|
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 WebAppRootDir
|
||||||
data WebAppSrcDir
|
|
||||||
data WebAppTemplatesDir
|
|
||||||
|
|
||||||
|
data WebAppSrcDir
|
||||||
|
|
||||||
|
data WebAppTemplatesDir
|
||||||
|
|
||||||
asTmplFile :: P.Path P.Rel P.File -> Path (Rel WebAppTemplatesDir) File
|
asTmplFile :: P.Path P.Rel P.File -> Path (Rel WebAppTemplatesDir) File
|
||||||
asTmplFile = SP.fromPathRelFile
|
asTmplFile = SP.fromPathRelFile
|
||||||
@ -39,7 +39,6 @@ asWebAppFile = SP.fromPathRelFile
|
|||||||
asWebAppSrcFile :: P.Path P.Rel P.File -> Path (Rel WebAppSrcDir) File
|
asWebAppSrcFile :: P.Path P.Rel P.File -> Path (Rel WebAppSrcDir) File
|
||||||
asWebAppSrcFile = SP.fromPathRelFile
|
asWebAppSrcFile = SP.fromPathRelFile
|
||||||
|
|
||||||
|
|
||||||
-- * Paths
|
-- * Paths
|
||||||
|
|
||||||
-- | Path where web app root dir is generated, relative to the root directory of the whole generated project.
|
-- | 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 :: Path (Rel ProjectRootDir) (Dir WebAppSrcDir)
|
||||||
webAppSrcDirInProjectRootDir = webAppRootDirInProjectRootDir </> webAppSrcDirInWebAppRootDir
|
webAppSrcDirInProjectRootDir = webAppRootDirInProjectRootDir </> webAppSrcDirInWebAppRootDir
|
||||||
|
|
||||||
|
|
||||||
-- * Templates
|
-- * Templates
|
||||||
|
|
||||||
-- | Path in templates directory where web app templates reside.
|
-- | 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 (Rel WebAppTemplatesDir) File -> Wasp -> FileDraft
|
||||||
makeSimpleTemplateFD path wasp = makeTemplateFD path (SP.castRel path) (Just $ Aeson.toJSON wasp)
|
makeSimpleTemplateFD path wasp = makeTemplateFD path (SP.castRel path) (Just $ Aeson.toJSON wasp)
|
||||||
|
|
||||||
makeTemplateFD
|
makeTemplateFD ::
|
||||||
:: Path (Rel WebAppTemplatesDir) File
|
Path (Rel WebAppTemplatesDir) File ->
|
||||||
-> Path (Rel WebAppRootDir) File
|
Path (Rel WebAppRootDir) File ->
|
||||||
-> Maybe Aeson.Value
|
Maybe Aeson.Value ->
|
||||||
-> FileDraft
|
FileDraft
|
||||||
makeTemplateFD srcPathInWebAppTemplatesDir dstPathInWebAppRootDir tmplData =
|
makeTemplateFD srcPathInWebAppTemplatesDir dstPathInWebAppRootDir tmplData =
|
||||||
createTemplateFileDraft
|
createTemplateFileDraft
|
||||||
(webAppRootDirInProjectRootDir </> dstPathInWebAppRootDir)
|
(webAppRootDirInProjectRootDir </> dstPathInWebAppRootDir)
|
||||||
(webAppTemplatesDirInTemplatesDir </> srcPathInWebAppTemplatesDir)
|
(webAppTemplatesDirInTemplatesDir </> srcPathInWebAppTemplatesDir)
|
||||||
tmplData
|
tmplData
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module Generator.WebAppGenerator.ExternalCodeGenerator
|
module Generator.WebAppGenerator.ExternalCodeGenerator
|
||||||
( extCodeDirInWebAppSrcDir
|
( extCodeDirInWebAppSrcDir,
|
||||||
, generatorStrategy
|
generatorStrategy,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Path as P
|
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||||
|
|
||||||
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.Js (resolveJsFileWaspImportsForExtCodeDir)
|
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 path to directory where external code will be generated.
|
||||||
-- Relative to web app src dir.
|
-- Relative to web app src dir.
|
||||||
@ -17,9 +17,11 @@ extCodeDirInWebAppSrcDir :: Path (Rel C.WebAppSrcDir) (Dir GeneratedExternalCode
|
|||||||
extCodeDirInWebAppSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
extCodeDirInWebAppSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||||
|
|
||||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
generatorStrategy =
|
||||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir)
|
ExternalCodeGeneratorStrategy
|
||||||
, _extCodeDirInProjectRootDir = C.webAppRootDirInProjectRootDir
|
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir),
|
||||||
</> C.webAppSrcDirInWebAppRootDir
|
_extCodeDirInProjectRootDir =
|
||||||
</> extCodeDirInWebAppSrcDir
|
C.webAppRootDirInProjectRootDir
|
||||||
|
</> C.webAppSrcDirInWebAppRootDir
|
||||||
|
</> extCodeDirInWebAppSrcDir
|
||||||
}
|
}
|
||||||
|
@ -1,42 +1,48 @@
|
|||||||
module Generator.WebAppGenerator.OperationsGenerator
|
module Generator.WebAppGenerator.OperationsGenerator
|
||||||
( genOperations
|
( genOperations,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (object,
|
import Data.Aeson
|
||||||
(.=))
|
( object,
|
||||||
import Data.List (intercalate)
|
(.=),
|
||||||
import Data.Maybe (fromJust,
|
)
|
||||||
fromMaybe)
|
import Data.List (intercalate)
|
||||||
import qualified Path as P
|
import Data.Maybe
|
||||||
|
( fromJust,
|
||||||
import Generator.FileDraft (FileDraft)
|
fromMaybe,
|
||||||
import qualified Generator.ServerGenerator as ServerGenerator
|
)
|
||||||
import qualified Generator.ServerGenerator.OperationsRoutesG as ServerOperationsRoutesG
|
import Generator.FileDraft (FileDraft)
|
||||||
import qualified Generator.WebAppGenerator.Common as C
|
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 qualified Generator.WebAppGenerator.OperationsGenerator.ResourcesG as Resources
|
||||||
import Wasp (Wasp)
|
import qualified Path as P
|
||||||
|
import Wasp (Wasp)
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
import qualified Wasp.Action
|
import qualified Wasp.Action
|
||||||
import qualified Wasp.Operation
|
import qualified Wasp.Operation
|
||||||
import qualified Wasp.Query
|
import qualified Wasp.Query
|
||||||
|
|
||||||
|
|
||||||
genOperations :: Wasp -> [FileDraft]
|
genOperations :: Wasp -> [FileDraft]
|
||||||
genOperations wasp = concat
|
genOperations wasp =
|
||||||
[ genQueries wasp
|
concat
|
||||||
, genActions wasp
|
[ genQueries wasp,
|
||||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp]
|
genActions wasp,
|
||||||
, Resources.genResources wasp
|
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp],
|
||||||
|
Resources.genResources wasp
|
||||||
]
|
]
|
||||||
|
|
||||||
genQueries :: Wasp -> [FileDraft]
|
genQueries :: Wasp -> [FileDraft]
|
||||||
genQueries wasp = concat
|
genQueries wasp =
|
||||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
concat
|
||||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
[ map (genQuery wasp) (Wasp.getQueries wasp),
|
||||||
|
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
||||||
]
|
]
|
||||||
|
|
||||||
genActions :: Wasp -> [FileDraft]
|
genActions :: Wasp -> [FileDraft]
|
||||||
genActions wasp = concat
|
genActions wasp =
|
||||||
|
concat
|
||||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -44,14 +50,17 @@ genQuery :: Wasp -> Wasp.Query.Query -> FileDraft
|
|||||||
genQuery _ query = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genQuery _ query = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
tmplFile = C.asTmplFile [P.relfile|src/queries/_query.js|]
|
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)
|
dstFile = C.asWebAppFile $ [P.reldir|src/queries/|] P.</> fromJust (getOperationDstFileName operation)
|
||||||
tmplData = object
|
tmplData =
|
||||||
[ "queryFnName" .= Wasp.Query._name query
|
object
|
||||||
, "queryRoute" .=
|
[ "queryFnName" .= Wasp.Query._name query,
|
||||||
(ServerGenerator.operationsRouteInRootRouter
|
"queryRoute"
|
||||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
++ "/"
|
||||||
|
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||||
|
),
|
||||||
|
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||||
]
|
]
|
||||||
operation = Wasp.Operation.QueryOp query
|
operation = Wasp.Operation.QueryOp query
|
||||||
|
|
||||||
@ -59,14 +68,17 @@ genAction :: Wasp -> Wasp.Action.Action -> FileDraft
|
|||||||
genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||||
where
|
where
|
||||||
tmplFile = C.asTmplFile [P.relfile|src/actions/_action.js|]
|
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)
|
dstFile = C.asWebAppFile $ [P.reldir|src/actions/|] P.</> fromJust (getOperationDstFileName operation)
|
||||||
tmplData = object
|
tmplData =
|
||||||
[ "actionFnName" .= Wasp.Action._name action
|
object
|
||||||
, "actionRoute" .=
|
[ "actionFnName" .= Wasp.Action._name action,
|
||||||
(ServerGenerator.operationsRouteInRootRouter
|
"actionRoute"
|
||||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
++ "/"
|
||||||
|
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||||
|
),
|
||||||
|
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||||
]
|
]
|
||||||
operation = Wasp.Operation.ActionOp action
|
operation = Wasp.Operation.ActionOp action
|
||||||
|
|
||||||
@ -74,7 +86,8 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
|||||||
-- E.g. "['Task', 'Project']"
|
-- E.g. "['Task', 'Project']"
|
||||||
makeJsArrayOfEntityNames :: Wasp.Operation.Operation -> String
|
makeJsArrayOfEntityNames :: Wasp.Operation.Operation -> String
|
||||||
makeJsArrayOfEntityNames operation = "[" ++ intercalate ", " entityStrings ++ "]"
|
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 :: Wasp.Operation.Operation -> Maybe (P.Path P.Rel P.File)
|
||||||
getOperationDstFileName operation = P.parseRelFile (Wasp.Operation.getName operation ++ ".js")
|
getOperationDstFileName operation = P.parseRelFile (Wasp.Operation.getName operation ++ ".js")
|
||||||
|
@ -1,14 +1,13 @@
|
|||||||
module Generator.WebAppGenerator.OperationsGenerator.ResourcesG
|
module Generator.WebAppGenerator.OperationsGenerator.ResourcesG
|
||||||
( genResources
|
( genResources,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson (object)
|
|
||||||
import qualified Path as P
|
|
||||||
|
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import qualified Generator.WebAppGenerator.Common as C
|
|
||||||
import Wasp (Wasp)
|
|
||||||
|
|
||||||
|
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 :: Wasp -> [FileDraft]
|
||||||
genResources _ = [C.makeTemplateFD tmplFile dstFile (Just tmplData)]
|
genResources _ = [C.makeTemplateFD tmplFile dstFile (Just tmplData)]
|
||||||
|
@ -1,118 +1,123 @@
|
|||||||
module Generator.WebAppGenerator.RouterGenerator
|
module Generator.WebAppGenerator.RouterGenerator
|
||||||
( generateRouter
|
( generateRouter,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import qualified Path as P
|
import Generator.FileDraft (FileDraft)
|
||||||
|
import Generator.WebAppGenerator.Common (asTmplFile, asWebAppSrcFile)
|
||||||
import Generator.FileDraft (FileDraft)
|
|
||||||
import Generator.WebAppGenerator.Common (asTmplFile, asWebAppSrcFile)
|
|
||||||
import qualified Generator.WebAppGenerator.Common as C
|
import qualified Generator.WebAppGenerator.Common as C
|
||||||
import StrongPath ((</>))
|
import qualified Path as P
|
||||||
import qualified StrongPath as SP
|
import StrongPath ((</>))
|
||||||
import Wasp (Wasp)
|
import qualified StrongPath as SP
|
||||||
|
import Wasp (Wasp)
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
import qualified Wasp.JsImport
|
import qualified Wasp.JsImport
|
||||||
import qualified Wasp.Page
|
import qualified Wasp.Page
|
||||||
import qualified Wasp.Route
|
import qualified Wasp.Route
|
||||||
|
|
||||||
|
|
||||||
data RouterTemplateData = RouterTemplateData
|
data RouterTemplateData = RouterTemplateData
|
||||||
{ _routes :: ![RouteTemplateData]
|
{ _routes :: ![RouteTemplateData],
|
||||||
, _pagesToImport :: ![PageTemplateData]
|
_pagesToImport :: ![PageTemplateData],
|
||||||
, _isAuthEnabled :: Bool
|
_isAuthEnabled :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ToJSON RouterTemplateData where
|
instance ToJSON RouterTemplateData where
|
||||||
toJSON routerTD = object
|
toJSON routerTD =
|
||||||
[ "routes" .= _routes routerTD
|
object
|
||||||
, "pagesToImport" .= _pagesToImport routerTD
|
[ "routes" .= _routes routerTD,
|
||||||
, "isAuthEnabled" .= _isAuthEnabled routerTD
|
"pagesToImport" .= _pagesToImport routerTD,
|
||||||
]
|
"isAuthEnabled" .= _isAuthEnabled routerTD
|
||||||
|
]
|
||||||
|
|
||||||
data RouteTemplateData = RouteTemplateData
|
data RouteTemplateData = RouteTemplateData
|
||||||
{ _urlPath :: !String
|
{ _urlPath :: !String,
|
||||||
, _targetComponent :: !String
|
_targetComponent :: !String
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ToJSON RouteTemplateData where
|
instance ToJSON RouteTemplateData where
|
||||||
toJSON routeTD = object
|
toJSON routeTD =
|
||||||
[ "urlPath" .= _urlPath routeTD
|
object
|
||||||
, "targetComponent" .= _targetComponent routeTD
|
[ "urlPath" .= _urlPath routeTD,
|
||||||
]
|
"targetComponent" .= _targetComponent routeTD
|
||||||
|
]
|
||||||
|
|
||||||
data PageTemplateData = PageTemplateData
|
data PageTemplateData = PageTemplateData
|
||||||
{ _importWhat :: !String
|
{ _importWhat :: !String,
|
||||||
, _importFrom :: !String
|
_importFrom :: !String
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON PageTemplateData where
|
instance ToJSON PageTemplateData where
|
||||||
toJSON pageTD = object
|
toJSON pageTD =
|
||||||
[ "importWhat" .= _importWhat pageTD
|
object
|
||||||
, "importFrom" .= _importFrom pageTD
|
[ "importWhat" .= _importWhat pageTD,
|
||||||
]
|
"importFrom" .= _importFrom pageTD
|
||||||
|
]
|
||||||
|
|
||||||
generateRouter :: Wasp -> FileDraft
|
generateRouter :: Wasp -> FileDraft
|
||||||
generateRouter wasp = C.makeTemplateFD
|
generateRouter wasp =
|
||||||
|
C.makeTemplateFD
|
||||||
(asTmplFile $ [P.reldir|src|] P.</> routerPath)
|
(asTmplFile $ [P.reldir|src|] P.</> routerPath)
|
||||||
targetPath
|
targetPath
|
||||||
(Just $ toJSON templateData)
|
(Just $ toJSON templateData)
|
||||||
where
|
where
|
||||||
routerPath = [P.relfile|router.js|]
|
routerPath = [P.relfile|router.js|]
|
||||||
templateData = createRouterTemplateData wasp
|
templateData = createRouterTemplateData wasp
|
||||||
targetPath = C.webAppSrcDirInWebAppRootDir </> asWebAppSrcFile routerPath
|
targetPath = C.webAppSrcDirInWebAppRootDir </> asWebAppSrcFile routerPath
|
||||||
|
|
||||||
createRouterTemplateData :: Wasp -> RouterTemplateData
|
createRouterTemplateData :: Wasp -> RouterTemplateData
|
||||||
createRouterTemplateData wasp = RouterTemplateData
|
createRouterTemplateData wasp =
|
||||||
{ _routes = routes
|
RouterTemplateData
|
||||||
, _pagesToImport = pages
|
{ _routes = routes,
|
||||||
, _isAuthEnabled = isJust $ Wasp.getAuth wasp
|
_pagesToImport = pages,
|
||||||
|
_isAuthEnabled = isJust $ Wasp.getAuth wasp
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
routes = map (createRouteTemplateData wasp) $ Wasp.getRoutes wasp
|
routes = map (createRouteTemplateData wasp) $ Wasp.getRoutes wasp
|
||||||
pages = map createPageTemplateData $ Wasp.getPages wasp
|
pages = map createPageTemplateData $ Wasp.getPages wasp
|
||||||
|
|
||||||
createRouteTemplateData :: Wasp -> Wasp.Route.Route -> RouteTemplateData
|
createRouteTemplateData :: Wasp -> Wasp.Route.Route -> RouteTemplateData
|
||||||
createRouteTemplateData wasp route = RouteTemplateData
|
createRouteTemplateData wasp route =
|
||||||
{ _urlPath = Wasp.Route._urlPath route
|
RouteTemplateData
|
||||||
, _targetComponent = determineRouteTargetComponent wasp route
|
{ _urlPath = Wasp.Route._urlPath route,
|
||||||
|
_targetComponent = determineRouteTargetComponent wasp route
|
||||||
}
|
}
|
||||||
|
|
||||||
determineRouteTargetComponent :: Wasp -> Wasp.Route.Route -> String
|
determineRouteTargetComponent :: Wasp -> Wasp.Route.Route -> String
|
||||||
determineRouteTargetComponent wasp route =
|
determineRouteTargetComponent wasp route =
|
||||||
maybe
|
maybe
|
||||||
targetPageName
|
targetPageName
|
||||||
determineRouteTargetComponent'
|
determineRouteTargetComponent'
|
||||||
(Wasp.Page._authRequired targetPage)
|
(Wasp.Page._authRequired targetPage)
|
||||||
where
|
where
|
||||||
targetPageName = Wasp.Route._targetPage route
|
targetPageName = Wasp.Route._targetPage route
|
||||||
-- NOTE(matija): if no page with the name specified in the route, head will fail.
|
-- 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)
|
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
|
|
||||||
|
|
||||||
|
|
||||||
|
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 :: Wasp.Page.Page -> PageTemplateData
|
||||||
createPageTemplateData page = PageTemplateData
|
createPageTemplateData page =
|
||||||
{ _importFrom = relPathToExtSrcDir ++
|
PageTemplateData
|
||||||
SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent)
|
{ _importFrom =
|
||||||
, _importWhat = case Wasp.JsImport._namedImports pageComponent of
|
relPathToExtSrcDir
|
||||||
-- If no named imports, we go with the default import.
|
++ SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent),
|
||||||
[] -> pageName
|
_importWhat = case Wasp.JsImport._namedImports pageComponent of
|
||||||
[namedImport] -> "{ " ++ namedImport ++ " as " ++ pageName ++ " }"
|
-- If no named imports, we go with the default import.
|
||||||
_ -> error "Only one named import can be provided for a page."
|
[] -> pageName
|
||||||
|
[namedImport] -> "{ " ++ namedImport ++ " as " ++ pageName ++ " }"
|
||||||
|
_ -> error "Only one named import can be provided for a page."
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
relPathToExtSrcDir :: FilePath
|
relPathToExtSrcDir :: FilePath
|
||||||
relPathToExtSrcDir = "./ext-src/"
|
relPathToExtSrcDir = "./ext-src/"
|
||||||
|
|
||||||
pageName = Wasp.Page._name page
|
pageName = Wasp.Page._name page
|
||||||
pageComponent = Wasp.Page._component page
|
pageComponent = Wasp.Page._component page
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module Generator.WebAppGenerator.Setup
|
module Generator.WebAppGenerator.Setup
|
||||||
( setupWebApp
|
( setupWebApp,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Generator.Job as J
|
import qualified Generator.Job as J
|
||||||
import Generator.Job.Process (runNodeCommandAsJob)
|
import Generator.Job.Process (runNodeCommandAsJob)
|
||||||
import qualified Generator.WebAppGenerator.Common as Common
|
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 :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
setupWebApp projectDir = do
|
setupWebApp projectDir = do
|
||||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||||
runNodeCommandAsJob webAppDir "npm" ["install"] J.WebApp
|
runNodeCommandAsJob webAppDir "npm" ["install"] J.WebApp
|
||||||
|
@ -1,15 +1,15 @@
|
|||||||
module Generator.WebAppGenerator.Start
|
module Generator.WebAppGenerator.Start
|
||||||
( startWebApp
|
( startWebApp,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Generator.Job as J
|
import qualified Generator.Job as J
|
||||||
import Generator.Job.Process (runNodeCommandAsJob)
|
import Generator.Job.Process (runNodeCommandAsJob)
|
||||||
import qualified Generator.WebAppGenerator.Common as Common
|
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 :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
startWebApp projectDir = do
|
startWebApp projectDir = do
|
||||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||||
runNodeCommandAsJob webAppDir "npm" ["start"] J.WebApp
|
runNodeCommandAsJob webAppDir "npm" ["start"] J.WebApp
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
module Lexer where
|
module Lexer where
|
||||||
|
|
||||||
import Text.Parsec (letter, alphaNum, (<|>), char, between)
|
import Text.Parsec (alphaNum, between, char, letter, (<|>))
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
import Text.Parsec.Language (emptyDef)
|
import Text.Parsec.Language (emptyDef)
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Text.Parsec.Token as Token
|
import qualified Text.Parsec.Token as Token
|
||||||
|
|
||||||
reservedNameImport :: String
|
reservedNameImport :: String
|
||||||
@ -56,32 +56,33 @@ reservedNameBooleanFalse = "false"
|
|||||||
|
|
||||||
reservedNames :: [String]
|
reservedNames :: [String]
|
||||||
reservedNames =
|
reservedNames =
|
||||||
[ reservedNameImport
|
[ reservedNameImport,
|
||||||
, reservedNameFrom
|
reservedNameFrom,
|
||||||
-- Wasp element types
|
-- Wasp element types
|
||||||
, reservedNameApp
|
reservedNameApp,
|
||||||
, reservedNameDependencies
|
reservedNameDependencies,
|
||||||
, reservedNamePage
|
reservedNamePage,
|
||||||
, reservedNameRoute
|
reservedNameRoute,
|
||||||
, reservedNameEntity
|
reservedNameEntity,
|
||||||
, reservedNameAuth
|
reservedNameAuth,
|
||||||
, reservedNameQuery
|
reservedNameQuery,
|
||||||
, reservedNameAction
|
reservedNameAction,
|
||||||
-- Data types
|
-- Data types
|
||||||
, reservedNameString
|
reservedNameString,
|
||||||
, reservedNameBoolean
|
reservedNameBoolean,
|
||||||
, reservedNameBooleanTrue
|
reservedNameBooleanTrue,
|
||||||
, reservedNameBooleanFalse
|
reservedNameBooleanFalse
|
||||||
]
|
]
|
||||||
|
|
||||||
waspLanguageDef :: Token.LanguageDef ()
|
waspLanguageDef :: Token.LanguageDef ()
|
||||||
waspLanguageDef = emptyDef
|
waspLanguageDef =
|
||||||
{ Token.commentLine = "//"
|
emptyDef
|
||||||
, Token.reservedNames = reservedNames
|
{ Token.commentLine = "//",
|
||||||
, Token.caseSensitive = True
|
Token.reservedNames = reservedNames,
|
||||||
-- Identifier
|
Token.caseSensitive = True,
|
||||||
, Token.identStart = letter
|
-- Identifier
|
||||||
, Token.identLetter = alphaNum <|> char '_'
|
Token.identStart = letter,
|
||||||
|
Token.identLetter = alphaNum <|> char '_'
|
||||||
}
|
}
|
||||||
|
|
||||||
waspLexer :: Token.TokenParser ()
|
waspLexer :: Token.TokenParser ()
|
||||||
|
@ -1,72 +1,75 @@
|
|||||||
module Lib
|
module Lib
|
||||||
( compile
|
( compile,
|
||||||
, Generator.setup
|
Generator.setup,
|
||||||
, Generator.start
|
Generator.start,
|
||||||
, ProjectRootDir
|
ProjectRootDir,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Path as P
|
import Common (WaspProjectDir)
|
||||||
import System.Directory (doesFileExist)
|
import CompileOptions (CompileOptions)
|
||||||
|
|
||||||
import Common (WaspProjectDir)
|
|
||||||
import CompileOptions (CompileOptions)
|
|
||||||
import qualified CompileOptions
|
import qualified CompileOptions
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Data.List (find, isSuffixOf)
|
import Data.List (find, isSuffixOf)
|
||||||
import qualified ExternalCode
|
import qualified ExternalCode
|
||||||
import qualified Generator
|
import qualified Generator
|
||||||
import Generator.Common (ProjectRootDir)
|
import Generator.Common (ProjectRootDir)
|
||||||
import qualified Parser
|
import qualified Parser
|
||||||
import StrongPath (Abs, Dir, Path)
|
import qualified Path as P
|
||||||
import qualified StrongPath as SP
|
import StrongPath (Abs, Dir, Path)
|
||||||
|
import qualified StrongPath as SP
|
||||||
|
import System.Directory (doesFileExist)
|
||||||
import qualified Util.IO
|
import qualified Util.IO
|
||||||
import Wasp (Wasp)
|
import Wasp (Wasp)
|
||||||
import qualified Wasp
|
import qualified Wasp
|
||||||
|
|
||||||
|
|
||||||
type CompileError = String
|
type CompileError = String
|
||||||
|
|
||||||
compile :: Path Abs (Dir WaspProjectDir)
|
compile ::
|
||||||
-> Path Abs (Dir ProjectRootDir)
|
Path Abs (Dir WaspProjectDir) ->
|
||||||
-> CompileOptions
|
Path Abs (Dir ProjectRootDir) ->
|
||||||
-> IO (Either CompileError ())
|
CompileOptions ->
|
||||||
|
IO (Either CompileError ())
|
||||||
compile waspDir outDir options = do
|
compile waspDir outDir options = do
|
||||||
maybeWaspFile <- findWaspFile waspDir
|
maybeWaspFile <- findWaspFile waspDir
|
||||||
case maybeWaspFile of
|
case maybeWaspFile of
|
||||||
Nothing -> return $ Left "Couldn't find a single *.wasp file."
|
Nothing -> return $ Left "Couldn't find a single *.wasp file."
|
||||||
Just waspFile -> do
|
Just waspFile -> do
|
||||||
waspStr <- readFile (SP.toFilePath waspFile)
|
waspStr <- readFile (SP.toFilePath waspFile)
|
||||||
|
|
||||||
case Parser.parseWasp waspStr of
|
case Parser.parseWasp waspStr of
|
||||||
Left err -> return $ Left (show err)
|
Left err -> return $ Left (show err)
|
||||||
Right wasp -> do
|
Right wasp -> do
|
||||||
maybeDotEnvFile <- findDotEnvFile waspDir
|
maybeDotEnvFile <- findDotEnvFile waspDir
|
||||||
(wasp
|
( wasp
|
||||||
`Wasp.setDotEnvFile` maybeDotEnvFile
|
`Wasp.setDotEnvFile` maybeDotEnvFile
|
||||||
`enrichWaspASTBasedOnCompileOptions` options
|
`enrichWaspASTBasedOnCompileOptions` options
|
||||||
) >>= generateCode
|
)
|
||||||
|
>>= generateCode
|
||||||
where
|
where
|
||||||
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
||||||
|
|
||||||
enrichWaspASTBasedOnCompileOptions :: Wasp -> CompileOptions -> IO Wasp
|
enrichWaspASTBasedOnCompileOptions :: Wasp -> CompileOptions -> IO Wasp
|
||||||
enrichWaspASTBasedOnCompileOptions wasp options = do
|
enrichWaspASTBasedOnCompileOptions wasp options = do
|
||||||
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
|
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
|
||||||
return (wasp
|
return
|
||||||
`Wasp.setExternalCodeFiles` externalCodeFiles
|
( wasp
|
||||||
`Wasp.setIsBuild` CompileOptions.isBuild options
|
`Wasp.setExternalCodeFiles` externalCodeFiles
|
||||||
)
|
`Wasp.setIsBuild` CompileOptions.isBuild options
|
||||||
|
)
|
||||||
|
|
||||||
findWaspFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
findWaspFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
||||||
findWaspFile waspDir = do
|
findWaspFile waspDir = do
|
||||||
(files, _) <- liftIO $ Util.IO.listDirectory (SP.toPathAbsDir waspDir)
|
(files, _) <- liftIO $ Util.IO.listDirectory (SP.toPathAbsDir waspDir)
|
||||||
return $ (waspDir SP.</>) . SP.fromPathRelFile <$> find isWaspFile files
|
return $ (waspDir SP.</>) . SP.fromPathRelFile <$> find isWaspFile files
|
||||||
where
|
where
|
||||||
isWaspFile :: P.Path P.Rel P.File -> Bool
|
isWaspFile :: P.Path P.Rel P.File -> Bool
|
||||||
isWaspFile path = ".wasp" `isSuffixOf` P.toFilePath path
|
isWaspFile path =
|
||||||
&& (length (P.toFilePath path) > length (".wasp" :: String))
|
".wasp" `isSuffixOf` P.toFilePath path
|
||||||
|
&& (length (P.toFilePath path) > length (".wasp" :: String))
|
||||||
|
|
||||||
findDotEnvFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
findDotEnvFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
||||||
findDotEnvFile waspDir = do
|
findDotEnvFile waspDir = do
|
||||||
let dotEnvAbsPath = waspDir SP.</> SP.fromPathRelFile [P.relfile|.env|]
|
let dotEnvAbsPath = waspDir SP.</> SP.fromPathRelFile [P.relfile|.env|]
|
||||||
dotEnvExists <- doesFileExist (SP.toFilePath dotEnvAbsPath)
|
dotEnvExists <- doesFileExist (SP.toFilePath dotEnvAbsPath)
|
||||||
return $ if dotEnvExists then Just dotEnvAbsPath else Nothing
|
return $ if dotEnvExists then Just dotEnvAbsPath else Nothing
|
||||||
|
@ -1,21 +1,23 @@
|
|||||||
module NpmDependency
|
module NpmDependency
|
||||||
( NpmDependency (..)
|
( NpmDependency (..),
|
||||||
, fromList
|
fromList,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
|
|
||||||
data NpmDependency = NpmDependency
|
data NpmDependency = NpmDependency
|
||||||
{ _name :: !String
|
{ _name :: !String,
|
||||||
, _version :: !String }
|
_version :: !String
|
||||||
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
fromList :: [(String, String)] -> [NpmDependency]
|
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
|
instance ToJSON NpmDependency where
|
||||||
toJSON npmDep = object
|
toJSON npmDep =
|
||||||
[ "name" .= _name npmDep
|
object
|
||||||
, "version" .= _version npmDep
|
[ "name" .= _name npmDep,
|
||||||
]
|
"version" .= _version npmDep
|
||||||
|
]
|
||||||
|
@ -1,30 +1,27 @@
|
|||||||
module Parser
|
module Parser
|
||||||
( parseWasp
|
( parseWasp,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Text.Parsec (ParseError, (<|>), many1, eof, many)
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
|
|
||||||
import qualified Wasp
|
|
||||||
|
|
||||||
import Lexer
|
import Lexer
|
||||||
|
import qualified Parser.Action
|
||||||
import Parser.App (app)
|
import Parser.App (app)
|
||||||
import Parser.Auth (auth)
|
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 Parser.Common (runWaspParser)
|
||||||
import qualified Parser.Query
|
import Parser.Db (db)
|
||||||
import qualified Parser.Action
|
import Parser.Entity (entity)
|
||||||
|
import Parser.JsImport (jsImport)
|
||||||
import qualified Parser.NpmDependencies
|
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 :: Parser Wasp.WaspElement
|
||||||
waspElement
|
waspElement =
|
||||||
= waspElementApp
|
waspElementApp
|
||||||
<|> waspElementAuth
|
<|> waspElementAuth
|
||||||
<|> waspElementPage
|
<|> waspElementPage
|
||||||
<|> waspElementDb
|
<|> waspElementDb
|
||||||
@ -52,7 +49,6 @@ waspElementRoute = Wasp.WaspElementRoute <$> route
|
|||||||
waspElementEntity :: Parser Wasp.WaspElement
|
waspElementEntity :: Parser Wasp.WaspElement
|
||||||
waspElementEntity = Wasp.WaspElementEntity <$> entity
|
waspElementEntity = Wasp.WaspElementEntity <$> entity
|
||||||
|
|
||||||
|
|
||||||
waspElementQuery :: Parser Wasp.WaspElement
|
waspElementQuery :: Parser Wasp.WaspElement
|
||||||
waspElementQuery = Wasp.WaspElementQuery <$> Parser.Query.query
|
waspElementQuery = Wasp.WaspElementQuery <$> Parser.Query.query
|
||||||
|
|
||||||
@ -62,26 +58,25 @@ waspElementAction = Wasp.WaspElementAction <$> Parser.Action.action
|
|||||||
waspElementNpmDependencies :: Parser Wasp.WaspElement
|
waspElementNpmDependencies :: Parser Wasp.WaspElement
|
||||||
waspElementNpmDependencies = Wasp.WaspElementNpmDependencies <$> Parser.NpmDependencies.npmDependencies
|
waspElementNpmDependencies = Wasp.WaspElementNpmDependencies <$> Parser.NpmDependencies.npmDependencies
|
||||||
|
|
||||||
|
|
||||||
-- | Top level parser, produces Wasp.
|
-- | Top level parser, produces Wasp.
|
||||||
waspParser :: Parser Wasp.Wasp
|
waspParser :: Parser Wasp.Wasp
|
||||||
waspParser = do
|
waspParser = do
|
||||||
-- NOTE(matija): this is the only place we need to use whiteSpace, to skip empty lines
|
-- 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
|
-- and comments in the beginning of file. All other used parsers are lexeme parsers
|
||||||
-- so they do it themselves.
|
-- so they do it themselves.
|
||||||
whiteSpace
|
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
|
-- 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.
|
-- e.g. check there is only 1 title - if not, throw a meaningful error.
|
||||||
-- Also, check there is at least one Page defined.
|
-- 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.
|
-- | Top level parser executor.
|
||||||
parseWasp :: String -> Either ParseError Wasp.Wasp
|
parseWasp :: String -> Either ParseError Wasp.Wasp
|
||||||
|
@ -1,23 +1,23 @@
|
|||||||
module Parser.Action
|
module Parser.Action
|
||||||
( action
|
( action,
|
||||||
) where
|
)
|
||||||
|
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
|
|
||||||
|
|
||||||
|
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 :: Parser Action
|
||||||
action = do
|
action = do
|
||||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameAction Operation.properties
|
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameAction Operation.properties
|
||||||
return Action.Action
|
return
|
||||||
{ Action._name = name
|
Action.Action
|
||||||
, Action._jsFunction =
|
{ Action._name = name,
|
||||||
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props)
|
Action._jsFunction =
|
||||||
, Action._entities = Operation.getEntitiesFromProps props
|
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||||
}
|
Action._entities = Operation.getEntitiesFromProps props
|
||||||
|
}
|
||||||
|
@ -1,29 +1,30 @@
|
|||||||
module Parser.App
|
module Parser.App
|
||||||
( app
|
( app,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
|
import Lexer
|
||||||
|
import qualified Lexer as L
|
||||||
|
import Parser.Common
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
import Text.Parsec.String (Parser)
|
import Text.Parsec.String (Parser)
|
||||||
import Data.Maybe (listToMaybe)
|
|
||||||
|
|
||||||
import Lexer
|
|
||||||
import qualified Wasp.App as App
|
import qualified Wasp.App as App
|
||||||
import Parser.Common
|
|
||||||
import qualified Lexer as L
|
|
||||||
|
|
||||||
-- | A type that describes supported app properties.
|
-- | A type that describes supported app properties.
|
||||||
data AppProperty
|
data AppProperty
|
||||||
= Title !String
|
= Title !String
|
||||||
| Favicon !String
|
| Favicon !String
|
||||||
| Head [String]
|
| Head [String]
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Parses supported app properties, expects format "key1: value1, key2: value2, ..."
|
-- | Parses supported app properties, expects format "key1: value1, key2: value2, ..."
|
||||||
appProperties :: Parser [AppProperty]
|
appProperties :: Parser [AppProperty]
|
||||||
appProperties = commaSep1
|
appProperties =
|
||||||
$ appPropertyTitle
|
commaSep1 $
|
||||||
<|> appPropertyFavicon
|
appPropertyTitle
|
||||||
<|> appPropertyHead
|
<|> appPropertyFavicon
|
||||||
|
<|> appPropertyHead
|
||||||
|
|
||||||
appPropertyTitle :: Parser AppProperty
|
appPropertyTitle :: Parser AppProperty
|
||||||
appPropertyTitle = Title <$> waspPropertyStringLiteral "title"
|
appPropertyTitle = Title <$> waspPropertyStringLiteral "title"
|
||||||
@ -45,11 +46,12 @@ getAppHead ps = listToMaybe [hs | Head hs <- ps]
|
|||||||
-- | Top level parser, parses App.
|
-- | Top level parser, parses App.
|
||||||
app :: Parser App.App
|
app :: Parser App.App
|
||||||
app = do
|
app = do
|
||||||
(appName, appProps) <- waspElementNameAndClosureContent reservedNameApp appProperties
|
(appName, appProps) <- waspElementNameAndClosureContent reservedNameApp appProperties
|
||||||
|
|
||||||
return App.App
|
return
|
||||||
{ App.appName = appName
|
App.App
|
||||||
, App.appTitle = getAppTitle appProps
|
{ App.appName = appName,
|
||||||
, App.appHead = getAppHead appProps
|
App.appTitle = getAppTitle appProps,
|
||||||
-- TODO(matija): add favicon.
|
App.appHead = getAppHead appProps
|
||||||
}
|
-- TODO(matija): add favicon.
|
||||||
|
}
|
||||||
|
@ -1,45 +1,47 @@
|
|||||||
module Parser.Auth
|
module Parser.Auth
|
||||||
( auth
|
( auth,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
import Text.Parsec ((<|>))
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
|
||||||
import qualified Wasp.Auth
|
|
||||||
import qualified Parser.Common as P
|
|
||||||
import qualified Lexer as L
|
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 :: Parser Wasp.Auth.Auth
|
||||||
auth = do
|
auth = do
|
||||||
L.reserved L.reservedNameAuth
|
L.reserved L.reservedNameAuth
|
||||||
authProperties <- P.waspClosure (L.commaSep1 authProperty)
|
authProperties <- P.waspClosure (L.commaSep1 authProperty)
|
||||||
|
|
||||||
let userEntityProps = [s | AuthPropertyUserEntity s <- authProperties]
|
let userEntityProps = [s | AuthPropertyUserEntity s <- authProperties]
|
||||||
failIfPropMissing propUserEntityName userEntityProps
|
failIfPropMissing propUserEntityName userEntityProps
|
||||||
|
|
||||||
let methodsProps = [ms | AuthPropertyMethods ms <- authProperties]
|
let methodsProps = [ms | AuthPropertyMethods ms <- authProperties]
|
||||||
failIfPropMissing propMethodsName methodsProps
|
failIfPropMissing propMethodsName methodsProps
|
||||||
|
|
||||||
let redirectProps = [r | AuthPropertyOnAuthFailedRedirectTo r <- authProperties]
|
let redirectProps = [r | AuthPropertyOnAuthFailedRedirectTo r <- authProperties]
|
||||||
failIfPropMissing propOnAuthFailedRedirectToName redirectProps
|
failIfPropMissing propOnAuthFailedRedirectToName redirectProps
|
||||||
|
|
||||||
return Wasp.Auth.Auth
|
return
|
||||||
{ Wasp.Auth._userEntity = head userEntityProps
|
Wasp.Auth.Auth
|
||||||
, Wasp.Auth._methods = head methodsProps
|
{ Wasp.Auth._userEntity = head userEntityProps,
|
||||||
, Wasp.Auth._onAuthFailedRedirectTo = head redirectProps
|
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.
|
-- TODO(matija): this should be extracted if we want to use in other places too.
|
||||||
failIfPropMissing :: (Applicative m, MonadFail m) => String -> [p] -> m ()
|
failIfPropMissing :: (Applicative m, MonadFail m) => String -> [p] -> m ()
|
||||||
failIfPropMissing propName ps = when (null ps) $ fail errorMsg
|
failIfPropMissing propName ps = when (null ps) $ fail errorMsg
|
||||||
where errorMsg = propName ++ " is required!"
|
where
|
||||||
|
errorMsg = propName ++ " is required!"
|
||||||
|
|
||||||
-- Auxiliary data structure used by parser.
|
-- Auxiliary data structure used by parser.
|
||||||
data AuthProperty
|
data AuthProperty
|
||||||
= AuthPropertyUserEntity String
|
= AuthPropertyUserEntity String
|
||||||
| AuthPropertyMethods [Wasp.Auth.AuthMethod]
|
| AuthPropertyMethods [Wasp.Auth.AuthMethod]
|
||||||
| AuthPropertyOnAuthFailedRedirectTo String
|
| AuthPropertyOnAuthFailedRedirectTo String
|
||||||
|
|
||||||
propUserEntityName :: String
|
propUserEntityName :: String
|
||||||
propUserEntityName = "userEntity"
|
propUserEntityName = "userEntity"
|
||||||
@ -53,14 +55,14 @@ propOnAuthFailedRedirectToName = "onAuthFailedRedirectTo"
|
|||||||
-- Sub-parsers
|
-- Sub-parsers
|
||||||
|
|
||||||
authProperty :: Parser AuthProperty
|
authProperty :: Parser AuthProperty
|
||||||
authProperty
|
authProperty =
|
||||||
= authPropertyUserEntity
|
authPropertyUserEntity
|
||||||
<|> authPropertyMethods
|
<|> authPropertyMethods
|
||||||
<|> authPropertyOnAuthFailedRedirectTo
|
<|> authPropertyOnAuthFailedRedirectTo
|
||||||
|
|
||||||
authPropertyOnAuthFailedRedirectTo :: Parser AuthProperty
|
authPropertyOnAuthFailedRedirectTo :: Parser AuthProperty
|
||||||
authPropertyOnAuthFailedRedirectTo =
|
authPropertyOnAuthFailedRedirectTo =
|
||||||
AuthPropertyOnAuthFailedRedirectTo <$> (P.waspPropertyStringLiteral "onAuthFailedRedirectTo")
|
AuthPropertyOnAuthFailedRedirectTo <$> (P.waspPropertyStringLiteral "onAuthFailedRedirectTo")
|
||||||
|
|
||||||
authPropertyUserEntity :: Parser AuthProperty
|
authPropertyUserEntity :: Parser AuthProperty
|
||||||
authPropertyUserEntity = AuthPropertyUserEntity <$> (P.waspProperty "userEntity" L.identifier)
|
authPropertyUserEntity = AuthPropertyUserEntity <$> (P.waspProperty "userEntity" L.identifier)
|
||||||
|
@ -4,15 +4,19 @@
|
|||||||
|
|
||||||
module Parser.Common where
|
module Parser.Common where
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Path as P
|
import qualified Lexer as L
|
||||||
import qualified Path.Posix as PPosix
|
import qualified Path as P
|
||||||
import Text.Parsec (ParseError, anyChar, manyTill, parse, try,
|
import qualified Path.Posix as PPosix
|
||||||
unexpected)
|
import Text.Parsec
|
||||||
import Text.Parsec.String (Parser)
|
( ParseError,
|
||||||
|
anyChar,
|
||||||
import qualified Lexer as L
|
manyTill,
|
||||||
|
parse,
|
||||||
|
try,
|
||||||
|
unexpected,
|
||||||
|
)
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
|
|
||||||
-- | Runs given wasp parser on a specified input.
|
-- | Runs given wasp parser on a specified input.
|
||||||
runWaspParser :: Parser a -> String -> Either ParseError a
|
runWaspParser :: Parser a -> String -> Either ParseError a
|
||||||
@ -24,33 +28,40 @@ runWaspParser waspParser input = parse waspParser sourceName input
|
|||||||
sourceName = ""
|
sourceName = ""
|
||||||
|
|
||||||
-- TODO(matija): rename to just "waspElement"?
|
-- TODO(matija): rename to just "waspElement"?
|
||||||
|
|
||||||
-- | Parses declaration of a wasp element (e.g. App or Page) and the closure content.
|
-- | Parses declaration of a wasp element (e.g. App or Page) and the closure content.
|
||||||
waspElementNameAndClosureContent
|
waspElementNameAndClosureContent ::
|
||||||
:: String -- ^ Type of the wasp element (e.g. "app" or "page").
|
-- | Type of the wasp element (e.g. "app" or "page").
|
||||||
-> Parser a -- ^ Parser to be used for parsing closure content of the wasp element.
|
String ->
|
||||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
-- | 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 =
|
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.
|
-- | Parses declaration of a wasp element (e.g. App or Page) and the belonging closure.
|
||||||
waspElementNameAndClosure
|
waspElementNameAndClosure ::
|
||||||
:: String -- ^ Element type
|
-- | Element type
|
||||||
-> Parser a -- ^ Closure parser (needs to parse braces as well, not just the content)
|
String ->
|
||||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
-- | 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 =
|
waspElementNameAndClosure elementType closure =
|
||||||
-- NOTE(matija): It is important to have `try` here because we don't want to consume the
|
-- NOTE(matija): It is important to have `try` here because we don't want to consume the
|
||||||
-- content intended for other parsers.
|
-- content intended for other parsers.
|
||||||
-- E.g. if we tried to parse "entity-form" this parser would have been tried first for
|
-- 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.
|
-- "entity" and would consume "entity", so entity-form parser would also fail.
|
||||||
-- This way when entity parser fails, it will backtrack and allow
|
-- This way when entity parser fails, it will backtrack and allow
|
||||||
-- entity-form parser to succeed.
|
-- entity-form parser to succeed.
|
||||||
--
|
--
|
||||||
-- TODO(matija): should I push this try higher, to the specific case of entity parser
|
-- TODO(matija): should I push this try higher, to the specific case of entity parser
|
||||||
-- which is causing the trouble?
|
-- which is causing the trouble?
|
||||||
-- This way try will be executed in more cases where it is not neccessary, this
|
-- 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.
|
-- might not be the best for the performance and the clarity of error messages.
|
||||||
-- On the other hand, it is safer?
|
-- On the other hand, it is safer?
|
||||||
try $ do
|
try $ do
|
||||||
L.reserved elementType
|
L.reserved elementType
|
||||||
elementName <- L.identifier
|
elementName <- L.identifier
|
||||||
closureContent <- closure
|
closureContent <- closure
|
||||||
@ -59,16 +70,19 @@ waspElementNameAndClosure elementType closure =
|
|||||||
|
|
||||||
-- | Parses declaration of a wasp element linked to an entity.
|
-- | Parses declaration of a wasp element linked to an entity.
|
||||||
-- E.g. "entity-form<Task> ..." or "action<Task> ..."
|
-- E.g. "entity-form<Task> ..." or "action<Task> ..."
|
||||||
waspElementLinkedToEntity
|
waspElementLinkedToEntity ::
|
||||||
:: String -- ^ Type of the linked wasp element (e.g. "entity-form").
|
-- | Type of the linked wasp element (e.g. "entity-form").
|
||||||
-> Parser a -- ^ Parser to be used for parsing body of the wasp element.
|
String ->
|
||||||
-> Parser (String, String, a) -- ^ Name of the linked entity, element name and body.
|
-- | 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
|
waspElementLinkedToEntity elementType bodyParser = do
|
||||||
L.reserved elementType
|
L.reserved elementType
|
||||||
linkedEntityName <- L.angles L.identifier
|
linkedEntityName <- L.angles L.identifier
|
||||||
elementName <- L.identifier
|
elementName <- L.identifier
|
||||||
body <- bodyParser
|
body <- bodyParser
|
||||||
return (linkedEntityName, elementName, body)
|
return (linkedEntityName, elementName, body)
|
||||||
|
|
||||||
-- | Parses wasp property along with the key, "key: value".
|
-- | Parses wasp property along with the key, "key: value".
|
||||||
waspProperty :: String -> Parser a -> Parser a
|
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.
|
-- form "FIELD_NAME: {...}" -> FIELD_NAME is then an identifier we need.
|
||||||
waspPropertyWithIdentifierAsKey :: Parser a -> Parser (String, a)
|
waspPropertyWithIdentifierAsKey :: Parser a -> Parser (String, a)
|
||||||
waspPropertyWithIdentifierAsKey valueP = do
|
waspPropertyWithIdentifierAsKey valueP = do
|
||||||
identifier <- L.identifier <* L.colon
|
identifier <- L.identifier <* L.colon
|
||||||
value <- valueP
|
value <- valueP
|
||||||
|
|
||||||
return (identifier, value)
|
return (identifier, value)
|
||||||
|
|
||||||
-- | Parses wasp closure, which is {...}. Returns parsed content within the closure.
|
-- | Parses wasp closure, which is {...}. Returns parsed content within the closure.
|
||||||
waspClosure :: Parser a -> Parser a
|
waspClosure :: Parser a -> Parser a
|
||||||
@ -128,14 +142,15 @@ waspCssClosure :: Parser String
|
|||||||
waspCssClosure = waspNamedClosure "css"
|
waspCssClosure = waspNamedClosure "css"
|
||||||
|
|
||||||
-- TODO(martin): write tests and comments.
|
-- TODO(martin): write tests and comments.
|
||||||
|
|
||||||
-- | Parses named wasp closure, which is {=name...name=}. Returns content within the closure.
|
-- | Parses named wasp closure, which is {=name...name=}. Returns content within the closure.
|
||||||
waspNamedClosure :: String -> Parser String
|
waspNamedClosure :: String -> Parser String
|
||||||
waspNamedClosure name = do
|
waspNamedClosure name = do
|
||||||
_ <- closureStart
|
_ <- closureStart
|
||||||
strip <$> manyTill anyChar (try closureEnd)
|
strip <$> manyTill anyChar (try closureEnd)
|
||||||
where
|
where
|
||||||
closureStart = L.symbol ("{=" ++ name)
|
closureStart = L.symbol ("{=" ++ name)
|
||||||
closureEnd = L.symbol (name ++ "=}")
|
closureEnd = L.symbol (name ++ "=}")
|
||||||
|
|
||||||
-- | Parses a list of items that can be parsed with given parser.
|
-- | 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"].
|
-- 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".
|
-- | Parses relative file path, e.g. "my/file.txt".
|
||||||
relFilePathString :: Parser (P.Path P.Rel P.File)
|
relFilePathString :: Parser (P.Path P.Rel P.File)
|
||||||
relFilePathString = do
|
relFilePathString = do
|
||||||
path <- L.stringLiteral
|
path <- L.stringLiteral
|
||||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
maybe
|
||||||
return
|
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||||
(P.parseRelFile path)
|
return
|
||||||
|
(P.parseRelFile path)
|
||||||
|
|
||||||
-- | Parses relative posix file path, e.g. "my/file.txt".
|
-- | Parses relative posix file path, e.g. "my/file.txt".
|
||||||
relPosixFilePathString :: Parser (PPosix.Path PPosix.Rel PPosix.File)
|
relPosixFilePathString :: Parser (PPosix.Path PPosix.Rel PPosix.File)
|
||||||
relPosixFilePathString = do
|
relPosixFilePathString = do
|
||||||
path <- L.stringLiteral
|
path <- L.stringLiteral
|
||||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
maybe
|
||||||
return
|
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||||
(PPosix.parseRelFile path)
|
return
|
||||||
|
(PPosix.parseRelFile path)
|
||||||
|
@ -1,36 +1,40 @@
|
|||||||
module Parser.Db
|
module Parser.Db
|
||||||
( db
|
( db,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Text.Parsec.String (Parser)
|
import Data.Maybe (fromMaybe, listToMaybe)
|
||||||
import Text.Parsec ((<|>), try)
|
|
||||||
import Data.Maybe (listToMaybe, fromMaybe)
|
|
||||||
|
|
||||||
import qualified Wasp.Db
|
|
||||||
import qualified Parser.Common as P
|
|
||||||
import qualified Lexer as L
|
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 :: Parser Wasp.Db.Db
|
||||||
db = do
|
db = do
|
||||||
L.reserved L.reservedNameDb
|
L.reserved L.reservedNameDb
|
||||||
dbProperties <- P.waspClosure (L.commaSep1 dbProperty)
|
dbProperties <- P.waspClosure (L.commaSep1 dbProperty)
|
||||||
|
|
||||||
system <- fromMaybe (fail "'system' property is required!") $ return <$>
|
system <-
|
||||||
listToMaybe [p | DbPropertySystem p <- dbProperties]
|
fromMaybe (fail "'system' property is required!") $
|
||||||
|
return
|
||||||
|
<$> listToMaybe [p | DbPropertySystem p <- dbProperties]
|
||||||
|
|
||||||
return Wasp.Db.Db
|
return
|
||||||
{ Wasp.Db._system = system
|
Wasp.Db.Db
|
||||||
}
|
{ Wasp.Db._system = system
|
||||||
|
}
|
||||||
|
|
||||||
data DbProperty
|
data DbProperty
|
||||||
= DbPropertySystem Wasp.Db.DbSystem
|
= DbPropertySystem Wasp.Db.DbSystem
|
||||||
|
|
||||||
dbProperty :: Parser DbProperty
|
dbProperty :: Parser DbProperty
|
||||||
dbProperty
|
dbProperty =
|
||||||
= dbPropertySystem
|
dbPropertySystem
|
||||||
|
|
||||||
dbPropertySystem :: Parser DbProperty
|
dbPropertySystem :: Parser DbProperty
|
||||||
dbPropertySystem = DbPropertySystem <$> (P.waspProperty "system" dbPropertySystemValue)
|
dbPropertySystem = DbPropertySystem <$> (P.waspProperty "system" dbPropertySystemValue)
|
||||||
where
|
where
|
||||||
dbPropertySystemValue = try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
dbPropertySystemValue =
|
||||||
<|> try (L.symbol "SQLite" >> return Wasp.Db.SQLite)
|
try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
||||||
|
<|> try (L.symbol "SQLite" >> return Wasp.Db.SQLite)
|
||||||
|
@ -1,27 +1,28 @@
|
|||||||
module Parser.Entity
|
module Parser.Entity
|
||||||
( entity
|
( entity,
|
||||||
) where
|
)
|
||||||
|
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 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 :: Parser Entity.Entity
|
||||||
entity = do
|
entity = do
|
||||||
_ <- L.reserved L.reservedNameEntity
|
_ <- L.reserved L.reservedNameEntity
|
||||||
name <- L.identifier
|
name <- L.identifier
|
||||||
_ <- L.symbol "{=psl"
|
_ <- L.symbol "{=psl"
|
||||||
pslModelBody <- Psl.Parser.Model.body
|
pslModelBody <- Psl.Parser.Model.body
|
||||||
_ <- L.symbol "psl=}"
|
_ <- L.symbol "psl=}"
|
||||||
|
|
||||||
return Entity.Entity
|
return
|
||||||
{ Entity._name = name
|
Entity.Entity
|
||||||
, Entity._fields = getEntityFields pslModelBody
|
{ Entity._name = name,
|
||||||
, Entity._pslModelBody = pslModelBody
|
Entity._fields = getEntityFields pslModelBody,
|
||||||
}
|
Entity._pslModelBody = pslModelBody
|
||||||
|
}
|
||||||
|
|
||||||
getEntityFields :: PslModel.Body -> [Entity.Field]
|
getEntityFields :: PslModel.Body -> [Entity.Field]
|
||||||
getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslFields
|
getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslFields
|
||||||
@ -29,35 +30,37 @@ getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslField
|
|||||||
pslFields = [field | (PslModel.ElementField field) <- pslElements]
|
pslFields = [field | (PslModel.ElementField field) <- pslElements]
|
||||||
|
|
||||||
pslFieldToEntityField :: PslModel.Field -> Entity.Field
|
pslFieldToEntityField :: PslModel.Field -> Entity.Field
|
||||||
pslFieldToEntityField pslField = Entity.Field
|
pslFieldToEntityField pslField =
|
||||||
{ Entity._fieldName = PslModel._name pslField
|
Entity.Field
|
||||||
, Entity._fieldType = pslFieldTypeToEntityFieldType
|
{ Entity._fieldName = PslModel._name pslField,
|
||||||
(PslModel._type pslField)
|
Entity._fieldType =
|
||||||
(PslModel._typeModifiers pslField)
|
pslFieldTypeToEntityFieldType
|
||||||
|
(PslModel._type pslField)
|
||||||
|
(PslModel._typeModifiers pslField)
|
||||||
}
|
}
|
||||||
|
|
||||||
pslFieldTypeToEntityFieldType
|
pslFieldTypeToEntityFieldType ::
|
||||||
:: PslModel.FieldType
|
PslModel.FieldType ->
|
||||||
-> [PslModel.FieldTypeModifier]
|
[PslModel.FieldTypeModifier] ->
|
||||||
-> Entity.FieldType
|
Entity.FieldType
|
||||||
pslFieldTypeToEntityFieldType fType fTypeModifiers =
|
pslFieldTypeToEntityFieldType fType fTypeModifiers =
|
||||||
let scalar = pslFieldTypeToScalar fType
|
let scalar = pslFieldTypeToScalar fType
|
||||||
in case fTypeModifiers of
|
in case fTypeModifiers of
|
||||||
[] -> Entity.FieldTypeScalar scalar
|
[] -> Entity.FieldTypeScalar scalar
|
||||||
[PslModel.List] -> Entity.FieldTypeComposite $ Entity.List scalar
|
[PslModel.List] -> Entity.FieldTypeComposite $ Entity.List scalar
|
||||||
[PslModel.Optional] -> Entity.FieldTypeComposite $ Entity.Optional scalar
|
[PslModel.Optional] -> Entity.FieldTypeComposite $ Entity.Optional scalar
|
||||||
_ -> error "Not a valid list of modifiers."
|
_ -> error "Not a valid list of modifiers."
|
||||||
|
|
||||||
pslFieldTypeToScalar :: PslModel.FieldType -> Entity.Scalar
|
pslFieldTypeToScalar :: PslModel.FieldType -> Entity.Scalar
|
||||||
pslFieldTypeToScalar fType = case fType of
|
pslFieldTypeToScalar fType = case fType of
|
||||||
PslModel.String -> Entity.String
|
PslModel.String -> Entity.String
|
||||||
PslModel.Boolean -> Entity.Boolean
|
PslModel.Boolean -> Entity.Boolean
|
||||||
PslModel.Int -> Entity.Int
|
PslModel.Int -> Entity.Int
|
||||||
PslModel.BigInt -> Entity.BigInt
|
PslModel.BigInt -> Entity.BigInt
|
||||||
PslModel.Float -> Entity.Float
|
PslModel.Float -> Entity.Float
|
||||||
PslModel.Decimal -> Entity.Decimal
|
PslModel.Decimal -> Entity.Decimal
|
||||||
PslModel.DateTime -> Entity.DateTime
|
PslModel.DateTime -> Entity.DateTime
|
||||||
PslModel.Json -> Entity.Json
|
PslModel.Json -> Entity.Json
|
||||||
PslModel.Bytes -> Entity.Bytes
|
PslModel.Bytes -> Entity.Bytes
|
||||||
PslModel.UserType typeName -> Entity.UserType typeName
|
PslModel.UserType typeName -> Entity.UserType typeName
|
||||||
PslModel.Unsupported typeName -> Entity.Unsupported typeName
|
PslModel.Unsupported typeName -> Entity.Unsupported typeName
|
||||||
|
@ -1,23 +1,23 @@
|
|||||||
module Parser.ExternalCode
|
module Parser.ExternalCode
|
||||||
( extCodeFilePathString
|
( extCodeFilePathString,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Path.Posix as PPosix
|
import ExternalCode (SourceExternalCodeDir)
|
||||||
import Text.Parsec (unexpected)
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
|
|
||||||
import ExternalCode (SourceExternalCodeDir)
|
|
||||||
import qualified Parser.Common
|
import qualified Parser.Common
|
||||||
import StrongPath (File, Path', Posix, Rel)
|
import qualified Path.Posix as PPosix
|
||||||
import qualified StrongPath as SP
|
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.
|
-- Parses string literal that is file path to file in source external code dir.
|
||||||
-- Returns file path relative to the 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".
|
-- Example of input: "@ext/some/file.txt". Output would be: "some/file.txt".
|
||||||
extCodeFilePathString :: Parser (Path' Posix (Rel SourceExternalCodeDir) File)
|
extCodeFilePathString :: Parser (Path' Posix (Rel SourceExternalCodeDir) File)
|
||||||
extCodeFilePathString = do
|
extCodeFilePathString = do
|
||||||
path <- Parser.Common.relPosixFilePathString
|
path <- Parser.Common.relPosixFilePathString
|
||||||
maybe (unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
maybe
|
||||||
(return . SP.fromPathRelFileP)
|
(unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
||||||
(PPosix.stripProperPrefix [PPosix.reldir|@ext|] path)
|
(return . SP.fromPathRelFileP)
|
||||||
|
(PPosix.stripProperPrefix [PPosix.reldir|@ext|] path)
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
module Parser.JsCode
|
module Parser.JsCode
|
||||||
( jsCode
|
( jsCode,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
import qualified Parser.Common as P
|
import qualified Parser.Common as P
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Wasp.JsCode as WJS
|
import qualified Wasp.JsCode as WJS
|
||||||
|
|
||||||
jsCode :: Parser WJS.JsCode
|
jsCode :: Parser WJS.JsCode
|
||||||
|
@ -1,31 +1,32 @@
|
|||||||
module Parser.JsImport
|
module Parser.JsImport
|
||||||
( jsImport
|
( jsImport,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import qualified Lexer as L
|
||||||
|
import qualified Parser.ExternalCode
|
||||||
import Text.Parsec ((<|>))
|
import Text.Parsec ((<|>))
|
||||||
import Text.Parsec.String (Parser)
|
import Text.Parsec.String (Parser)
|
||||||
|
|
||||||
import qualified Parser.ExternalCode
|
|
||||||
import qualified Lexer as L
|
|
||||||
import qualified Wasp.JsImport
|
import qualified Wasp.JsImport
|
||||||
|
|
||||||
|
|
||||||
-- | Parses subset of JS import statement (only default or single named import, and only external code files):
|
-- | 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/..."
|
||||||
-- import { <identifier> } from "@ext/..."
|
-- import { <identifier> } from "@ext/..."
|
||||||
jsImport :: Parser Wasp.JsImport.JsImport
|
jsImport :: Parser Wasp.JsImport.JsImport
|
||||||
jsImport = do
|
jsImport = do
|
||||||
L.whiteSpace
|
L.whiteSpace
|
||||||
_ <- L.reserved L.reservedNameImport
|
_ <- L.reserved L.reservedNameImport
|
||||||
-- For now we support only default import or one named import.
|
-- For now we support only default import or one named import.
|
||||||
(defaultImport, namedImports) <- ((\i -> (Just i, [])) <$> L.identifier)
|
(defaultImport, namedImports) <-
|
||||||
<|> ((\i -> (Nothing, [i])) <$> L.braces L.identifier)
|
((\i -> (Just i, [])) <$> L.identifier)
|
||||||
_ <- L.reserved L.reservedNameFrom
|
<|> ((\i -> (Nothing, [i])) <$> L.braces L.identifier)
|
||||||
-- TODO: For now we only support double quotes here, we should also support single quotes.
|
_ <- L.reserved L.reservedNameFrom
|
||||||
-- We would need to write this from scratch, with single quote escaping enabled.
|
-- TODO: For now we only support double quotes here, we should also support single quotes.
|
||||||
from <- Parser.ExternalCode.extCodeFilePathString
|
-- We would need to write this from scratch, with single quote escaping enabled.
|
||||||
return Wasp.JsImport.JsImport
|
from <- Parser.ExternalCode.extCodeFilePathString
|
||||||
{ Wasp.JsImport._defaultImport = defaultImport
|
return
|
||||||
, Wasp.JsImport._namedImports = namedImports
|
Wasp.JsImport.JsImport
|
||||||
, Wasp.JsImport._from = from
|
{ Wasp.JsImport._defaultImport = defaultImport,
|
||||||
}
|
Wasp.JsImport._namedImports = namedImports,
|
||||||
|
Wasp.JsImport._from = from
|
||||||
|
}
|
||||||
|
@ -1,31 +1,31 @@
|
|||||||
module Parser.NpmDependencies
|
module Parser.NpmDependencies
|
||||||
( npmDependencies
|
( npmDependencies,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import qualified Data.ByteString.Lazy.UTF8 as BLU
|
import qualified Data.ByteString.Lazy.UTF8 as BLU
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
import Text.Parsec (try)
|
import qualified Lexer as L
|
||||||
import Text.Parsec.String (Parser)
|
import qualified NpmDependency as ND
|
||||||
|
import qualified Parser.Common as P
|
||||||
import qualified Lexer as L
|
import Text.Parsec (try)
|
||||||
import qualified NpmDependency as ND
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Parser.Common as P
|
import Wasp.NpmDependencies (NpmDependencies)
|
||||||
import Wasp.NpmDependencies (NpmDependencies)
|
import qualified Wasp.NpmDependencies as NpmDependencies
|
||||||
import qualified Wasp.NpmDependencies as NpmDependencies
|
|
||||||
|
|
||||||
|
|
||||||
npmDependencies :: Parser NpmDependencies
|
npmDependencies :: Parser NpmDependencies
|
||||||
npmDependencies = try $ do
|
npmDependencies = try $ do
|
||||||
L.reserved L.reservedNameDependencies
|
L.reserved L.reservedNameDependencies
|
||||||
closureContent <- P.waspNamedClosure "json"
|
closureContent <- P.waspNamedClosure "json"
|
||||||
let jsonBytestring = BLU.fromString $ "{ " ++ closureContent ++ " }"
|
let jsonBytestring = BLU.fromString $ "{ " ++ closureContent ++ " }"
|
||||||
npmDeps <- case Aeson.eitherDecode' jsonBytestring :: Either String (M.HashMap String String) of
|
npmDeps <- case Aeson.eitherDecode' jsonBytestring :: Either String (M.HashMap String String) of
|
||||||
Left errorMessage -> fail $ "Failed to parse dependencies JSON: " ++ errorMessage
|
Left errorMessage -> fail $ "Failed to parse dependencies JSON: " ++ errorMessage
|
||||||
Right rawDeps -> return $ map rawDepToNpmDep (M.toList rawDeps)
|
Right rawDeps -> return $ map rawDepToNpmDep (M.toList rawDeps)
|
||||||
return NpmDependencies.NpmDependencies
|
return
|
||||||
{ NpmDependencies._dependencies = npmDeps
|
NpmDependencies.NpmDependencies
|
||||||
}
|
{ NpmDependencies._dependencies = npmDeps
|
||||||
|
}
|
||||||
where
|
where
|
||||||
rawDepToNpmDep :: (String, String) -> ND.NpmDependency
|
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
|
module Parser.Operation
|
||||||
( jsFunctionPropParser
|
( jsFunctionPropParser,
|
||||||
, entitiesPropParser
|
entitiesPropParser,
|
||||||
, getJsFunctionFromProps
|
getJsFunctionFromProps,
|
||||||
, getEntitiesFromProps
|
getEntitiesFromProps,
|
||||||
, properties
|
properties,
|
||||||
-- FOR TESTS:
|
-- FOR TESTS:
|
||||||
, Property(..)
|
Property (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Maybe (listToMaybe)
|
import Data.Maybe (listToMaybe)
|
||||||
import Text.Parsec ((<|>))
|
import qualified Lexer as L
|
||||||
import Text.Parsec.String (Parser)
|
import qualified Parser.Common as C
|
||||||
|
|
||||||
import qualified Lexer as L
|
|
||||||
import qualified Parser.Common as C
|
|
||||||
import qualified Parser.JsImport
|
import qualified Parser.JsImport
|
||||||
|
import Text.Parsec ((<|>))
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Wasp.JsImport
|
import qualified Wasp.JsImport
|
||||||
|
|
||||||
|
data Property
|
||||||
data Property = JsFunction !Wasp.JsImport.JsImport
|
= JsFunction !Wasp.JsImport.JsImport
|
||||||
| Entities ![String]
|
| Entities ![String]
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
properties :: Parser [Property]
|
properties :: Parser [Property]
|
||||||
properties = L.commaSep1 $
|
properties =
|
||||||
|
L.commaSep1 $
|
||||||
jsFunctionPropParser
|
jsFunctionPropParser
|
||||||
<|> entitiesPropParser
|
<|> entitiesPropParser
|
||||||
|
|
||||||
jsFunctionPropParser :: Parser Property
|
jsFunctionPropParser :: Parser Property
|
||||||
jsFunctionPropParser = JsFunction <$> C.waspProperty "fn" Parser.JsImport.jsImport
|
jsFunctionPropParser = JsFunction <$> C.waspProperty "fn" Parser.JsImport.jsImport
|
||||||
|
@ -1,30 +1,30 @@
|
|||||||
module Parser.Page
|
module Parser.Page
|
||||||
( page
|
( page,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Text.Parsec
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
import Data.Maybe (listToMaybe, fromMaybe)
|
|
||||||
|
|
||||||
import qualified Wasp.Page as Page
|
|
||||||
import Wasp.JsImport (JsImport)
|
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe, listToMaybe)
|
||||||
import Lexer
|
import Lexer
|
||||||
import Parser.Common
|
import Parser.Common
|
||||||
import qualified Parser.JsImport
|
import qualified Parser.JsImport
|
||||||
|
import Text.Parsec
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
|
import Wasp.JsImport (JsImport)
|
||||||
|
import qualified Wasp.Page as Page
|
||||||
|
|
||||||
data PageProperty
|
data PageProperty
|
||||||
= Title !String
|
= Title !String
|
||||||
| Component !JsImport
|
| Component !JsImport
|
||||||
| AuthRequired !Bool
|
| AuthRequired !Bool
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- | Parses Page properties, separated by a comma.
|
-- | Parses Page properties, separated by a comma.
|
||||||
pageProperties :: Parser [PageProperty]
|
pageProperties :: Parser [PageProperty]
|
||||||
pageProperties = commaSep1 $
|
pageProperties =
|
||||||
|
commaSep1 $
|
||||||
pagePropertyTitle
|
pagePropertyTitle
|
||||||
<|> pagePropertyComponent
|
<|> pagePropertyComponent
|
||||||
<|> pagePropertyAuthRequired
|
<|> pagePropertyAuthRequired
|
||||||
|
|
||||||
-- NOTE(matija): this is currently unused?
|
-- NOTE(matija): this is currently unused?
|
||||||
pagePropertyTitle :: Parser PageProperty
|
pagePropertyTitle :: Parser PageProperty
|
||||||
@ -45,10 +45,11 @@ getPageComponent ps = listToMaybe [c | Component c <- ps]
|
|||||||
-- | Top level parser, parses Page.
|
-- | Top level parser, parses Page.
|
||||||
page :: Parser Page.Page
|
page :: Parser Page.Page
|
||||||
page = do
|
page = do
|
||||||
(pageName, pageProps) <- waspElementNameAndClosureContent reservedNamePage pageProperties
|
(pageName, pageProps) <- waspElementNameAndClosureContent reservedNamePage pageProperties
|
||||||
|
|
||||||
return Page.Page
|
return
|
||||||
{ Page._name = pageName
|
Page.Page
|
||||||
, Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps)
|
{ Page._name = pageName,
|
||||||
, Page._authRequired = getPageAuthRequired pageProps
|
Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps),
|
||||||
}
|
Page._authRequired = getPageAuthRequired pageProps
|
||||||
|
}
|
||||||
|
@ -1,23 +1,23 @@
|
|||||||
module Parser.Query
|
module Parser.Query
|
||||||
( query
|
( query,
|
||||||
) where
|
)
|
||||||
|
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
|
|
||||||
|
|
||||||
|
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 :: Parser Query
|
||||||
query = do
|
query = do
|
||||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameQuery Operation.properties
|
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameQuery Operation.properties
|
||||||
return Query.Query
|
return
|
||||||
{ Query._name = name
|
Query.Query
|
||||||
, Query._jsFunction =
|
{ Query._name = name,
|
||||||
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props)
|
Query._jsFunction =
|
||||||
, Query._entities = Operation.getEntitiesFromProps props
|
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||||
}
|
Query._entities = Operation.getEntitiesFromProps props
|
||||||
|
}
|
||||||
|
@ -1,26 +1,26 @@
|
|||||||
module Parser.Route
|
module Parser.Route
|
||||||
( route
|
( route,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
|
|
||||||
import qualified Lexer as L
|
import qualified Lexer as L
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Wasp.Route as Route
|
import qualified Wasp.Route as Route
|
||||||
|
|
||||||
-- | Top level parser, parses route Wasp element.
|
-- | Top level parser, parses route Wasp element.
|
||||||
route :: Parser Route.Route
|
route :: Parser Route.Route
|
||||||
route = do
|
route = do
|
||||||
-- route "some/url/path"
|
-- route "some/url/path"
|
||||||
L.reserved L.reservedNameRoute
|
L.reserved L.reservedNameRoute
|
||||||
urlPath <- L.stringLiteral
|
urlPath <- L.stringLiteral
|
||||||
|
|
||||||
-- -> page somePage
|
-- -> page somePage
|
||||||
L.reserved "->"
|
L.reserved "->"
|
||||||
L.reserved L.reservedNamePage
|
L.reserved L.reservedNamePage
|
||||||
targetPage <- L.identifier
|
targetPage <- L.identifier
|
||||||
|
|
||||||
return Route.Route
|
|
||||||
{ Route._urlPath = urlPath
|
|
||||||
, Route._targetPage = targetPage
|
|
||||||
}
|
|
||||||
|
|
||||||
|
return
|
||||||
|
Route.Route
|
||||||
|
{ Route._urlPath = urlPath,
|
||||||
|
Route._targetPage = targetPage
|
||||||
|
}
|
||||||
|
@ -1,16 +1,15 @@
|
|||||||
module Parser.Style
|
module Parser.Style
|
||||||
( style
|
( style,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Text.Parsec ((<|>))
|
|
||||||
import Text.Parsec.String (Parser)
|
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
import qualified Parser.Common
|
import qualified Parser.Common
|
||||||
import qualified Parser.ExternalCode
|
import qualified Parser.ExternalCode
|
||||||
|
import Text.Parsec ((<|>))
|
||||||
|
import Text.Parsec.String (Parser)
|
||||||
import qualified Wasp.Style
|
import qualified Wasp.Style
|
||||||
|
|
||||||
|
|
||||||
style :: Parser Wasp.Style.Style
|
style :: Parser Wasp.Style.Style
|
||||||
style = cssFile <|> cssCode
|
style = cssFile <|> cssCode
|
||||||
|
|
||||||
|
@ -1,11 +1,12 @@
|
|||||||
module Path.Extra
|
module Path.Extra
|
||||||
( reversePosixPath
|
( reversePosixPath,
|
||||||
, toPosixFilePath
|
toPosixFilePath,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Control.Exception (assert)
|
import Control.Exception (assert)
|
||||||
import qualified System.FilePath.Posix as FPP
|
|
||||||
import Path
|
import Path
|
||||||
|
import qualified System.FilePath.Posix as FPP
|
||||||
|
|
||||||
-- | For given posix path P, returns posix path P', such that (terminal pseudocode incoming)
|
-- | 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
|
-- `pwd == (cd P && cd P' && pwd)`, or to put it differently, such that
|
||||||
@ -14,9 +15,10 @@ import Path
|
|||||||
-- (e.g. reversePath "foo/bar" == "../..").
|
-- (e.g. reversePath "foo/bar" == "../..").
|
||||||
reversePosixPath :: FilePath -> FilePath
|
reversePosixPath :: FilePath -> FilePath
|
||||||
reversePosixPath path
|
reversePosixPath path
|
||||||
| null parts = "."
|
| null parts = "."
|
||||||
| otherwise = assert (".." `notElem` parts) $
|
| otherwise =
|
||||||
FPP.joinPath $ map (const "..") parts
|
assert (".." `notElem` parts) $
|
||||||
|
FPP.joinPath $ map (const "..") parts
|
||||||
where
|
where
|
||||||
parts :: [String]
|
parts :: [String]
|
||||||
parts = filter (/= ".") $ FPP.splitDirectories path
|
parts = filter (/= ".") $ FPP.splitDirectories path
|
||||||
|
@ -1,42 +1,45 @@
|
|||||||
module Psl.Ast.Model where
|
module Psl.Ast.Model where
|
||||||
|
|
||||||
data Model = Model
|
data Model
|
||||||
String -- ^ Name of the model
|
= Model
|
||||||
Body
|
String
|
||||||
deriving (Show, Eq)
|
-- ^ Name of the model
|
||||||
|
Body
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
newtype Body = Body [Element]
|
newtype Body = Body [Element]
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Element = ElementField Field | ElementBlockAttribute Attribute
|
data Element = ElementField Field | ElementBlockAttribute Attribute
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- TODO: To support attributes before the field,
|
-- TODO: To support attributes before the field,
|
||||||
-- we could just have `attrsBefore :: [[Attr]]`,
|
-- we could just have `attrsBefore :: [[Attr]]`,
|
||||||
-- which represents lines, each one with list of attributes.
|
-- which represents lines, each one with list of attributes.
|
||||||
data Field = Field
|
data Field = Field
|
||||||
{ _name :: String
|
{ _name :: String,
|
||||||
, _type :: FieldType
|
_type :: FieldType,
|
||||||
, _typeModifiers :: [FieldTypeModifier]
|
_typeModifiers :: [FieldTypeModifier],
|
||||||
, _attrs :: [Attribute]
|
_attrs :: [Attribute]
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data FieldType = String
|
data FieldType
|
||||||
| Boolean
|
= String
|
||||||
| Int
|
| Boolean
|
||||||
| BigInt
|
| Int
|
||||||
| Float
|
| BigInt
|
||||||
| Decimal
|
| Float
|
||||||
| DateTime
|
| Decimal
|
||||||
| Json
|
| DateTime
|
||||||
| Bytes
|
| Json
|
||||||
| Unsupported String
|
| Bytes
|
||||||
| UserType String
|
| Unsupported String
|
||||||
deriving (Show, Eq)
|
| UserType String
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data FieldTypeModifier = List | Optional
|
data FieldTypeModifier = List | Optional
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- NOTE: We don't differentiate "native database type" attributes from normal attributes right now,
|
-- NOTE: We don't differentiate "native database type" attributes from normal attributes right now,
|
||||||
-- they are all represented with `data Attribute`.
|
-- 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
|
-- 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.
|
-- for them -> but let's see if that will be needed.
|
||||||
data Attribute = Attribute
|
data Attribute = Attribute
|
||||||
{ _attrName :: String
|
{ _attrName :: String,
|
||||||
, _attrArgs :: [AttributeArg]
|
_attrArgs :: [AttributeArg]
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data AttributeArg = AttrArgNamed String AttrArgValue | AttrArgUnnamed AttrArgValue
|
data AttributeArg = AttrArgNamed String AttrArgValue | AttrArgUnnamed AttrArgValue
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data AttrArgValue
|
data AttrArgValue
|
||||||
= AttrArgString String
|
= AttrArgString String
|
||||||
| AttrArgIdentifier String
|
| AttrArgIdentifier String
|
||||||
| AttrArgFunc String
|
| AttrArgFunc String
|
||||||
| AttrArgFieldRefList [String]
|
| AttrArgFieldRefList [String]
|
||||||
| AttrArgNumber String
|
| AttrArgNumber String
|
||||||
| AttrArgUnknown String
|
| AttrArgUnknown String
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
@ -1,12 +1,11 @@
|
|||||||
module Psl.Generator.Model
|
module Psl.Generator.Model
|
||||||
( generateModel
|
( generateModel,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.List (intercalate)
|
|
||||||
|
|
||||||
|
import Data.List (intercalate)
|
||||||
import qualified Psl.Ast.Model as Ast
|
import qualified Psl.Ast.Model as Ast
|
||||||
|
|
||||||
|
|
||||||
generateModel :: Ast.Model -> String
|
generateModel :: Ast.Model -> String
|
||||||
generateModel (Ast.Model name body) = "model " ++ name ++ " {\n" ++ generateBody body ++ "\n}"
|
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.Element -> String
|
||||||
generateElement (Ast.ElementField field) =
|
generateElement (Ast.ElementField field) =
|
||||||
Ast._name field ++ " "
|
Ast._name field ++ " "
|
||||||
++ generateFieldType (Ast._type field) ++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
++ generateFieldType (Ast._type field)
|
||||||
|
++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
||||||
++ concatMap ((" " ++) . generateAttribute) (Ast._attrs field)
|
++ concatMap ((" " ++) . generateAttribute) (Ast._attrs field)
|
||||||
generateElement (Ast.ElementBlockAttribute attribute) =
|
generateElement (Ast.ElementBlockAttribute attribute) =
|
||||||
"@" ++ generateAttribute attribute
|
"@" ++ generateAttribute attribute
|
||||||
|
|
||||||
generateFieldType :: Ast.FieldType -> String
|
generateFieldType :: Ast.FieldType -> String
|
||||||
generateFieldType fieldType = case fieldType of
|
generateFieldType fieldType = case fieldType of
|
||||||
Ast.String -> "String"
|
Ast.String -> "String"
|
||||||
Ast.Boolean -> "Boolean"
|
Ast.Boolean -> "Boolean"
|
||||||
Ast.Int -> "Int"
|
Ast.Int -> "Int"
|
||||||
Ast.BigInt -> "BigInt"
|
Ast.BigInt -> "BigInt"
|
||||||
Ast.Float -> "Float"
|
Ast.Float -> "Float"
|
||||||
Ast.Decimal -> "Decimal"
|
Ast.Decimal -> "Decimal"
|
||||||
Ast.DateTime -> "DateTime"
|
Ast.DateTime -> "DateTime"
|
||||||
Ast.Json -> "Json"
|
Ast.Json -> "Json"
|
||||||
Ast.Bytes -> "Bytes"
|
Ast.Bytes -> "Bytes"
|
||||||
Ast.UserType label -> label
|
Ast.UserType label -> label
|
||||||
Ast.Unsupported typeName -> "Unsupported(" ++ show typeName ++ ")"
|
Ast.Unsupported typeName -> "Unsupported(" ++ show typeName ++ ")"
|
||||||
|
|
||||||
generateFieldTypeModifier :: Ast.FieldTypeModifier -> String
|
generateFieldTypeModifier :: Ast.FieldTypeModifier -> String
|
||||||
generateFieldTypeModifier typeModifier = case typeModifier of
|
generateFieldTypeModifier typeModifier = case typeModifier of
|
||||||
Ast.List -> "[]"
|
Ast.List -> "[]"
|
||||||
Ast.Optional -> "?"
|
Ast.Optional -> "?"
|
||||||
|
|
||||||
generateAttribute :: Ast.Attribute -> String
|
generateAttribute :: Ast.Attribute -> String
|
||||||
generateAttribute attribute =
|
generateAttribute attribute =
|
||||||
"@" ++ Ast._attrName attribute
|
"@" ++ Ast._attrName attribute
|
||||||
++ if null (Ast._attrArgs attribute)
|
++ if null (Ast._attrArgs attribute)
|
||||||
then ""
|
then ""
|
||||||
else "(" ++ intercalate ", " (map generateAttributeArg (Ast._attrArgs attribute)) ++ ")"
|
else "(" ++ intercalate ", " (map generateAttributeArg (Ast._attrArgs attribute)) ++ ")"
|
||||||
|
|
||||||
generateAttributeArg :: Ast.AttributeArg -> String
|
generateAttributeArg :: Ast.AttributeArg -> String
|
||||||
generateAttributeArg (Ast.AttrArgNamed name value) = name ++ ": " ++ generateAttrArgValue value
|
generateAttributeArg (Ast.AttrArgNamed name value) = name ++ ": " ++ generateAttrArgValue value
|
||||||
@ -53,12 +53,12 @@ generateAttributeArg (Ast.AttrArgUnnamed value) = generateAttrArgValue value
|
|||||||
|
|
||||||
generateAttrArgValue :: Ast.AttrArgValue -> String
|
generateAttrArgValue :: Ast.AttrArgValue -> String
|
||||||
generateAttrArgValue value = case value of
|
generateAttrArgValue value = case value of
|
||||||
Ast.AttrArgString strValue -> show strValue
|
Ast.AttrArgString strValue -> show strValue
|
||||||
Ast.AttrArgIdentifier identifier -> identifier
|
Ast.AttrArgIdentifier identifier -> identifier
|
||||||
Ast.AttrArgFunc funcName -> funcName ++ "()"
|
Ast.AttrArgFunc funcName -> funcName ++ "()"
|
||||||
Ast.AttrArgFieldRefList refs -> "[" ++ intercalate ", " refs ++ "]"
|
Ast.AttrArgFieldRefList refs -> "[" ++ intercalate ", " refs ++ "]"
|
||||||
Ast.AttrArgNumber numberStr -> numberStr
|
Ast.AttrArgNumber numberStr -> numberStr
|
||||||
Ast.AttrArgUnknown unknownStr -> unknownStr
|
Ast.AttrArgUnknown unknownStr -> unknownStr
|
||||||
|
|
||||||
-- TODO: I should make sure to skip attributes that are not known in prisma.
|
-- 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
|
-- Or maybe it would be better if that was done in previous step, where
|
||||||
|
@ -1,19 +1,30 @@
|
|||||||
module Psl.Parser.Model
|
module Psl.Parser.Model
|
||||||
( model
|
( model,
|
||||||
, body
|
body,
|
||||||
-- NOTE: Only for testing:
|
-- NOTE: Only for testing:
|
||||||
, attrArgument
|
attrArgument,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Maybe (fromMaybe, maybeToList)
|
import Data.Maybe (fromMaybe, maybeToList)
|
||||||
import Text.Parsec (alphaNum, char, choice, letter,
|
import qualified Psl.Ast.Model as Model
|
||||||
lookAhead, many, many1, noneOf, oneOf,
|
import Text.Parsec
|
||||||
optionMaybe, try, (<|>))
|
( alphaNum,
|
||||||
import Text.Parsec.Language (emptyDef)
|
char,
|
||||||
import Text.Parsec.String (Parser)
|
choice,
|
||||||
import qualified Text.Parsec.Token as T
|
letter,
|
||||||
|
lookAhead,
|
||||||
import qualified Psl.Ast.Model as Model
|
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).
|
-- | Parses PSL (Prisma Schema Language model).
|
||||||
-- Example of PSL model:
|
-- Example of PSL model:
|
||||||
@ -24,123 +35,133 @@ import qualified Psl.Ast.Model as Model
|
|||||||
-- }
|
-- }
|
||||||
model :: Parser Model.Model
|
model :: Parser Model.Model
|
||||||
model = do
|
model = do
|
||||||
T.whiteSpace lexer
|
T.whiteSpace lexer
|
||||||
_ <- T.symbol lexer "model"
|
_ <- T.symbol lexer "model"
|
||||||
modelName <- T.identifier lexer
|
modelName <- T.identifier lexer
|
||||||
Model.Model modelName <$> T.braces lexer body
|
Model.Model modelName <$> T.braces lexer body
|
||||||
|
|
||||||
-- | Parses body of the PSL (Prisma Schema Language) model,
|
-- | Parses body of the PSL (Prisma Schema Language) model,
|
||||||
-- which is everything besides model keyword, name and braces:
|
-- which is everything besides model keyword, name and braces:
|
||||||
-- `model User { <body> }`.
|
-- `model User { <body> }`.
|
||||||
body :: Parser Model.Body
|
body :: Parser Model.Body
|
||||||
body = do
|
body = do
|
||||||
T.whiteSpace lexer
|
T.whiteSpace lexer
|
||||||
Model.Body <$> many1 element
|
Model.Body <$> many1 element
|
||||||
|
|
||||||
element :: Parser Model.Element
|
element :: Parser Model.Element
|
||||||
element = try (Model.ElementField <$> field) <|>
|
element =
|
||||||
try (Model.ElementBlockAttribute <$> blockAttribute)
|
try (Model.ElementField <$> field)
|
||||||
|
<|> try (Model.ElementBlockAttribute <$> blockAttribute)
|
||||||
|
|
||||||
field :: Parser Model.Field
|
field :: Parser Model.Field
|
||||||
field = do
|
field = do
|
||||||
name <- T.identifier lexer
|
name <- T.identifier lexer
|
||||||
type' <- fieldType
|
type' <- fieldType
|
||||||
maybeTypeModifier <- fieldTypeModifier
|
maybeTypeModifier <- fieldTypeModifier
|
||||||
attrs <- many (try attribute)
|
attrs <- many (try attribute)
|
||||||
return $ Model.Field
|
return $
|
||||||
{ Model._name = name
|
Model.Field
|
||||||
, Model._type = type'
|
{ Model._name = name,
|
||||||
, Model._typeModifiers = maybeToList maybeTypeModifier
|
Model._type = type',
|
||||||
, Model._attrs = attrs
|
Model._typeModifiers = maybeToList maybeTypeModifier,
|
||||||
}
|
Model._attrs = attrs
|
||||||
|
}
|
||||||
where
|
where
|
||||||
fieldType :: Parser Model.FieldType
|
fieldType :: Parser Model.FieldType
|
||||||
fieldType =
|
fieldType =
|
||||||
(foldl1 (<|>) $
|
( foldl1 (<|>) $
|
||||||
map (\(s, t) -> try (T.symbol lexer s) >> return t)
|
map
|
||||||
[ ("String", Model.String)
|
(\(s, t) -> try (T.symbol lexer s) >> return t)
|
||||||
, ("Boolean", Model.Boolean)
|
[ ("String", Model.String),
|
||||||
, ("Int", Model.Int)
|
("Boolean", Model.Boolean),
|
||||||
, ("BigInt", Model.BigInt)
|
("Int", Model.Int),
|
||||||
, ("Float", Model.Float)
|
("BigInt", Model.BigInt),
|
||||||
, ("Decimal", Model.Decimal)
|
("Float", Model.Float),
|
||||||
, ("DateTime", Model.DateTime)
|
("Decimal", Model.Decimal),
|
||||||
, ("Json", Model.Json)
|
("DateTime", Model.DateTime),
|
||||||
, ("Bytes", Model.Bytes)
|
("Json", Model.Json),
|
||||||
]
|
("Bytes", Model.Bytes)
|
||||||
)
|
]
|
||||||
|
)
|
||||||
<|> (try $ Model.Unsupported <$> (T.symbol lexer "Unsupported" >> T.parens lexer (T.stringLiteral lexer)))
|
<|> (try $ Model.Unsupported <$> (T.symbol lexer "Unsupported" >> T.parens lexer (T.stringLiteral lexer)))
|
||||||
<|> Model.UserType <$> T.identifier lexer
|
<|> Model.UserType <$> T.identifier lexer
|
||||||
|
|
||||||
-- NOTE: As is Prisma currently implemented, there can be only one type modifier at one time: [] or ?.
|
-- NOTE: As is Prisma currently implemented, there can be only one type modifier at one time: [] or ?.
|
||||||
fieldTypeModifier :: Parser (Maybe Model.FieldTypeModifier)
|
fieldTypeModifier :: Parser (Maybe Model.FieldTypeModifier)
|
||||||
fieldTypeModifier = optionMaybe
|
fieldTypeModifier =
|
||||||
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List) <|>
|
optionMaybe
|
||||||
(try (T.symbol lexer "?") >> return Model.Optional)
|
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List)
|
||||||
|
<|> (try (T.symbol lexer "?") >> return Model.Optional)
|
||||||
)
|
)
|
||||||
|
|
||||||
attribute :: Parser Model.Attribute
|
attribute :: Parser Model.Attribute
|
||||||
attribute = do
|
attribute = do
|
||||||
_ <- char '@'
|
_ <- char '@'
|
||||||
name <- T.identifier lexer
|
name <- T.identifier lexer
|
||||||
-- NOTE: we support potential "selector" in order to support native database type attributes.
|
-- 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), ... .
|
-- 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
|
-- 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
|
-- 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.
|
-- (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.
|
-- 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.
|
-- 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
|
-- Also, we could do some additional checks here in parser (PascalCase), and some additional checks
|
||||||
-- in th generator ("db" matching the datasource block name).
|
-- in th generator ("db" matching the datasource block name).
|
||||||
maybeSelector <- optionMaybe $ try $ char '.' >> T.identifier lexer
|
maybeSelector <- optionMaybe $ try $ char '.' >> T.identifier lexer
|
||||||
|
|
||||||
maybeArgs <- optionMaybe (T.parens lexer (T.commaSep1 lexer (try attrArgument)))
|
maybeArgs <- optionMaybe (T.parens lexer (T.commaSep1 lexer (try attrArgument)))
|
||||||
return $ Model.Attribute
|
return $
|
||||||
{ Model._attrName = case maybeSelector of
|
Model.Attribute
|
||||||
Just selector -> name ++ "." ++ selector
|
{ Model._attrName = case maybeSelector of
|
||||||
Nothing -> name
|
Just selector -> name ++ "." ++ selector
|
||||||
, Model._attrArgs = fromMaybe [] maybeArgs
|
Nothing -> name,
|
||||||
}
|
Model._attrArgs = fromMaybe [] maybeArgs
|
||||||
|
}
|
||||||
|
|
||||||
-- Parses attribute argument that ends with delimiter: , or ).
|
-- Parses attribute argument that ends with delimiter: , or ).
|
||||||
-- Doesn't parse the delimiter.
|
-- Doesn't parse the delimiter.
|
||||||
attrArgument :: Parser Model.AttributeArg
|
attrArgument :: Parser Model.AttributeArg
|
||||||
attrArgument = do
|
attrArgument = do
|
||||||
arg <- try namedArg <|> try unnamedArg
|
arg <- try namedArg <|> try unnamedArg
|
||||||
return arg
|
return arg
|
||||||
where
|
where
|
||||||
namedArg :: Parser Model.AttributeArg
|
namedArg :: Parser Model.AttributeArg
|
||||||
namedArg = do
|
namedArg = do
|
||||||
name <- T.identifier lexer
|
name <- T.identifier lexer
|
||||||
_ <- T.colon lexer
|
_ <- T.colon lexer
|
||||||
Model.AttrArgNamed name <$> argValue
|
Model.AttrArgNamed name <$> argValue
|
||||||
|
|
||||||
unnamedArg :: Parser Model.AttributeArg
|
unnamedArg :: Parser Model.AttributeArg
|
||||||
unnamedArg = Model.AttrArgUnnamed <$> argValue
|
unnamedArg = Model.AttrArgUnnamed <$> argValue
|
||||||
|
|
||||||
argValue :: Parser Model.AttrArgValue
|
argValue :: Parser Model.AttrArgValue
|
||||||
argValue = choice $ map (try . delimitedArgValue)
|
argValue =
|
||||||
[ argValueString
|
choice $
|
||||||
, argValueFunc
|
map
|
||||||
, argValueFieldReferenceList
|
(try . delimitedArgValue)
|
||||||
, argValueNumberFloat
|
[ argValueString,
|
||||||
, argValueNumberInt
|
argValueFunc,
|
||||||
, argValueIdentifier
|
argValueFieldReferenceList,
|
||||||
, argValueUnknown
|
argValueNumberFloat,
|
||||||
]
|
argValueNumberInt,
|
||||||
|
argValueIdentifier,
|
||||||
|
argValueUnknown
|
||||||
|
]
|
||||||
|
|
||||||
argValueString :: Parser Model.AttrArgValue
|
argValueString :: Parser Model.AttrArgValue
|
||||||
argValueString = Model.AttrArgString <$> T.stringLiteral lexer
|
argValueString = Model.AttrArgString <$> T.stringLiteral lexer
|
||||||
|
|
||||||
argValueFunc :: Parser Model.AttrArgValue
|
argValueFunc :: Parser Model.AttrArgValue
|
||||||
argValueFunc = do -- TODO: Could I implement this with applicative?
|
argValueFunc = do
|
||||||
name <- T.identifier lexer
|
-- TODO: Could I implement this with applicative?
|
||||||
T.parens lexer $ T.whiteSpace lexer
|
name <- T.identifier lexer
|
||||||
return $ Model.AttrArgFunc name
|
T.parens lexer $ T.whiteSpace lexer
|
||||||
|
return $ Model.AttrArgFunc name
|
||||||
|
|
||||||
argValueFieldReferenceList :: Parser Model.AttrArgValue
|
argValueFieldReferenceList :: Parser Model.AttrArgValue
|
||||||
argValueFieldReferenceList = Model.AttrArgFieldRefList <$>
|
argValueFieldReferenceList =
|
||||||
(T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
Model.AttrArgFieldRefList
|
||||||
|
<$> (T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
||||||
|
|
||||||
-- NOTE: For now we are not supporting negative numbers.
|
-- NOTE: For now we are not supporting negative numbers.
|
||||||
-- I couldn't figure out from Prisma docs if there could be the case
|
-- 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 :: Parser Model.AttrArgValue
|
||||||
argValueIdentifier = Model.AttrArgIdentifier <$> T.identifier lexer
|
argValueIdentifier = Model.AttrArgIdentifier <$> T.identifier lexer
|
||||||
|
|
||||||
-- | Our "wildcard" -> tries to capture anything.
|
|
||||||
argValueUnknown :: Parser Model.AttrArgValue
|
argValueUnknown :: Parser Model.AttrArgValue
|
||||||
argValueUnknown = Model.AttrArgUnknown <$>
|
argValueUnknown =
|
||||||
(many1 $ try $ noneOf argDelimiters)
|
Model.AttrArgUnknown
|
||||||
|
<$> (many1 $ try $ noneOf argDelimiters)
|
||||||
|
|
||||||
delimitedArgValue :: Parser Model.AttrArgValue -> Parser Model.AttrArgValue
|
delimitedArgValue :: Parser Model.AttrArgValue -> Parser Model.AttrArgValue
|
||||||
delimitedArgValue argValueP = do
|
delimitedArgValue argValueP = do
|
||||||
value <- argValueP
|
value <- argValueP
|
||||||
_ <- lookAhead $ oneOf argDelimiters
|
_ <- lookAhead $ oneOf argDelimiters
|
||||||
return value
|
return value
|
||||||
|
|
||||||
argDelimiters = [',', ')']
|
argDelimiters = [',', ')']
|
||||||
|
|
||||||
@ -174,9 +195,11 @@ blockAttribute :: Parser Model.Attribute
|
|||||||
blockAttribute = char '@' >> attribute
|
blockAttribute = char '@' >> attribute
|
||||||
|
|
||||||
lexer :: T.TokenParser ()
|
lexer :: T.TokenParser ()
|
||||||
lexer = T.makeTokenParser emptyDef
|
lexer =
|
||||||
{ T.commentLine = "//"
|
T.makeTokenParser
|
||||||
, T.caseSensitive = True
|
emptyDef
|
||||||
, T.identStart = letter
|
{ T.commentLine = "//",
|
||||||
, T.identLetter = alphaNum <|> char '_'
|
T.caseSensitive = True,
|
||||||
}
|
T.identStart = letter,
|
||||||
|
T.identLetter = alphaNum <|> char '_'
|
||||||
|
}
|
||||||
|
@ -1,49 +1,87 @@
|
|||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
|
||||||
module StrongPath
|
module StrongPath
|
||||||
( Path, Path'
|
( Path,
|
||||||
, Abs, Rel, Dir, File, File'
|
Path',
|
||||||
, System, Windows, Posix
|
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
|
import Control.Monad.Catch (MonadThrow)
|
||||||
, parseRelDirW, parseRelFileW, parseAbsDirW, parseAbsFileW
|
import Data.List (intercalate)
|
||||||
, parseRelDirP, parseRelFileP, parseAbsDirP, parseAbsFileP
|
import Data.Maybe (fromJust)
|
||||||
|
import qualified Path as P
|
||||||
, fromPathRelDir, fromPathRelFile, fromPathAbsDir, fromPathAbsFile
|
import qualified Path.Posix as PP
|
||||||
, fromPathRelDirW, fromPathRelFileW, fromPathAbsDirW, fromPathAbsFileW
|
import qualified Path.Windows as PW
|
||||||
, fromPathRelDirP, fromPathRelFileP, fromPathAbsDirP, fromPathAbsFileP
|
import StrongPath.Internal
|
||||||
|
import qualified System.FilePath as FP
|
||||||
, toPathRelDir, toPathRelFile, toPathAbsDir, toPathAbsFile
|
import qualified System.FilePath.Posix as FPP
|
||||||
, 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 qualified System.FilePath.Windows as FPW
|
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?
|
-- 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?
|
-- 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.
|
-- 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),
|
-- 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,
|
-- 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.
|
-- because they are done via Include mechanism.
|
||||||
fromPathRelDir :: P.Path P.Rel P.Dir -> Path' System (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)
|
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)
|
fromPathAbsDir :: P.Path P.Abs P.Dir -> Path' System Abs (Dir a)
|
||||||
fromPathAbsFile :: P.Path P.Abs P.File -> Path' System Abs (File' f)
|
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)
|
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)
|
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)
|
fromPathAbsDirW :: PW.Path PW.Abs PW.Dir -> Path' Windows Abs (Dir a)
|
||||||
fromPathAbsFileW :: PW.Path PW.Abs PW.File -> Path' Windows Abs (File' f)
|
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)
|
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)
|
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)
|
fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path' Posix Abs (Dir a)
|
||||||
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path' Posix Abs (File' f)
|
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path' Posix Abs (File' f)
|
||||||
---- System
|
---- System
|
||||||
fromPathRelDir p = RelDir p NoPrefix
|
fromPathRelDir p = RelDir p NoPrefix
|
||||||
fromPathRelFile p = RelFile p NoPrefix
|
|
||||||
fromPathAbsDir = AbsDir
|
fromPathRelFile p = RelFile p NoPrefix
|
||||||
fromPathAbsFile = AbsFile
|
|
||||||
|
fromPathAbsDir = AbsDir
|
||||||
|
|
||||||
|
fromPathAbsFile = AbsFile
|
||||||
|
|
||||||
---- Windows
|
---- Windows
|
||||||
fromPathRelDirW p = RelDirW p NoPrefix
|
fromPathRelDirW p = RelDirW p NoPrefix
|
||||||
|
|
||||||
fromPathRelFileW p = RelFileW p NoPrefix
|
fromPathRelFileW p = RelFileW p NoPrefix
|
||||||
fromPathAbsDirW = AbsDirW
|
|
||||||
|
fromPathAbsDirW = AbsDirW
|
||||||
|
|
||||||
fromPathAbsFileW = AbsFileW
|
fromPathAbsFileW = AbsFileW
|
||||||
|
|
||||||
---- Posix
|
---- Posix
|
||||||
fromPathRelDirP p = RelDirP p NoPrefix
|
fromPathRelDirP p = RelDirP p NoPrefix
|
||||||
|
|
||||||
fromPathRelFileP p = RelFileP p NoPrefix
|
fromPathRelFileP p = RelFileP p NoPrefix
|
||||||
fromPathAbsDirP = AbsDirP
|
|
||||||
|
fromPathAbsDirP = AbsDirP
|
||||||
|
|
||||||
fromPathAbsFileP = AbsFileP
|
fromPathAbsFileP = AbsFileP
|
||||||
|
|
||||||
-- TODO: Should I go with MonadThrow here instead of just throwing error? Probably!
|
-- 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,
|
-- 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.
|
-- so user can recover from error and continue, if they wish.
|
||||||
-- Deconstructors
|
-- Deconstructors
|
||||||
toPathRelDir :: Path' System (Rel a) (Dir b) -> P.Path P.Rel P.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
|
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
|
toPathAbsDir :: Path' System Abs (Dir a) -> P.Path P.Abs P.Dir
|
||||||
toPathAbsFile :: Path' System Abs (File' f) -> P.Path P.Abs P.File
|
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
|
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
|
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
|
toPathAbsDirW :: Path' Windows Abs (Dir a) -> PW.Path PW.Abs PW.Dir
|
||||||
toPathAbsFileW :: Path' Windows Abs (File' f) -> PW.Path PW.Abs PW.File
|
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
|
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
|
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
|
toPathAbsDirP :: Path' Posix Abs (Dir a) -> PP.Path PP.Abs PP.Dir
|
||||||
toPathAbsFileP :: Path' Posix Abs (File' f) -> PP.Path PP.Abs PP.File
|
toPathAbsFileP :: Path' Posix Abs (File' f) -> PP.Path PP.Abs PP.File
|
||||||
---- System
|
---- System
|
||||||
toPathRelDir (RelDir p NoPrefix) = p
|
toPathRelDir (RelDir p NoPrefix) = p
|
||||||
toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelDir _ = impossible
|
toPathRelDir _ = impossible
|
||||||
|
|
||||||
toPathRelFile (RelFile p NoPrefix) = p
|
toPathRelFile (RelFile p NoPrefix) = p
|
||||||
toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelFile _ = impossible
|
toPathRelFile _ = impossible
|
||||||
|
|
||||||
toPathAbsDir (AbsDir p) = p
|
toPathAbsDir (AbsDir p) = p
|
||||||
toPathAbsDir _ = impossible
|
toPathAbsDir _ = impossible
|
||||||
|
|
||||||
toPathAbsFile (AbsFile p) = p
|
toPathAbsFile (AbsFile p) = p
|
||||||
toPathAbsFile _ = impossible
|
toPathAbsFile _ = impossible
|
||||||
|
|
||||||
---- Windows
|
---- Windows
|
||||||
toPathRelDirW (RelDirW p NoPrefix) = p
|
toPathRelDirW (RelDirW p NoPrefix) = p
|
||||||
toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelDirW _ = impossible
|
toPathRelDirW _ = impossible
|
||||||
|
|
||||||
toPathRelFileW (RelFileW p NoPrefix) = p
|
toPathRelFileW (RelFileW p NoPrefix) = p
|
||||||
toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelFileW _ = impossible
|
toPathRelFileW _ = impossible
|
||||||
|
|
||||||
toPathAbsDirW (AbsDirW p) = p
|
toPathAbsDirW (AbsDirW p) = p
|
||||||
toPathAbsDirW _ = impossible
|
toPathAbsDirW _ = impossible
|
||||||
|
|
||||||
toPathAbsFileW (AbsFileW p) = p
|
toPathAbsFileW (AbsFileW p) = p
|
||||||
toPathAbsFileW _ = impossible
|
toPathAbsFileW _ = impossible
|
||||||
|
|
||||||
---- Posix
|
---- Posix
|
||||||
toPathRelDirP (RelDirP p NoPrefix) = p
|
toPathRelDirP (RelDirP p NoPrefix) = p
|
||||||
toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelDirP _ = impossible
|
toPathRelDirP _ = impossible
|
||||||
|
|
||||||
toPathRelFileP (RelFileP p NoPrefix) = p
|
toPathRelFileP (RelFileP p NoPrefix) = p
|
||||||
toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError
|
toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError
|
||||||
toPathRelFileP _ = impossible
|
toPathRelFileP _ = impossible
|
||||||
|
|
||||||
toPathAbsDirP (AbsDirP p) = p
|
toPathAbsDirP (AbsDirP p) = p
|
||||||
toPathAbsDirP _ = impossible
|
toPathAbsDirP _ = impossible
|
||||||
|
|
||||||
toPathAbsFileP (AbsFileP p) = p
|
toPathAbsFileP (AbsFileP p) = p
|
||||||
toPathAbsFileP _ = impossible
|
toPathAbsFileP _ = impossible
|
||||||
|
|
||||||
relativeStrongPathWithPrefixToPathError :: a
|
relativeStrongPathWithPrefixToPathError :: a
|
||||||
relativeStrongPathWithPrefixToPathError =
|
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.
|
-- | Parsers.
|
||||||
-- How parsers work:
|
-- How parsers work:
|
||||||
@ -173,60 +233,70 @@ relativeStrongPathWithPrefixToPathError =
|
|||||||
-- NOTE: System/Posix* means that path has to be System with exception of separators
|
-- 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).
|
-- that can be Posix besides being System (but e.g. root can't be Posix).
|
||||||
-- Win/Posix* is analogous to System/Posix*.
|
-- Win/Posix* is analogous to System/Posix*.
|
||||||
parseRelDir :: MonadThrow m => FilePath -> m (Path' System (Rel d1) (Dir d2))
|
parseRelDir :: MonadThrow m => FilePath -> m (Path' System (Rel d1) (Dir d2))
|
||||||
parseRelFile :: MonadThrow m => FilePath -> m (Path' System (Rel d) (File' f))
|
parseRelFile :: MonadThrow m => FilePath -> m (Path' System (Rel d) (File' f))
|
||||||
parseAbsDir :: MonadThrow m => FilePath -> m (Path' System Abs (Dir d))
|
parseAbsDir :: MonadThrow m => FilePath -> m (Path' System Abs (Dir d))
|
||||||
parseAbsFile :: MonadThrow m => FilePath -> m (Path' System Abs (File' f))
|
parseAbsFile :: MonadThrow m => FilePath -> m (Path' System Abs (File' f))
|
||||||
parseRelDirW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d1) (Dir d2))
|
parseRelDirW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d1) (Dir d2))
|
||||||
parseRelFileW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d) (File' f))
|
parseRelFileW :: MonadThrow m => FilePath -> m (Path' Windows (Rel d) (File' f))
|
||||||
parseAbsDirW :: MonadThrow m => FilePath -> m (Path' Windows Abs (Dir d))
|
parseAbsDirW :: MonadThrow m => FilePath -> m (Path' Windows Abs (Dir d))
|
||||||
parseAbsFileW :: MonadThrow m => FilePath -> m (Path' Windows Abs (File' f))
|
parseAbsFileW :: MonadThrow m => FilePath -> m (Path' Windows Abs (File' f))
|
||||||
parseRelDirP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d1) (Dir d2))
|
parseRelDirP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d1) (Dir d2))
|
||||||
parseRelFileP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d) (File' f))
|
parseRelFileP :: MonadThrow m => FilePath -> m (Path' Posix (Rel d) (File' f))
|
||||||
parseAbsDirP :: MonadThrow m => FilePath -> m (Path' Posix Abs (Dir d))
|
parseAbsDirP :: MonadThrow m => FilePath -> m (Path' Posix Abs (Dir d))
|
||||||
parseAbsFileP :: MonadThrow m => FilePath -> m (Path' Posix Abs (File' f))
|
parseAbsFileP :: MonadThrow m => FilePath -> m (Path' Posix Abs (File' f))
|
||||||
---- System
|
---- 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
|
parseRelFile = parseRelFP RelFile [FP.pathSeparator, FPP.pathSeparator] P.parseRelFile
|
||||||
|
|
||||||
parseAbsDir fp = fromPathAbsDir <$> P.parseAbsDir fp
|
parseAbsDir fp = fromPathAbsDir <$> P.parseAbsDir fp
|
||||||
|
|
||||||
parseAbsFile fp = fromPathAbsFile <$> P.parseAbsFile fp
|
parseAbsFile fp = fromPathAbsFile <$> P.parseAbsFile fp
|
||||||
|
|
||||||
---- Windows
|
---- Windows
|
||||||
parseRelDirW = parseRelFP RelDirW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelDir
|
parseRelDirW = parseRelFP RelDirW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelDir
|
||||||
|
|
||||||
parseRelFileW = parseRelFP RelFileW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelFile
|
parseRelFileW = parseRelFP RelFileW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelFile
|
||||||
|
|
||||||
parseAbsDirW fp = fromPathAbsDirW <$> PW.parseAbsDir fp
|
parseAbsDirW fp = fromPathAbsDirW <$> PW.parseAbsDir fp
|
||||||
|
|
||||||
parseAbsFileW fp = fromPathAbsFileW <$> PW.parseAbsFile fp
|
parseAbsFileW fp = fromPathAbsFileW <$> PW.parseAbsFile fp
|
||||||
|
|
||||||
---- Posix
|
---- Posix
|
||||||
parseRelDirP = parseRelFP RelDirP [FPP.pathSeparator] PP.parseRelDir
|
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 :: Path' s b t -> FilePath
|
||||||
toFilePath sp = case sp of
|
toFilePath sp = case sp of
|
||||||
---- System
|
---- System
|
||||||
RelDir p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
RelDir p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||||
RelFile p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
RelFile p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p
|
||||||
AbsDir p -> P.toFilePath p
|
AbsDir p -> P.toFilePath p
|
||||||
AbsFile p -> P.toFilePath p
|
AbsFile p -> P.toFilePath p
|
||||||
---- Windows
|
---- Windows
|
||||||
RelDirW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
RelDirW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||||
RelFileW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
RelFileW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p
|
||||||
AbsDirW p -> PW.toFilePath p
|
AbsDirW p -> PW.toFilePath p
|
||||||
AbsFileW p -> PW.toFilePath p
|
AbsFileW p -> PW.toFilePath p
|
||||||
---- Posix
|
---- Posix
|
||||||
RelDirP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
RelDirP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||||
RelFileP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
RelFileP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p
|
||||||
AbsDirP p -> PP.toFilePath p
|
AbsDirP p -> PP.toFilePath p
|
||||||
AbsFileP p -> PP.toFilePath p
|
AbsFileP p -> PP.toFilePath p
|
||||||
where
|
where
|
||||||
relPathToFilePath pathToFilePath sep prefix path =
|
relPathToFilePath pathToFilePath sep prefix path =
|
||||||
combinePrefixWithPath sep (relPathPrefixToFilePath sep prefix) (pathToFilePath path)
|
combinePrefixWithPath sep (relPathPrefixToFilePath sep prefix) (pathToFilePath path)
|
||||||
|
|
||||||
relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath
|
relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath
|
||||||
relPathPrefixToFilePath _ NoPrefix = ""
|
relPathPrefixToFilePath _ NoPrefix = ""
|
||||||
relPathPrefixToFilePath sep (ParentDir n) =
|
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
|
-- TODO: This function and helper functions above are somewhat too loose and hard to
|
||||||
-- follow, implement them in better way.
|
-- follow, implement them in better way.
|
||||||
@ -234,56 +304,67 @@ toFilePath sp = case sp of
|
|||||||
-- and it could also be empty.
|
-- and it could also be empty.
|
||||||
combinePrefixWithPath :: Char -> String -> FilePath -> FilePath
|
combinePrefixWithPath :: Char -> String -> FilePath -> FilePath
|
||||||
combinePrefixWithPath sep prefix path
|
combinePrefixWithPath sep prefix path
|
||||||
| path `elem` [".", ['.', sep], "./"] && not (null prefix) = prefix
|
| path `elem` [".", ['.', sep], "./"] && not (null prefix) = prefix
|
||||||
combinePrefixWithPath _ prefix path = prefix ++ path
|
combinePrefixWithPath _ prefix path = prefix ++ path
|
||||||
|
|
||||||
-- These functions just call toFilePath, but their value is in
|
-- These functions just call toFilePath, but their value is in
|
||||||
-- their type: they allow you to capture expected type of the strong path
|
-- their type: they allow you to capture expected type of the strong path
|
||||||
-- that you want to convert into FilePath.
|
-- that you want to convert into FilePath.
|
||||||
fromRelDir :: Path' System (Rel r) (Dir d) -> FilePath
|
fromRelDir :: Path' System (Rel r) (Dir d) -> FilePath
|
||||||
fromRelDir = toFilePath
|
fromRelDir = toFilePath
|
||||||
fromRelFile :: Path' System (Rel r) (File' f) -> FilePath
|
|
||||||
fromRelFile = toFilePath
|
fromRelFile :: Path' System (Rel r) (File' f) -> FilePath
|
||||||
fromAbsDir :: Path' System Abs (Dir d) -> FilePath
|
fromRelFile = toFilePath
|
||||||
fromAbsDir = toFilePath
|
|
||||||
fromAbsFile :: Path' System Abs (File' f) -> FilePath
|
fromAbsDir :: Path' System Abs (Dir d) -> FilePath
|
||||||
fromAbsFile = toFilePath
|
fromAbsDir = toFilePath
|
||||||
fromRelDirP :: Path' Posix (Rel r) (Dir d) -> FilePath
|
|
||||||
fromRelDirP = toFilePath
|
fromAbsFile :: Path' System Abs (File' f) -> FilePath
|
||||||
fromRelFileP :: Path' Posix (Rel r) (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
|
fromRelFileP = toFilePath
|
||||||
fromAbsDirP :: Path' Posix Abs (Dir d) -> FilePath
|
|
||||||
fromAbsDirP = toFilePath
|
fromAbsDirP :: Path' Posix Abs (Dir d) -> FilePath
|
||||||
fromAbsFileP :: Path' Posix Abs (File' f) -> FilePath
|
fromAbsDirP = toFilePath
|
||||||
|
|
||||||
|
fromAbsFileP :: Path' Posix Abs (File' f) -> FilePath
|
||||||
fromAbsFileP = toFilePath
|
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 :: Path' Windows (Rel r) (File' f) -> FilePath
|
||||||
fromRelFileW = toFilePath
|
fromRelFileW = toFilePath
|
||||||
fromAbsDirW :: Path' Windows Abs (Dir d) -> FilePath
|
|
||||||
fromAbsDirW = toFilePath
|
fromAbsDirW :: Path' Windows Abs (Dir d) -> FilePath
|
||||||
fromAbsFileW :: Path' Windows Abs (File' f) -> FilePath
|
fromAbsDirW = toFilePath
|
||||||
|
|
||||||
|
fromAbsFileW :: Path' Windows Abs (File' f) -> FilePath
|
||||||
fromAbsFileW = toFilePath
|
fromAbsFileW = toFilePath
|
||||||
|
|
||||||
-- | Either removes last entry or if there are no entries and just "../"s, adds one more "../".
|
-- | 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.
|
-- 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' s b t -> Path' s b (Dir d)
|
||||||
parent path = case path of
|
parent path = case path of
|
||||||
---- System
|
---- System
|
||||||
RelDir p prefix -> relDirPathParent RelDir P.parent p prefix
|
RelDir p prefix -> relDirPathParent RelDir P.parent p prefix
|
||||||
RelFile p prefix -> RelDir (P.parent p) prefix
|
RelFile p prefix -> RelDir (P.parent p) prefix
|
||||||
AbsDir p -> AbsDir $ P.parent p
|
AbsDir p -> AbsDir $ P.parent p
|
||||||
AbsFile p -> AbsDir $ P.parent p
|
AbsFile p -> AbsDir $ P.parent p
|
||||||
---- Windows
|
---- Windows
|
||||||
RelDirW p prefix -> relDirPathParent RelDirW PW.parent p prefix
|
RelDirW p prefix -> relDirPathParent RelDirW PW.parent p prefix
|
||||||
RelFileW p prefix -> RelDirW (PW.parent p) prefix
|
RelFileW p prefix -> RelDirW (PW.parent p) prefix
|
||||||
AbsDirW p -> AbsDirW $ PW.parent p
|
AbsDirW p -> AbsDirW $ PW.parent p
|
||||||
AbsFileW p -> AbsDirW $ PW.parent p
|
AbsFileW p -> AbsDirW $ PW.parent p
|
||||||
---- Posix
|
---- Posix
|
||||||
RelDirP p prefix -> relDirPathParent RelDirP PP.parent p prefix
|
RelDirP p prefix -> relDirPathParent RelDirP PP.parent p prefix
|
||||||
RelFileP p prefix -> RelDirP (PP.parent p) prefix
|
RelFileP p prefix -> RelDirP (PP.parent p) prefix
|
||||||
AbsDirP p -> AbsDirP $ PP.parent p
|
AbsDirP p -> AbsDirP $ PP.parent p
|
||||||
AbsFileP p -> AbsDirP $ PP.parent p
|
AbsFileP p -> AbsDirP $ PP.parent p
|
||||||
where
|
where
|
||||||
-- NOTE: We need this special logic for RelDir, because if we have RelDir Path,
|
-- 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,
|
-- 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
|
-- For file though, we don't have that concern, because it will always be possible to
|
||||||
-- get a parent, as per current Path implementation.
|
-- get a parent, as per current Path implementation.
|
||||||
relDirPathParent constructor pathParent p prefix =
|
relDirPathParent constructor pathParent p prefix =
|
||||||
if pathParent p == p
|
if pathParent p == p
|
||||||
then let prefix' = case prefix of
|
then
|
||||||
ParentDir n -> ParentDir (n + 1)
|
let prefix' = case prefix of
|
||||||
NoPrefix -> ParentDir 1
|
ParentDir n -> ParentDir (n + 1)
|
||||||
in constructor p prefix'
|
NoPrefix -> ParentDir 1
|
||||||
else let p' = pathParent p
|
in constructor p prefix'
|
||||||
in constructor p' prefix
|
else
|
||||||
|
let p' = pathParent p
|
||||||
|
in constructor p' prefix
|
||||||
|
|
||||||
-- | How "../"s are resolved:
|
-- | How "../"s are resolved:
|
||||||
-- For each "../" at the start of the right hand path, one most right entry is removed
|
-- 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
|
(</>) :: Path' s a (Dir d) -> Path' s (Rel d) c -> Path' s a c
|
||||||
---- System
|
---- System
|
||||||
lsp@(RelDir _ _) </> (RelFile rp rprefix) =
|
lsp@(RelDir _ _) </> (RelFile rp rprefix) =
|
||||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelFile (lp' P.</> rp) lprefix'
|
in RelFile (lp' P.</> rp) lprefix'
|
||||||
lsp@(RelDir _ _) </> (RelDir rp rprefix) =
|
lsp@(RelDir _ _) </> (RelDir rp rprefix) =
|
||||||
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelDir (lp' P.</> rp) lprefix'
|
in RelDir (lp' P.</> rp) lprefix'
|
||||||
lsp@(AbsDir _) </> (RelFile rp rprefix) =
|
lsp@(AbsDir _) </> (RelFile rp rprefix) =
|
||||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsFile (lp' P.</> rp)
|
in AbsFile (lp' P.</> rp)
|
||||||
lsp@(AbsDir _) </> (RelDir rp rprefix) =
|
lsp@(AbsDir _) </> (RelDir rp rprefix) =
|
||||||
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsDir (lp' P.</> rp)
|
in AbsDir (lp' P.</> rp)
|
||||||
---- Windows
|
---- Windows
|
||||||
lsp@(RelDirW _ _) </> (RelFileW rp rprefix) =
|
lsp@(RelDirW _ _) </> (RelFileW rp rprefix) =
|
||||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelFileW (lp' `pathWinCombineRelDirAndRelFile` rp) lprefix'
|
in RelFileW (lp' `pathWinCombineRelDirAndRelFile` rp) lprefix'
|
||||||
lsp@(RelDirW _ _) </> (RelDirW rp rprefix) =
|
lsp@(RelDirW _ _) </> (RelDirW rp rprefix) =
|
||||||
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelDirW (lp' `pathWinCombineRelDirAndRelDir` rp) lprefix'
|
in RelDirW (lp' `pathWinCombineRelDirAndRelDir` rp) lprefix'
|
||||||
lsp@(AbsDirW _) </> (RelFileW rp rprefix) =
|
lsp@(AbsDirW _) </> (RelFileW rp rprefix) =
|
||||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsFileW (lp' PW.</> rp)
|
in AbsFileW (lp' PW.</> rp)
|
||||||
lsp@(AbsDirW _) </> (RelDirW rp rprefix) =
|
lsp@(AbsDirW _) </> (RelDirW rp rprefix) =
|
||||||
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsDirW (lp' `pathWinCombineAbsDirAndRelDir` rp)
|
in AbsDirW (lp' `pathWinCombineAbsDirAndRelDir` rp)
|
||||||
---- Posix
|
---- Posix
|
||||||
lsp@(RelDirP _ _) </> (RelFileP rp rprefix) =
|
lsp@(RelDirP _ _) </> (RelFileP rp rprefix) =
|
||||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelFileP (lp' `pathPosixCombineRelDirAndRelFile` rp) lprefix'
|
in RelFileP (lp' `pathPosixCombineRelDirAndRelFile` rp) lprefix'
|
||||||
lsp@(RelDirP _ _) </> (RelDirP rp rprefix) =
|
lsp@(RelDirP _ _) </> (RelDirP rp rprefix) =
|
||||||
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in RelDirP (lp' `pathPosixCombineRelDirAndRelDir` rp) lprefix'
|
in RelDirP (lp' `pathPosixCombineRelDirAndRelDir` rp) lprefix'
|
||||||
lsp@(AbsDirP _) </> (RelFileP rp rprefix) =
|
lsp@(AbsDirP _) </> (RelFileP rp rprefix) =
|
||||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsFileP (lp' PP.</> rp)
|
in AbsFileP (lp' PP.</> rp)
|
||||||
lsp@(AbsDirP _) </> (RelDirP rp rprefix) =
|
lsp@(AbsDirP _) </> (RelDirP rp rprefix) =
|
||||||
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix
|
||||||
in AbsDirP (lp' `pathPosixCombineAbsDirAndRelDir` rp)
|
in AbsDirP (lp' `pathPosixCombineAbsDirAndRelDir` rp)
|
||||||
_ </> _ = impossible
|
_ </> _ = impossible
|
||||||
|
|
||||||
|
|
||||||
castRel :: Path' s (Rel d1) a -> Path' s (Rel d2) a
|
castRel :: Path' s (Rel d1) a -> Path' s (Rel d2) a
|
||||||
---- System
|
---- System
|
||||||
castRel (RelDir p pr) = RelDir p pr
|
castRel (RelDir p pr) = RelDir p pr
|
||||||
castRel (RelFile p pr) = RelFile p pr
|
castRel (RelFile p pr) = RelFile p pr
|
||||||
---- Windows
|
---- Windows
|
||||||
castRel (RelDirW p pr) = RelDirW p pr
|
castRel (RelDirW p pr) = RelDirW p pr
|
||||||
castRel (RelFileW p pr) = RelFileW p pr
|
castRel (RelFileW p pr) = RelFileW p pr
|
||||||
---- Posix
|
---- Posix
|
||||||
castRel (RelDirP p pr) = RelDirP p pr
|
castRel (RelDirP p pr) = RelDirP p pr
|
||||||
castRel (RelFileP p pr) = RelFileP p pr
|
castRel (RelFileP p pr) = RelFileP p pr
|
||||||
castRel _ = impossible
|
castRel _ = impossible
|
||||||
|
|
||||||
castDir :: Path' s a (Dir d1) -> Path' s a (Dir d2)
|
castDir :: Path' s a (Dir d1) -> Path' s a (Dir d2)
|
||||||
---- System
|
---- System
|
||||||
castDir (AbsDir p) = AbsDir p
|
castDir (AbsDir p) = AbsDir p
|
||||||
castDir (RelDir p pr) = RelDir p pr
|
castDir (RelDir p pr) = RelDir p pr
|
||||||
---- Windows
|
---- Windows
|
||||||
castDir (AbsDirW p) = AbsDirW p
|
castDir (AbsDirW p) = AbsDirW p
|
||||||
castDir (RelDirW p pr) = RelDirW p pr
|
castDir (RelDirW p pr) = RelDirW p pr
|
||||||
---- Posix
|
---- Posix
|
||||||
castDir (AbsDirP p) = AbsDirP p
|
castDir (AbsDirP p) = AbsDirP p
|
||||||
castDir (RelDirP p pr) = RelDirP p pr
|
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``
|
-- 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
|
-- 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
|
-- 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.
|
-- 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.
|
-- | 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).
|
-- 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,
|
-- If path is weird but still considered relative, like just "C:" on Win,
|
||||||
-- results can be unxpected, most likely resulting with error thrown.
|
-- results can be unxpected, most likely resulting with error thrown.
|
||||||
-- If path is already Posix, it will not change.
|
-- 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 :: 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 sp@(RelDirW _ _) = parseRelDirP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||||
relDirToPosix (RelDirP p pr) = return $ RelDirP p pr
|
relDirToPosix (RelDirP p pr) = return $ RelDirP p pr
|
||||||
relDirToPosix _ = impossible
|
relDirToPosix _ = impossible
|
||||||
|
|
||||||
relFileToPosix :: MonadThrow m => Path' s (Rel d1) (File' f) -> m (Path' Posix (Rel d1) (File' f))
|
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 sp@(RelFileW _ _) = parseRelFileP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||||
relFileToPosix (RelFileP p pr) = return $ RelFileP p pr
|
relFileToPosix (RelFileP p pr) = return $ RelFileP p pr
|
||||||
relFileToPosix _ = impossible
|
relFileToPosix _ = impossible
|
||||||
|
|
||||||
-- TODO: Should I name these unsafe versions differently? Maybe relDirToPosixU?
|
-- TODO: Should I name these unsafe versions differently? Maybe relDirToPosixU?
|
||||||
-- Unsafe versions:
|
-- Unsafe versions:
|
||||||
relDirToPosix' :: Path' s (Rel d1) (Dir d2) -> Path' Posix (Rel d1) (Dir d2)
|
relDirToPosix' :: Path' s (Rel d1) (Dir d2) -> Path' Posix (Rel d1) (Dir d2)
|
||||||
relDirToPosix' = fromJust . relDirToPosix
|
relDirToPosix' = fromJust . relDirToPosix
|
||||||
|
|
||||||
relFileToPosix' :: Path' s (Rel d1) (File' f) -> Path' Posix (Rel d1) (File' f)
|
relFileToPosix' :: Path' s (Rel d1) (File' f) -> Path' Posix (Rel d1) (File' f)
|
||||||
relFileToPosix' = fromJust . relFileToPosix
|
relFileToPosix' = fromJust . relFileToPosix
|
||||||
|
@ -1,85 +1,91 @@
|
|||||||
module StrongPath.Internal where
|
module StrongPath.Internal where
|
||||||
|
|
||||||
import Control.Monad.Catch (MonadThrow)
|
import Control.Monad.Catch (MonadThrow)
|
||||||
import qualified Path as P
|
import qualified Path as P
|
||||||
import qualified Path.Posix as PP
|
import qualified Path.Posix as PP
|
||||||
import qualified Path.Windows as PW
|
import qualified Path.Windows as PW
|
||||||
import qualified System.FilePath.Posix as FPP
|
import qualified System.FilePath.Posix as FPP
|
||||||
import qualified System.FilePath.Windows as FPW
|
import qualified System.FilePath.Windows as FPW
|
||||||
|
|
||||||
|
|
||||||
-- | s -> standard, b -> base, t -> type
|
-- | s -> standard, b -> base, t -> type
|
||||||
data Path' s b t
|
data Path' s b t
|
||||||
-- System
|
= -- System
|
||||||
= RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
||||||
| RelFile (P.Path P.Rel P.File) RelPathPrefix
|
| RelFile (P.Path P.Rel P.File) RelPathPrefix
|
||||||
| AbsDir (P.Path P.Abs P.Dir)
|
| AbsDir (P.Path P.Abs P.Dir)
|
||||||
| AbsFile (P.Path P.Abs P.File)
|
| AbsFile (P.Path P.Abs P.File)
|
||||||
-- Windows
|
| -- Windows
|
||||||
| RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
||||||
| RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix
|
| RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix
|
||||||
| AbsDirW (PW.Path PW.Abs PW.Dir)
|
| AbsDirW (PW.Path PW.Abs PW.Dir)
|
||||||
| AbsFileW (PW.Path PW.Abs PW.File)
|
| AbsFileW (PW.Path PW.Abs PW.File)
|
||||||
-- Posix
|
| -- Posix
|
||||||
| RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
||||||
| RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix
|
| RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix
|
||||||
| AbsDirP (PP.Path PP.Abs PP.Dir)
|
| AbsDirP (PP.Path PP.Abs PP.Dir)
|
||||||
| AbsFileP (PP.Path PP.Abs PP.File)
|
| AbsFileP (PP.Path PP.Abs PP.File)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data RelPathPrefix = ParentDir Int -- ^ ../, Int saying how many times it repeats.
|
data RelPathPrefix
|
||||||
| NoPrefix
|
= -- | ../, Int saying how many times it repeats.
|
||||||
deriving (Show, Eq)
|
ParentDir Int
|
||||||
|
| NoPrefix
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type Path = Path' System
|
type Path = Path' System
|
||||||
|
|
||||||
-- | base
|
-- | base
|
||||||
data Abs
|
data Abs
|
||||||
|
|
||||||
data Rel dir
|
data Rel dir
|
||||||
|
|
||||||
-- | type
|
-- | type
|
||||||
data Dir dir
|
data Dir dir
|
||||||
|
|
||||||
data File' file
|
data File' file
|
||||||
|
|
||||||
type File = File' ()
|
type File = File' ()
|
||||||
|
|
||||||
-- | standard
|
-- | standard
|
||||||
data System -- Depends on the platform, it is either Posix or Windows.
|
data System -- Depends on the platform, it is either Posix or Windows.
|
||||||
|
|
||||||
data Windows
|
data Windows
|
||||||
|
|
||||||
data Posix
|
data Posix
|
||||||
|
|
||||||
|
parseRelFP ::
|
||||||
parseRelFP :: MonadThrow m
|
MonadThrow m =>
|
||||||
=> (P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t)
|
(P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t) ->
|
||||||
-> [Char]
|
[Char] ->
|
||||||
-> (FilePath -> m (P.Path pb pt))
|
(FilePath -> m (P.Path pb pt)) ->
|
||||||
-> FilePath
|
FilePath ->
|
||||||
-> m (Path' s (Rel d) t)
|
m (Path' s (Rel d) t)
|
||||||
parseRelFP constructor validSeparators pathParser fp =
|
parseRelFP constructor validSeparators pathParser fp =
|
||||||
let (prefix, fp') = extractRelPathPrefix validSeparators fp
|
let (prefix, fp') = extractRelPathPrefix validSeparators fp
|
||||||
fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "".
|
fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "".
|
||||||
in (\p -> constructor p prefix) <$> pathParser fp''
|
in (\p -> constructor p prefix) <$> pathParser fp''
|
||||||
|
|
||||||
-- | Extracts a multiple "../" from start of the file path.
|
-- | Extracts a multiple "../" from start of the file path.
|
||||||
-- If path is completely ../../.., also handles the last one.
|
-- If path is completely ../../.., also handles the last one.
|
||||||
-- NOTE: We don't normalize path in any way.
|
-- NOTE: We don't normalize path in any way.
|
||||||
extractRelPathPrefix :: [Char] -> FilePath -> (RelPathPrefix, FilePath)
|
extractRelPathPrefix :: [Char] -> FilePath -> (RelPathPrefix, FilePath)
|
||||||
extractRelPathPrefix validSeparators path =
|
extractRelPathPrefix validSeparators path =
|
||||||
let (n, path') = dropParentDirs path
|
let (n, path') = dropParentDirs path
|
||||||
in (if n == 0 then NoPrefix else ParentDir n, path')
|
in (if n == 0 then NoPrefix else ParentDir n, path')
|
||||||
where
|
where
|
||||||
parentDirStrings :: [String]
|
parentDirStrings :: [String]
|
||||||
parentDirStrings = [['.', '.', s] | s <- validSeparators]
|
parentDirStrings = [['.', '.', s] | s <- validSeparators]
|
||||||
|
|
||||||
pathStartsWithParentDir :: FilePath -> Bool
|
pathStartsWithParentDir :: FilePath -> Bool
|
||||||
pathStartsWithParentDir p = take 3 p `elem` parentDirStrings
|
pathStartsWithParentDir p = take 3 p `elem` parentDirStrings
|
||||||
|
|
||||||
dropParentDirs :: FilePath -> (Int, FilePath)
|
dropParentDirs :: FilePath -> (Int, FilePath)
|
||||||
dropParentDirs p
|
dropParentDirs p
|
||||||
| pathStartsWithParentDir p = let (n, p') = dropParentDirs (drop 3 p)
|
| pathStartsWithParentDir p =
|
||||||
in (1 + n, p')
|
let (n, p') = dropParentDirs (drop 3 p)
|
||||||
| p == ".." = (1, "")
|
in (1 + n, p')
|
||||||
| otherwise = (0, p)
|
| p == ".." = (1, "")
|
||||||
|
| otherwise = (0, p)
|
||||||
|
|
||||||
-- NOTE: These three funtions, pathWinCombine... exist only to fix
|
-- NOTE: These three funtions, pathWinCombine... exist only to fix
|
||||||
-- Path.Windows.</> behaviour regarding concatenating '.' rel dirs
|
-- Path.Windows.</> behaviour regarding concatenating '.' rel dirs
|
||||||
@ -102,35 +108,39 @@ extractRelPathPrefix validSeparators path =
|
|||||||
-- do the rest of the work.
|
-- 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 :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.File -> PW.Path PW.Rel PW.File
|
||||||
pathWinCombineRelDirAndRelFile lp rp
|
pathWinCombineRelDirAndRelFile lp rp
|
||||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||||
| otherwise = lp PW.</> 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 :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir
|
||||||
pathWinCombineRelDirAndRelDir lp rp
|
pathWinCombineRelDirAndRelDir lp rp
|
||||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||||
| otherwise = lp PW.</> rp
|
| otherwise = lp PW.</> rp
|
||||||
|
|
||||||
pathWinCombineAbsDirAndRelDir :: PW.Path PW.Abs PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Abs PW.Dir
|
pathWinCombineAbsDirAndRelDir :: PW.Path PW.Abs PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Abs PW.Dir
|
||||||
pathWinCombineAbsDirAndRelDir lp rp
|
pathWinCombineAbsDirAndRelDir lp rp
|
||||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||||
| otherwise = lp PW.</> rp
|
| otherwise = lp PW.</> rp
|
||||||
|
|
||||||
-- NOTE: Same as pathWinCombineRelDirAndRelFile but for Posix (Path has the same problem).
|
-- 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 :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.File -> PP.Path PP.Rel PP.File
|
||||||
pathPosixCombineRelDirAndRelFile lp rp
|
pathPosixCombineRelDirAndRelFile lp rp
|
||||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||||
| otherwise = lp PP.</> 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 :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir
|
||||||
pathPosixCombineRelDirAndRelDir lp rp
|
pathPosixCombineRelDirAndRelDir lp rp
|
||||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||||
| otherwise = lp PP.</> rp
|
| otherwise = lp PP.</> rp
|
||||||
|
|
||||||
pathPosixCombineAbsDirAndRelDir :: PP.Path PP.Abs PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Abs PP.Dir
|
pathPosixCombineAbsDirAndRelDir :: PP.Path PP.Abs PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Abs PP.Dir
|
||||||
pathPosixCombineAbsDirAndRelDir lp rp
|
pathPosixCombineAbsDirAndRelDir lp rp
|
||||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||||
| otherwise = lp PP.</> rp
|
| otherwise = lp PP.</> rp
|
||||||
|
|
||||||
prefixNumParentDirs :: RelPathPrefix -> Int
|
prefixNumParentDirs :: RelPathPrefix -> Int
|
||||||
prefixNumParentDirs NoPrefix = 0
|
prefixNumParentDirs NoPrefix = 0
|
||||||
prefixNumParentDirs (ParentDir n) = n
|
prefixNumParentDirs (ParentDir n) = n
|
||||||
|
|
||||||
relPathNumParentDirs :: Path' s (Rel r) t -> Int
|
relPathNumParentDirs :: Path' s (Rel r) t -> Int
|
||||||
@ -138,13 +148,13 @@ relPathNumParentDirs = prefixNumParentDirs . relPathPrefix
|
|||||||
|
|
||||||
relPathPrefix :: Path' s (Rel r) t -> RelPathPrefix
|
relPathPrefix :: Path' s (Rel r) t -> RelPathPrefix
|
||||||
relPathPrefix sp = case sp of
|
relPathPrefix sp = case sp of
|
||||||
RelDir _ pr -> pr
|
RelDir _ pr -> pr
|
||||||
RelFile _ pr -> pr
|
RelFile _ pr -> pr
|
||||||
RelDirW _ pr -> pr
|
RelDirW _ pr -> pr
|
||||||
RelFileW _ pr -> pr
|
RelFileW _ pr -> pr
|
||||||
RelDirP _ pr -> pr
|
RelDirP _ pr -> pr
|
||||||
RelFileP _ pr -> pr
|
RelFileP _ pr -> pr
|
||||||
_ -> impossible
|
_ -> impossible
|
||||||
|
|
||||||
impossible :: a
|
impossible :: a
|
||||||
impossible = error "This should be impossible."
|
impossible = error "This should be impossible."
|
||||||
|
@ -1,33 +1,35 @@
|
|||||||
module Util
|
module Util
|
||||||
( camelToKebabCase
|
( camelToKebabCase,
|
||||||
, onFirst
|
onFirst,
|
||||||
, toLowerFirst
|
toLowerFirst,
|
||||||
, toUpperFirst
|
toUpperFirst,
|
||||||
, headSafe
|
headSafe,
|
||||||
, jsonSet
|
jsonSet,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Char (isUpper, toLower, toUpper)
|
|
||||||
import qualified Data.Aeson as Aeson
|
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.HashMap.Strict as M
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
camelToKebabCase :: String -> String
|
camelToKebabCase :: String -> String
|
||||||
camelToKebabCase "" = ""
|
camelToKebabCase "" = ""
|
||||||
camelToKebabCase camel@(camelHead:camelTail) = kebabHead:kebabTail
|
camelToKebabCase camel@(camelHead : camelTail) = kebabHead : kebabTail
|
||||||
where
|
where
|
||||||
kebabHead = toLower camelHead
|
kebabHead = toLower camelHead
|
||||||
kebabTail = concat $ map
|
kebabTail =
|
||||||
(\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b])
|
concat $
|
||||||
(zip camel camelTail)
|
map
|
||||||
|
(\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b])
|
||||||
|
(zip camel camelTail)
|
||||||
isCamelHump (a, b) = (not . isUpper) a && isUpper b
|
isCamelHump (a, b) = (not . isUpper) a && isUpper b
|
||||||
|
|
||||||
-- | Applies given function to the first element of the list.
|
-- | Applies given function to the first element of the list.
|
||||||
-- If list is empty, returns empty list.
|
-- If list is empty, returns empty list.
|
||||||
onFirst :: (a -> a) -> [a] -> [a]
|
onFirst :: (a -> a) -> [a] -> [a]
|
||||||
onFirst _ [] = []
|
onFirst _ [] = []
|
||||||
onFirst f (x:xs) = (f x):xs
|
onFirst f (x : xs) = (f x) : xs
|
||||||
|
|
||||||
toLowerFirst :: String -> String
|
toLowerFirst :: String -> String
|
||||||
toLowerFirst = onFirst toLower
|
toLowerFirst = onFirst toLower
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
module Util.Fib (
|
module Util.Fib
|
||||||
fibonacci
|
( fibonacci,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
fibonacci :: Int -> Int
|
fibonacci :: Int -> Int
|
||||||
fibonacci 0 = 0
|
fibonacci 0 = 0
|
||||||
|
@ -1,17 +1,18 @@
|
|||||||
module Util.IO
|
module Util.IO
|
||||||
( listDirectoryDeep
|
( listDirectoryDeep,
|
||||||
, listDirectory
|
listDirectory,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad (filterM)
|
||||||
|
import qualified Path as P
|
||||||
import qualified System.Directory as Dir
|
import qualified System.Directory as Dir
|
||||||
import qualified System.FilePath as FilePath
|
import qualified System.FilePath as FilePath
|
||||||
import System.IO.Error (isDoesNotExistError)
|
import System.IO.Error (isDoesNotExistError)
|
||||||
import UnliftIO.Exception (catch, throwIO)
|
import UnliftIO.Exception (catch, throwIO)
|
||||||
import Control.Monad (filterM)
|
|
||||||
import qualified Path as P
|
|
||||||
|
|
||||||
|
|
||||||
-- TODO: write tests.
|
-- TODO: write tests.
|
||||||
|
|
||||||
-- | Lists all files in the directory recursively.
|
-- | Lists all files in the directory recursively.
|
||||||
-- All paths are relative to the directory we are listing.
|
-- All paths are relative to the directory we are listing.
|
||||||
-- If directory does not exist, returns empty list.
|
-- If directory does not exist, returns empty list.
|
||||||
@ -23,34 +24,36 @@ import qualified Path as P
|
|||||||
-- >>> ["test.txt", "bar/text2.txt"]
|
-- >>> ["test.txt", "bar/text2.txt"]
|
||||||
listDirectoryDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
listDirectoryDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||||
listDirectoryDeep absDirPath = do
|
listDirectoryDeep absDirPath = do
|
||||||
(relFilePaths, relSubDirPaths) <- listDirectory absDirPath
|
(relFilePaths, relSubDirPaths) <-
|
||||||
`catch` \e -> if isDoesNotExistError e then return ([], []) else throwIO e
|
listDirectory absDirPath
|
||||||
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath P.</>)) relSubDirPaths
|
`catch` \e -> if isDoesNotExistError e then return ([], []) else throwIO e
|
||||||
return $ relFilePaths ++ concat relSubDirFilesPaths
|
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath P.</>)) relSubDirPaths
|
||||||
|
return $ relFilePaths ++ concat relSubDirFilesPaths
|
||||||
where
|
where
|
||||||
-- | NOTE: Here, returned paths are relative to the main dir whose sub dir we are listing,
|
listSubDirDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||||
-- which is one level above what you might intuitively expect.
|
listSubDirDeep subDirPath = do
|
||||||
listSubDirDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
files <- listDirectoryDeep subDirPath
|
||||||
listSubDirDeep subDirPath = do
|
return $ map (P.dirname subDirPath P.</>) files
|
||||||
files <- listDirectoryDeep subDirPath
|
|
||||||
return $ map (P.dirname subDirPath P.</>) files
|
|
||||||
|
|
||||||
-- TODO: write tests.
|
-- TODO: write tests.
|
||||||
|
|
||||||
-- | Lists files and directories at top lvl of the directory.
|
-- | 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 :: P.Path P.Abs P.Dir -> IO ([P.Path P.Rel P.File], [P.Path P.Rel P.Dir])
|
||||||
listDirectory absDirPath = do
|
listDirectory absDirPath = do
|
||||||
fpRelItemPaths <- Dir.listDirectory fpAbsDirPath
|
fpRelItemPaths <- Dir.listDirectory fpAbsDirPath
|
||||||
relFilePaths <- filterFiles fpAbsDirPath fpRelItemPaths
|
relFilePaths <- filterFiles fpAbsDirPath fpRelItemPaths
|
||||||
relDirPaths <- filterDirs fpAbsDirPath fpRelItemPaths
|
relDirPaths <- filterDirs fpAbsDirPath fpRelItemPaths
|
||||||
return (relFilePaths, relDirPaths)
|
return (relFilePaths, relDirPaths)
|
||||||
where
|
where
|
||||||
fpAbsDirPath :: FilePath
|
fpAbsDirPath :: FilePath
|
||||||
fpAbsDirPath = P.toFilePath absDirPath
|
fpAbsDirPath = P.toFilePath absDirPath
|
||||||
|
|
||||||
filterFiles :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.File]
|
filterFiles :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.File]
|
||||||
filterFiles absDir relItems = filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
filterFiles absDir relItems =
|
||||||
>>= mapM P.parseRelFile
|
filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
||||||
|
>>= mapM P.parseRelFile
|
||||||
|
|
||||||
filterDirs :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.Dir]
|
filterDirs :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.Dir]
|
||||||
filterDirs absDir relItems = filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
filterDirs absDir relItems =
|
||||||
>>= mapM P.parseRelDir
|
filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
||||||
|
>>= mapM P.parseRelDir
|
||||||
|
@ -1,18 +1,20 @@
|
|||||||
module Util.Terminal
|
module Util.Terminal
|
||||||
( Style(..)
|
( Style (..),
|
||||||
, applyStyles
|
applyStyles,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
data Style = Black
|
data Style
|
||||||
| Red
|
= Black
|
||||||
| Green
|
| Red
|
||||||
| Yellow
|
| Green
|
||||||
| Blue
|
| Yellow
|
||||||
| Magenta
|
| Blue
|
||||||
| Cyan
|
| Magenta
|
||||||
| White
|
| Cyan
|
||||||
| Bold
|
| White
|
||||||
| Underline
|
| Bold
|
||||||
|
| Underline
|
||||||
|
|
||||||
-- | Given a string, returns decorated string that when printed in terminal
|
-- | Given a string, returns decorated string that when printed in terminal
|
||||||
-- will have same content as original string but will also exibit specified styles.
|
-- 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 [] str = str
|
||||||
applyStyles _ "" = ""
|
applyStyles _ "" = ""
|
||||||
applyStyles styles str = foldl applyStyle str styles ++ escapeCode ++ resetCode
|
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 :: Style -> String
|
||||||
styleCode Black = "[30m"
|
styleCode Black = "[30m"
|
||||||
styleCode Red = "[31m"
|
styleCode Red = "[31m"
|
||||||
styleCode Green = "[32m"
|
styleCode Green = "[32m"
|
||||||
styleCode Yellow = "[33m"
|
styleCode Yellow = "[33m"
|
||||||
styleCode Blue = "[34m"
|
styleCode Blue = "[34m"
|
||||||
styleCode Magenta = "[35m"
|
styleCode Magenta = "[35m"
|
||||||
styleCode Cyan = "[36m"
|
styleCode Cyan = "[36m"
|
||||||
styleCode White = "[37m"
|
styleCode White = "[37m"
|
||||||
styleCode Bold = "[1m"
|
styleCode Bold = "[1m"
|
||||||
styleCode Underline = "[4m"
|
styleCode Underline = "[4m"
|
||||||
|
|
||||||
escapeCode :: String
|
escapeCode :: String
|
||||||
|
@ -1,95 +1,85 @@
|
|||||||
module Wasp
|
module Wasp
|
||||||
( Wasp
|
( Wasp,
|
||||||
, WaspElement (..)
|
WaspElement (..),
|
||||||
, fromWaspElems
|
fromWaspElems,
|
||||||
|
module Wasp.JsImport,
|
||||||
, module Wasp.JsImport
|
getJsImports,
|
||||||
, getJsImports
|
setJsImports,
|
||||||
, setJsImports
|
module Wasp.App,
|
||||||
|
fromApp,
|
||||||
, module Wasp.App
|
getApp,
|
||||||
, fromApp
|
setApp,
|
||||||
, getApp
|
getAuth,
|
||||||
, setApp
|
getPSLEntities,
|
||||||
|
getDb,
|
||||||
, getAuth
|
module Wasp.Page,
|
||||||
, getPSLEntities
|
getPages,
|
||||||
|
addPage,
|
||||||
, getDb
|
getRoutes,
|
||||||
|
getQueries,
|
||||||
, module Wasp.Page
|
addQuery,
|
||||||
, getPages
|
getQueryByName,
|
||||||
, addPage
|
getActions,
|
||||||
, getRoutes
|
addAction,
|
||||||
|
getActionByName,
|
||||||
, getQueries
|
setExternalCodeFiles,
|
||||||
, addQuery
|
getExternalCodeFiles,
|
||||||
, getQueryByName
|
setDotEnvFile,
|
||||||
|
getDotEnvFile,
|
||||||
, getActions
|
setIsBuild,
|
||||||
, addAction
|
getIsBuild,
|
||||||
, getActionByName
|
setNpmDependencies,
|
||||||
|
getNpmDependencies,
|
||||||
, setExternalCodeFiles
|
)
|
||||||
, getExternalCodeFiles
|
where
|
||||||
|
|
||||||
, setDotEnvFile
|
|
||||||
, getDotEnvFile
|
|
||||||
|
|
||||||
, setIsBuild
|
|
||||||
, getIsBuild
|
|
||||||
|
|
||||||
, setNpmDependencies
|
|
||||||
, getNpmDependencies
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
|
||||||
import StrongPath (Path, Abs, File)
|
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
import qualified ExternalCode
|
import qualified ExternalCode
|
||||||
import qualified Util as U
|
import StrongPath (Abs, File, Path)
|
||||||
|
import qualified Util as U
|
||||||
import qualified Wasp.Action
|
import qualified Wasp.Action
|
||||||
import Wasp.App
|
import Wasp.App
|
||||||
import qualified Wasp.Auth
|
import qualified Wasp.Auth
|
||||||
import qualified Wasp.Db
|
import qualified Wasp.Db
|
||||||
import Wasp.Entity
|
import Wasp.Entity
|
||||||
import Wasp.JsImport
|
import Wasp.JsImport
|
||||||
import Wasp.NpmDependencies (NpmDependencies)
|
import Wasp.NpmDependencies (NpmDependencies)
|
||||||
import qualified Wasp.NpmDependencies
|
import qualified Wasp.NpmDependencies
|
||||||
import Wasp.Page
|
import Wasp.Page
|
||||||
import qualified Wasp.Query
|
import qualified Wasp.Query
|
||||||
import Wasp.Route
|
import Wasp.Route
|
||||||
|
|
||||||
|
|
||||||
-- * Wasp
|
-- * Wasp
|
||||||
|
|
||||||
data Wasp = Wasp
|
data Wasp = Wasp
|
||||||
{ waspElements :: [WaspElement]
|
{ waspElements :: [WaspElement],
|
||||||
, waspJsImports :: [JsImport]
|
waspJsImports :: [JsImport],
|
||||||
, externalCodeFiles :: [ExternalCode.File]
|
externalCodeFiles :: [ExternalCode.File],
|
||||||
, dotEnvFile :: Maybe (Path Abs File)
|
dotEnvFile :: Maybe (Path Abs File),
|
||||||
, isBuild :: Bool
|
isBuild :: Bool
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data WaspElement
|
data WaspElement
|
||||||
= WaspElementApp !App
|
= WaspElementApp !App
|
||||||
| WaspElementAuth !Wasp.Auth.Auth
|
| WaspElementAuth !Wasp.Auth.Auth
|
||||||
| WaspElementDb !Wasp.Db.Db
|
| WaspElementDb !Wasp.Db.Db
|
||||||
| WaspElementPage !Page
|
| WaspElementPage !Page
|
||||||
| WaspElementNpmDependencies !NpmDependencies
|
| WaspElementNpmDependencies !NpmDependencies
|
||||||
| WaspElementRoute !Route
|
| WaspElementRoute !Route
|
||||||
| WaspElementEntity !Wasp.Entity.Entity
|
| WaspElementEntity !Wasp.Entity.Entity
|
||||||
| WaspElementQuery !Wasp.Query.Query
|
| WaspElementQuery !Wasp.Query.Query
|
||||||
| WaspElementAction !Wasp.Action.Action
|
| WaspElementAction !Wasp.Action.Action
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
fromWaspElems :: [WaspElement] -> Wasp
|
fromWaspElems :: [WaspElement] -> Wasp
|
||||||
fromWaspElems elems = Wasp
|
fromWaspElems elems =
|
||||||
{ waspElements = elems
|
Wasp
|
||||||
, waspJsImports = []
|
{ waspElements = elems,
|
||||||
, externalCodeFiles = []
|
waspJsImports = [],
|
||||||
, dotEnvFile = Nothing
|
externalCodeFiles = [],
|
||||||
, isBuild = False
|
dotEnvFile = Nothing,
|
||||||
|
isBuild = False
|
||||||
}
|
}
|
||||||
|
|
||||||
-- * Build
|
-- * Build
|
||||||
@ -98,7 +88,7 @@ getIsBuild :: Wasp -> Bool
|
|||||||
getIsBuild = isBuild
|
getIsBuild = isBuild
|
||||||
|
|
||||||
setIsBuild :: Wasp -> Bool -> Wasp
|
setIsBuild :: Wasp -> Bool -> Wasp
|
||||||
setIsBuild wasp isBuildNew = wasp { isBuild = isBuildNew }
|
setIsBuild wasp isBuildNew = wasp {isBuild = isBuildNew}
|
||||||
|
|
||||||
-- * External code files
|
-- * External code files
|
||||||
|
|
||||||
@ -106,7 +96,7 @@ getExternalCodeFiles :: Wasp -> [ExternalCode.File]
|
|||||||
getExternalCodeFiles = externalCodeFiles
|
getExternalCodeFiles = externalCodeFiles
|
||||||
|
|
||||||
setExternalCodeFiles :: Wasp -> [ExternalCode.File] -> Wasp
|
setExternalCodeFiles :: Wasp -> [ExternalCode.File] -> Wasp
|
||||||
setExternalCodeFiles wasp files = wasp { externalCodeFiles = files }
|
setExternalCodeFiles wasp files = wasp {externalCodeFiles = files}
|
||||||
|
|
||||||
-- * Dot env files
|
-- * Dot env files
|
||||||
|
|
||||||
@ -114,7 +104,7 @@ getDotEnvFile :: Wasp -> Maybe (Path Abs File)
|
|||||||
getDotEnvFile = dotEnvFile
|
getDotEnvFile = dotEnvFile
|
||||||
|
|
||||||
setDotEnvFile :: Wasp -> Maybe (Path Abs File) -> Wasp
|
setDotEnvFile :: Wasp -> Maybe (Path Abs File) -> Wasp
|
||||||
setDotEnvFile wasp file = wasp { dotEnvFile = file }
|
setDotEnvFile wasp file = wasp {dotEnvFile = file}
|
||||||
|
|
||||||
-- * Js imports
|
-- * Js imports
|
||||||
|
|
||||||
@ -122,25 +112,26 @@ getJsImports :: Wasp -> [JsImport]
|
|||||||
getJsImports = waspJsImports
|
getJsImports = waspJsImports
|
||||||
|
|
||||||
setJsImports :: Wasp -> [JsImport] -> Wasp
|
setJsImports :: Wasp -> [JsImport] -> Wasp
|
||||||
setJsImports wasp jsImports = wasp { waspJsImports = jsImports }
|
setJsImports wasp jsImports = wasp {waspJsImports = jsImports}
|
||||||
|
|
||||||
-- * App
|
-- * App
|
||||||
|
|
||||||
getApp :: Wasp -> App
|
getApp :: Wasp -> App
|
||||||
getApp wasp = let apps = getApps wasp in
|
getApp wasp =
|
||||||
if (length apps /= 1)
|
let apps = getApps wasp
|
||||||
then error "Wasp has to contain exactly one WaspElementApp element!"
|
in if (length apps /= 1)
|
||||||
else head apps
|
then error "Wasp has to contain exactly one WaspElementApp element!"
|
||||||
|
else head apps
|
||||||
|
|
||||||
isAppElem :: WaspElement -> Bool
|
isAppElem :: WaspElement -> Bool
|
||||||
isAppElem WaspElementApp{} = True
|
isAppElem WaspElementApp {} = True
|
||||||
isAppElem _ = False
|
isAppElem _ = False
|
||||||
|
|
||||||
getApps :: Wasp -> [App]
|
getApps :: Wasp -> [App]
|
||||||
getApps wasp = [app | (WaspElementApp app) <- waspElements wasp]
|
getApps wasp = [app | (WaspElementApp app) <- waspElements wasp]
|
||||||
|
|
||||||
setApp :: Wasp -> App -> 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 -> Wasp
|
||||||
fromApp app = fromWaspElems [WaspElementApp app]
|
fromApp app = fromWaspElems [WaspElementApp app]
|
||||||
@ -148,37 +139,40 @@ fromApp app = fromWaspElems [WaspElementApp app]
|
|||||||
-- * Auth
|
-- * Auth
|
||||||
|
|
||||||
getAuth :: Wasp -> Maybe Wasp.Auth.Auth
|
getAuth :: Wasp -> Maybe Wasp.Auth.Auth
|
||||||
getAuth wasp = let auths = [a | WaspElementAuth a <- waspElements wasp] in
|
getAuth wasp =
|
||||||
case auths of
|
let auths = [a | WaspElementAuth a <- waspElements wasp]
|
||||||
[] -> Nothing
|
in case auths of
|
||||||
|
[] -> Nothing
|
||||||
[a] -> Just a
|
[a] -> Just a
|
||||||
_ -> error "Wasp can't contain more than one WaspElementAuth element!"
|
_ -> error "Wasp can't contain more than one WaspElementAuth element!"
|
||||||
|
|
||||||
-- * Db
|
-- * Db
|
||||||
|
|
||||||
getDb :: Wasp -> Maybe Wasp.Db.Db
|
getDb :: Wasp -> Maybe Wasp.Db.Db
|
||||||
getDb wasp = let dbs = [db | WaspElementDb db <- waspElements wasp] in
|
getDb wasp =
|
||||||
case dbs of
|
let dbs = [db | WaspElementDb db <- waspElements wasp]
|
||||||
[] -> Nothing
|
in case dbs of
|
||||||
|
[] -> Nothing
|
||||||
[db] -> Just db
|
[db] -> Just db
|
||||||
_ -> error "Wasp can't contain more than one Db element!"
|
_ -> error "Wasp can't contain more than one Db element!"
|
||||||
|
|
||||||
-- * NpmDependencies
|
-- * NpmDependencies
|
||||||
|
|
||||||
getNpmDependencies :: Wasp -> NpmDependencies
|
getNpmDependencies :: Wasp -> NpmDependencies
|
||||||
getNpmDependencies wasp
|
getNpmDependencies wasp =
|
||||||
= let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
||||||
in case depses of
|
in case depses of
|
||||||
[] -> Wasp.NpmDependencies.empty
|
[] -> Wasp.NpmDependencies.empty
|
||||||
[deps] -> deps
|
[deps] -> deps
|
||||||
_ -> error "Wasp can't contain more than one NpmDependencies element!"
|
_ -> error "Wasp can't contain more than one NpmDependencies element!"
|
||||||
|
|
||||||
isNpmDependenciesElem :: WaspElement -> Bool
|
isNpmDependenciesElem :: WaspElement -> Bool
|
||||||
isNpmDependenciesElem WaspElementNpmDependencies{} = True
|
isNpmDependenciesElem WaspElementNpmDependencies {} = True
|
||||||
isNpmDependenciesElem _ = False
|
isNpmDependenciesElem _ = False
|
||||||
|
|
||||||
setNpmDependencies :: Wasp -> NpmDependencies -> Wasp
|
setNpmDependencies :: Wasp -> NpmDependencies -> Wasp
|
||||||
setNpmDependencies wasp deps = wasp
|
setNpmDependencies wasp deps =
|
||||||
|
wasp
|
||||||
{ waspElements = WaspElementNpmDependencies deps : filter (not . isNpmDependenciesElem) (waspElements wasp)
|
{ waspElements = WaspElementNpmDependencies deps : filter (not . isNpmDependenciesElem) (waspElements wasp)
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -193,7 +187,7 @@ getPages :: Wasp -> [Page]
|
|||||||
getPages wasp = [page | (WaspElementPage page) <- waspElements wasp]
|
getPages wasp = [page | (WaspElementPage page) <- waspElements wasp]
|
||||||
|
|
||||||
addPage :: Wasp -> Page -> Wasp
|
addPage :: Wasp -> Page -> Wasp
|
||||||
addPage wasp page = wasp { waspElements = (WaspElementPage page):(waspElements wasp) }
|
addPage wasp page = wasp {waspElements = (WaspElementPage page) : (waspElements wasp)}
|
||||||
|
|
||||||
-- * Query
|
-- * Query
|
||||||
|
|
||||||
@ -201,7 +195,7 @@ getQueries :: Wasp -> [Wasp.Query.Query]
|
|||||||
getQueries wasp = [query | (WaspElementQuery query) <- waspElements wasp]
|
getQueries wasp = [query | (WaspElementQuery query) <- waspElements wasp]
|
||||||
|
|
||||||
addQuery :: Wasp -> Wasp.Query.Query -> 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.
|
-- | 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.
|
-- 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]
|
getActions wasp = [action | (WaspElementAction action) <- waspElements wasp]
|
||||||
|
|
||||||
addAction :: Wasp -> Wasp.Action.Action -> 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.
|
-- | 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.
|
-- 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 -> [Wasp.Entity.Entity]
|
||||||
getPSLEntities wasp = [entity | (WaspElementEntity entity) <- (waspElements wasp)]
|
getPSLEntities wasp = [entity | (WaspElementEntity entity) <- (waspElements wasp)]
|
||||||
|
|
||||||
|
|
||||||
-- * ToJSON instances.
|
-- * ToJSON instances.
|
||||||
|
|
||||||
instance ToJSON Wasp where
|
instance ToJSON Wasp where
|
||||||
toJSON wasp = object
|
toJSON wasp =
|
||||||
[ "app" .= getApp wasp
|
object
|
||||||
, "pages" .= getPages wasp
|
[ "app" .= getApp wasp,
|
||||||
, "routes" .= getRoutes wasp
|
"pages" .= getPages wasp,
|
||||||
, "jsImports" .= getJsImports wasp
|
"routes" .= getRoutes wasp,
|
||||||
]
|
"jsImports" .= getJsImports wasp
|
||||||
|
]
|
||||||
|
@ -1,21 +1,24 @@
|
|||||||
module Wasp.Action
|
module Wasp.Action
|
||||||
( Action(..)
|
( Action (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
import Wasp.JsImport (JsImport)
|
import Wasp.JsImport (JsImport)
|
||||||
|
|
||||||
-- TODO: Very similar to Wasp.Query, consider extracting duplication.
|
-- TODO: Very similar to Wasp.Query, consider extracting duplication.
|
||||||
|
|
||||||
data Action = Action
|
data Action = Action
|
||||||
{ _name :: !String
|
{ _name :: !String,
|
||||||
, _jsFunction :: !JsImport
|
_jsFunction :: !JsImport,
|
||||||
, _entities :: !(Maybe [String])
|
_entities :: !(Maybe [String])
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON Action where
|
instance ToJSON Action where
|
||||||
toJSON action = object
|
toJSON action =
|
||||||
[ "name" .= _name action
|
object
|
||||||
, "jsFunction" .= _jsFunction action
|
[ "name" .= _name action,
|
||||||
, "entities" .= _entities action
|
"jsFunction" .= _jsFunction action,
|
||||||
]
|
"entities" .= _entities action
|
||||||
|
]
|
||||||
|
@ -1,18 +1,20 @@
|
|||||||
module Wasp.App
|
module Wasp.App
|
||||||
( App(..)
|
( App (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson ((.=), object, ToJSON(..))
|
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
|
|
||||||
data App = App
|
data App = App
|
||||||
{ appName :: !String -- Identifier
|
{ appName :: !String, -- Identifier
|
||||||
, appTitle :: !String
|
appTitle :: !String,
|
||||||
, appHead :: !(Maybe [String])
|
appHead :: !(Maybe [String])
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON App where
|
instance ToJSON App where
|
||||||
toJSON app = object
|
toJSON app =
|
||||||
[ "name" .= appName app
|
object
|
||||||
, "title" .= appTitle app
|
[ "name" .= appName app,
|
||||||
]
|
"title" .= appTitle app
|
||||||
|
]
|
||||||
|
@ -1,14 +1,16 @@
|
|||||||
module Wasp.Auth
|
module Wasp.Auth
|
||||||
( Auth (..)
|
( Auth (..),
|
||||||
, AuthMethod (..)
|
AuthMethod (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
data Auth = Auth
|
data Auth = Auth
|
||||||
{ _userEntity :: !String
|
{ _userEntity :: !String,
|
||||||
, _methods :: [AuthMethod]
|
_methods :: [AuthMethod],
|
||||||
, _onAuthFailedRedirectTo :: !String
|
_onAuthFailedRedirectTo :: !String
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data AuthMethod
|
data AuthMethod
|
||||||
= EmailAndPassword
|
= EmailAndPassword
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
@ -1,13 +1,15 @@
|
|||||||
module Wasp.Db
|
module Wasp.Db
|
||||||
( Db (..)
|
( Db (..),
|
||||||
, DbSystem (..)
|
DbSystem (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
data Db = Db
|
data Db = Db
|
||||||
{ _system :: !DbSystem
|
{ _system :: !DbSystem
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data DbSystem
|
data DbSystem
|
||||||
= PostgreSQL
|
= PostgreSQL
|
||||||
| SQLite
|
| SQLite
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
@ -1,55 +1,55 @@
|
|||||||
module Wasp.Entity
|
module Wasp.Entity
|
||||||
( Entity (..)
|
( Entity (..),
|
||||||
, Field (..)
|
Field (..),
|
||||||
, FieldType (..)
|
FieldType (..),
|
||||||
, Scalar (..)
|
Scalar (..),
|
||||||
, Composite (..)
|
Composite (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson (ToJSON(..), (.=), object)
|
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
import qualified Psl.Ast.Model
|
import qualified Psl.Ast.Model
|
||||||
|
|
||||||
|
|
||||||
data Entity = Entity
|
data Entity = Entity
|
||||||
{ _name :: !String
|
{ _name :: !String,
|
||||||
, _fields :: ![Field]
|
_fields :: ![Field],
|
||||||
, _pslModelBody :: !Psl.Ast.Model.Body
|
_pslModelBody :: !Psl.Ast.Model.Body
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Field = Field
|
data Field = Field
|
||||||
{ _fieldName :: !String
|
{ _fieldName :: !String,
|
||||||
, _fieldType :: !FieldType
|
_fieldType :: !FieldType
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data FieldType = FieldTypeScalar Scalar | FieldTypeComposite Composite
|
data FieldType = FieldTypeScalar Scalar | FieldTypeComposite Composite
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Composite = Optional Scalar | List Scalar
|
data Composite = Optional Scalar | List Scalar
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Scalar
|
data Scalar
|
||||||
= String
|
= String
|
||||||
| Boolean
|
| Boolean
|
||||||
| Int
|
| Int
|
||||||
| BigInt
|
| BigInt
|
||||||
| Float
|
| Float
|
||||||
| Decimal
|
| Decimal
|
||||||
| DateTime
|
| DateTime
|
||||||
| Json
|
| Json
|
||||||
| Bytes
|
| Bytes
|
||||||
-- | Name of the user-defined type.
|
| -- | Name of the user-defined type.
|
||||||
-- This could be another entity, or maybe an enum,
|
-- This could be another entity, or maybe an enum,
|
||||||
-- we don't know here yet.
|
-- we don't know here yet.
|
||||||
| UserType String
|
UserType String
|
||||||
| Unsupported String
|
| Unsupported String
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON Entity where
|
instance ToJSON Entity where
|
||||||
toJSON entity = object
|
toJSON entity =
|
||||||
[ "name" .= _name entity
|
object
|
||||||
, "fields" .= show (_fields entity)
|
[ "name" .= _name entity,
|
||||||
, "pslModelBody" .= show (_pslModelBody entity)
|
"fields" .= show (_fields entity),
|
||||||
]
|
"pslModelBody" .= show (_pslModelBody entity)
|
||||||
|
]
|
||||||
|
@ -1,8 +1,9 @@
|
|||||||
module Wasp.JsCode
|
module Wasp.JsCode
|
||||||
( JsCode(..)
|
( JsCode (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson (ToJSON(..))
|
import Data.Aeson (ToJSON (..))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
data JsCode = JsCode !Text deriving (Show, Eq)
|
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
|
-- ideal. Ideally all the generation logic would be in the generator. But for now this was
|
||||||
-- the simplest way to implement it.
|
-- the simplest way to implement it.
|
||||||
instance ToJSON JsCode where
|
instance ToJSON JsCode where
|
||||||
toJSON (JsCode code) = toJSON code
|
toJSON (JsCode code) = toJSON code
|
||||||
|
@ -1,24 +1,25 @@
|
|||||||
module Wasp.JsImport
|
module Wasp.JsImport
|
||||||
( JsImport(..)
|
( JsImport (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
|
||||||
|
|
||||||
import ExternalCode (SourceExternalCodeDir)
|
|
||||||
import StrongPath (File, Path', Posix, Rel)
|
|
||||||
import qualified StrongPath as SP
|
|
||||||
|
|
||||||
|
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>".
|
-- | Represents javascript import -> "import <what> from <from>".
|
||||||
data JsImport = JsImport
|
data JsImport = JsImport
|
||||||
{ _defaultImport :: !(Maybe String)
|
{ _defaultImport :: !(Maybe String),
|
||||||
, _namedImports :: ![String]
|
_namedImports :: ![String],
|
||||||
, _from :: Path' Posix (Rel SourceExternalCodeDir) File
|
_from :: Path' Posix (Rel SourceExternalCodeDir) File
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON JsImport where
|
instance ToJSON JsImport where
|
||||||
toJSON jsImport = object
|
toJSON jsImport =
|
||||||
[ "defaultImport" .= _defaultImport jsImport
|
object
|
||||||
, "namedImports" .= _namedImports jsImport
|
[ "defaultImport" .= _defaultImport jsImport,
|
||||||
, "from" .= SP.toFilePath (_from jsImport)
|
"namedImports" .= _namedImports jsImport,
|
||||||
]
|
"from" .= SP.toFilePath (_from jsImport)
|
||||||
|
]
|
||||||
|
@ -1,20 +1,22 @@
|
|||||||
module Wasp.NpmDependencies
|
module Wasp.NpmDependencies
|
||||||
( NpmDependencies(..)
|
( NpmDependencies (..),
|
||||||
, empty
|
empty,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
import Data.Aeson (ToJSON (..), object, (.=))
|
|
||||||
import NpmDependency
|
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
|
import NpmDependency
|
||||||
|
|
||||||
data NpmDependencies = NpmDependencies
|
data NpmDependencies = NpmDependencies
|
||||||
{ _dependencies :: ![NpmDependency]
|
{ _dependencies :: ![NpmDependency]
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
empty :: NpmDependencies
|
empty :: NpmDependencies
|
||||||
empty = NpmDependencies { _dependencies = [] }
|
empty = NpmDependencies {_dependencies = []}
|
||||||
|
|
||||||
instance ToJSON NpmDependencies where
|
instance ToJSON NpmDependencies where
|
||||||
toJSON deps = object
|
toJSON deps =
|
||||||
[ "dependencies" .= _dependencies deps
|
object
|
||||||
]
|
[ "dependencies" .= _dependencies deps
|
||||||
|
]
|
||||||
|
@ -1,21 +1,23 @@
|
|||||||
module Wasp.Operation
|
module Wasp.Operation
|
||||||
( Operation(..)
|
( Operation (..),
|
||||||
, getName
|
getName,
|
||||||
, getJsFn
|
getJsFn,
|
||||||
, getEntities
|
getEntities,
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
-- TODO: Is this ok approach, should I instead use typeclass?
|
-- TODO: Is this ok approach, should I instead use typeclass?
|
||||||
-- So far, all usages in the codebase could be easily replaced with the 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.JsImport (JsImport)
|
||||||
import Wasp.Query (Query)
|
import Wasp.Query (Query)
|
||||||
import qualified Wasp.Query as Query
|
import qualified Wasp.Query as Query
|
||||||
import Wasp.Action (Action)
|
|
||||||
import qualified Wasp.Action as Action
|
|
||||||
|
|
||||||
data Operation = QueryOp Query
|
data Operation
|
||||||
| ActionOp Action
|
= QueryOp Query
|
||||||
|
| ActionOp Action
|
||||||
|
|
||||||
getName :: Operation -> String
|
getName :: Operation -> String
|
||||||
getName (QueryOp query) = Query._name query
|
getName (QueryOp query) = Query._name query
|
||||||
|
@ -1,19 +1,21 @@
|
|||||||
module Wasp.Page
|
module Wasp.Page
|
||||||
( Page(..)
|
( Page (..),
|
||||||
) where
|
)
|
||||||
|
where
|
||||||
|
|
||||||
import Data.Aeson ((.=), object, ToJSON(..))
|
import Data.Aeson (ToJSON (..), object, (.=))
|
||||||
import Wasp.JsImport (JsImport)
|
import Wasp.JsImport (JsImport)
|
||||||
|
|
||||||
|
|
||||||
data Page = Page
|
data Page = Page
|
||||||
{ _name :: !String
|
{ _name :: !String,
|
||||||
, _component :: !JsImport
|
_component :: !JsImport,
|
||||||
, _authRequired :: Maybe Bool
|
_authRequired :: Maybe Bool
|
||||||
} deriving (Show, Eq)
|
}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
instance ToJSON Page where
|
instance ToJSON Page where
|
||||||
toJSON page = object
|
toJSON page =
|
||||||
[ "name" .= _name page
|
object
|
||||||
, "component" .= _component page
|
[ "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