mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-08-17 11:10:37 +03:00
Formatted whole codebase with ormolu.
This commit is contained in:
parent
369ab16586
commit
1219a57bc9
@ -1,2 +1,3 @@
|
||||
import Distribution.Simple
|
||||
|
||||
main = defaultMain
|
||||
|
@ -1,28 +1,27 @@
|
||||
module Cli.Common
|
||||
( WaspProjectDir
|
||||
, DotWaspDir
|
||||
, CliTemplatesDir
|
||||
, dotWaspDirInWaspProjectDir
|
||||
, dotWaspRootFileInWaspProjectDir
|
||||
, extCodeDirInWaspProjectDir
|
||||
, generatedCodeDirInDotWaspDir
|
||||
, buildDirInDotWaspDir
|
||||
, waspSays
|
||||
) where
|
||||
|
||||
import qualified Path as P
|
||||
( WaspProjectDir,
|
||||
DotWaspDir,
|
||||
CliTemplatesDir,
|
||||
dotWaspDirInWaspProjectDir,
|
||||
dotWaspRootFileInWaspProjectDir,
|
||||
extCodeDirInWaspProjectDir,
|
||||
generatedCodeDirInDotWaspDir,
|
||||
buildDirInDotWaspDir,
|
||||
waspSays,
|
||||
)
|
||||
where
|
||||
|
||||
import Common (WaspProjectDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import qualified Generator.Common
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
|
||||
data DotWaspDir -- Here we put everything that wasp generates.
|
||||
data CliTemplatesDir
|
||||
|
||||
data CliTemplatesDir
|
||||
|
||||
-- TODO: SHould this be renamed to include word "root"?
|
||||
dotWaspDirInWaspProjectDir :: Path (Rel WaspProjectDir) (Dir DotWaspDir)
|
||||
|
@ -1,14 +1,15 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Command
|
||||
( Command
|
||||
, runCommand
|
||||
, CommandError(..)
|
||||
) where
|
||||
( Command,
|
||||
runCommand,
|
||||
CommandError (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
|
||||
|
||||
newtype Command a = Command {_runCommand :: ExceptT CommandError IO a}
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
|
||||
|
||||
|
@ -1,23 +1,26 @@
|
||||
module Command.Build
|
||||
( build
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
( build,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (alphaWarningMessage,
|
||||
findWaspProjectRootDirFromCwd)
|
||||
import Command.Common
|
||||
( alphaWarningMessage,
|
||||
findWaspProjectRootDirFromCwd,
|
||||
)
|
||||
import Command.Compile (compileIOWithOptions)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
build :: Command ()
|
||||
build = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
let outDir =
|
||||
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.buildDirInDotWaspDir
|
||||
|
||||
liftIO $ putStrLn "Building wasp project..."
|
||||
@ -27,12 +30,14 @@ build = do
|
||||
Right () -> liftIO $ putStrLn "Code has been successfully built! Check it out in .wasp/build directory.\n"
|
||||
liftIO $ putStrLn alphaWarningMessage
|
||||
|
||||
buildIO :: Path Abs (Dir Common.WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
buildIO ::
|
||||
Path Abs (Dir Common.WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
buildIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||
where
|
||||
options = CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir
|
||||
, isBuild = True
|
||||
options =
|
||||
CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Common.extCodeDirInWaspProjectDir,
|
||||
isBuild = True
|
||||
}
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Command.Call where
|
||||
|
||||
data Call = New String -- project name
|
||||
data Call
|
||||
= New String -- project name
|
||||
| Start
|
||||
| Clean
|
||||
| Compile
|
||||
|
@ -1,16 +1,18 @@
|
||||
module Command.Clean
|
||||
( clean
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.Directory (doesDirectoryExist,
|
||||
removeDirectoryRecursive)
|
||||
import System.IO (hFlush, stdout)
|
||||
( clean,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory
|
||||
( doesDirectoryExist,
|
||||
removeDirectoryRecursive,
|
||||
)
|
||||
import System.IO (hFlush, stdout)
|
||||
|
||||
clean :: Command ()
|
||||
clean = do
|
||||
@ -19,7 +21,7 @@ clean = do
|
||||
liftIO $ putStrLn "Deleting .wasp/ directory..." >> hFlush stdout
|
||||
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
|
||||
if doesDotWaspDirExist
|
||||
then liftIO $ do removeDirectoryRecursive dotWaspDirFp
|
||||
then liftIO $ do
|
||||
removeDirectoryRecursive dotWaspDirFp
|
||||
putStrLn "Deleted .wasp/ directory."
|
||||
else liftIO $ putStrLn "Nothing to delete: .wasp directory does not exist."
|
||||
|
||||
|
@ -1,28 +1,32 @@
|
||||
module Command.Compile
|
||||
( compileIO
|
||||
, compile
|
||||
, compileIOWithOptions
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (runExceptT, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
( compileIO,
|
||||
compile,
|
||||
compileIOWithOptions,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Command.Db.Migrate (MigrationDirCopyDirection (..),
|
||||
copyDbMigrationsDir)
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Command.Db.Migrate
|
||||
( MigrationDirCopyDirection (..),
|
||||
copyDbMigrationsDir,
|
||||
)
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions (..))
|
||||
import Control.Monad.Except (runExceptT, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
|
||||
compile :: Command ()
|
||||
compile = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let outDir = waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
let outDir =
|
||||
waspProjectDir </> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
waspSaysC "Compiling wasp code..."
|
||||
@ -33,20 +37,23 @@ compile = do
|
||||
|
||||
-- | Compiles Wasp source code in waspProjectDir directory and generates a project
|
||||
-- in given outDir directory.
|
||||
compileIO :: Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
compileIO ::
|
||||
Path Abs (Dir WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
compileIO waspProjectDir outDir = compileIOWithOptions options waspProjectDir outDir
|
||||
where
|
||||
options = CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir
|
||||
, isBuild = False
|
||||
options =
|
||||
CompileOptions
|
||||
{ externalCodeDirPath = waspProjectDir </> Cli.Common.extCodeDirInWaspProjectDir,
|
||||
isBuild = False
|
||||
}
|
||||
|
||||
compileIOWithOptions :: CompileOptions
|
||||
-> Path Abs (Dir Cli.Common.WaspProjectDir)
|
||||
-> Path Abs (Dir Lib.ProjectRootDir)
|
||||
-> IO (Either String ())
|
||||
compileIOWithOptions ::
|
||||
CompileOptions ->
|
||||
Path Abs (Dir Cli.Common.WaspProjectDir) ->
|
||||
Path Abs (Dir Lib.ProjectRootDir) ->
|
||||
IO (Either String ())
|
||||
compileIOWithOptions options waspProjectDir outDir = runExceptT $ do
|
||||
-- TODO: Use throwIO instead of Either to return exceptions?
|
||||
liftIO (Lib.compile waspProjectDir outDir options)
|
||||
|
@ -1,22 +1,22 @@
|
||||
module Command.Db
|
||||
( runDbCommand
|
||||
, studio
|
||||
) where
|
||||
( runDbCommand,
|
||||
studio,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..), runCommand)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd, waspSaysC)
|
||||
import Command.Compile (compile)
|
||||
import Control.Concurrent (newChan)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import Control.Monad.Except (throwError)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import StrongPath ((</>))
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Generator.DbGenerator.Jobs (runStudio)
|
||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||
import Command (Command, CommandError(..), runCommand)
|
||||
import Command.Compile (compile)
|
||||
import Command.Common (findWaspProjectRootDirFromCwd, waspSaysC)
|
||||
import qualified Cli.Common as Common
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import StrongPath ((</>))
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
runDbCommand :: Command a -> IO ()
|
||||
runDbCommand = runCommand . makeDbCommand
|
||||
@ -28,8 +28,9 @@ runDbCommand = runCommand . makeDbCommand
|
||||
makeDbCommand :: Command a -> Command a
|
||||
makeDbCommand cmd = do
|
||||
waspRoot <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </>
|
||||
Common.generatedCodeDirInDotWaspDir
|
||||
let genProjectDir =
|
||||
waspRoot </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
-- NOTE(matija): First we need make sure the code is generated.
|
||||
compile
|
||||
@ -43,10 +44,10 @@ makeDbCommand cmd = do
|
||||
case dbSetupResult of
|
||||
ExitSuccess -> waspSaysC "\nDatabase successfully set up!" >> cmd
|
||||
exitCode -> throwError $ CommandError $ dbSetupFailedMessage exitCode
|
||||
|
||||
where
|
||||
dbSetupFailedMessage exitCode = "\nDatabase setup failed" ++
|
||||
case exitCode of
|
||||
dbSetupFailedMessage exitCode =
|
||||
"\nDatabase setup failed"
|
||||
++ case exitCode of
|
||||
ExitFailure code -> ": " ++ show code
|
||||
_ -> ""
|
||||
|
||||
@ -54,7 +55,8 @@ makeDbCommand cmd = do
|
||||
studio :: Command ()
|
||||
studio = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectDir = waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
let genProjectDir =
|
||||
waspProjectDir </> Common.dotWaspDirInWaspProjectDir
|
||||
</> Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
waspSaysC "Running studio..."
|
||||
|
@ -1,33 +1,34 @@
|
||||
module Command.Db.Migrate
|
||||
( migrateDev
|
||||
, copyDbMigrationsDir
|
||||
, MigrationDirCopyDirection(..)
|
||||
) where
|
||||
( migrateDev,
|
||||
copyDbMigrationsDir,
|
||||
MigrationDirCopyDirection (..),
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Common (WaspProjectDir)
|
||||
import Control.Monad.Catch (catch)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Path as P
|
||||
import qualified Path.IO as PathIO
|
||||
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Common (WaspProjectDir)
|
||||
import qualified Cli.Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- Wasp generator interface.
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (dbRootDirInProjectRootDir)
|
||||
import qualified Generator.DbGenerator.Operations as DbOps
|
||||
|
||||
import qualified Path as P
|
||||
import qualified Path.IO as PathIO
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
migrateDev :: Command ()
|
||||
migrateDev = do
|
||||
waspProjectDir <- findWaspProjectRootDirFromCwd
|
||||
let genProjectRootDir = waspProjectDir
|
||||
let genProjectRootDir =
|
||||
waspProjectDir
|
||||
</> Cli.Common.dotWaspDirInWaspProjectDir
|
||||
</> Cli.Common.generatedCodeDirInDotWaspDir
|
||||
|
||||
@ -62,15 +63,15 @@ migrateDev = do
|
||||
Nothing -> waspSaysC "Done copying migrations folder."
|
||||
Just err -> throwError $ CommandError $ "Copying migration folder failed: " ++ err
|
||||
|
||||
|
||||
data MigrationDirCopyDirection = CopyMigDirUp | CopyMigDirDown deriving (Eq)
|
||||
|
||||
-- | Copy migrations directory between Wasp source and the generated project.
|
||||
copyDbMigrationsDir
|
||||
:: MigrationDirCopyDirection -- ^ Copy direction (source -> gen or gen-> source)
|
||||
-> Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir ProjectRootDir)
|
||||
-> IO (Maybe String)
|
||||
copyDbMigrationsDir ::
|
||||
-- | Copy direction (source -> gen or gen-> source)
|
||||
MigrationDirCopyDirection ->
|
||||
Path Abs (Dir WaspProjectDir) ->
|
||||
Path Abs (Dir ProjectRootDir) ->
|
||||
IO (Maybe String)
|
||||
copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir = do
|
||||
let dbMigrationsDirInDbRootDir = SP.fromPathRelDir [P.reldir|migrations|]
|
||||
|
||||
@ -78,23 +79,29 @@ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir = do
|
||||
let dbMigrationsDirInWaspProjectDirAbs = waspProjectDir </> dbMigrationsDirInDbRootDir
|
||||
|
||||
-- Migration folder in the generated code.
|
||||
let dbMigrationsDirInGenProjectDirAbs = genProjectRootDir </> dbRootDirInProjectRootDir
|
||||
let dbMigrationsDirInGenProjectDirAbs =
|
||||
genProjectRootDir </> dbRootDirInProjectRootDir
|
||||
</> dbMigrationsDirInDbRootDir
|
||||
|
||||
let src = if copyDirection == CopyMigDirUp
|
||||
let src =
|
||||
if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInGenProjectDirAbs
|
||||
else dbMigrationsDirInWaspProjectDirAbs
|
||||
|
||||
let target = if copyDirection == CopyMigDirUp
|
||||
let target =
|
||||
if copyDirection == CopyMigDirUp
|
||||
then dbMigrationsDirInWaspProjectDirAbs
|
||||
else dbMigrationsDirInGenProjectDirAbs
|
||||
|
||||
doesSrcDirExist <- PathIO.doesDirExist (SP.toPathAbsDir src)
|
||||
if doesSrcDirExist
|
||||
then ((PathIO.copyDirRecur (SP.toPathAbsDir src)
|
||||
(SP.toPathAbsDir target))
|
||||
>> return Nothing)
|
||||
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,21 +1,22 @@
|
||||
module Command.Start
|
||||
( start
|
||||
) where
|
||||
|
||||
import Control.Concurrent.Async (race)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
( start,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Cli.Common as Common
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (findWaspProjectRootDirFromCwd,
|
||||
waspSaysC)
|
||||
import Command.Common
|
||||
( findWaspProjectRootDirFromCwd,
|
||||
waspSaysC,
|
||||
)
|
||||
import Command.Compile (compileIO)
|
||||
import Command.Watch (watch)
|
||||
import Control.Concurrent.Async (race)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Lib
|
||||
import StrongPath ((</>))
|
||||
|
||||
|
||||
-- | Does initial compile of wasp code and then runs the generated project.
|
||||
-- It also listens for any file changes and recompiles and restarts generated project accordingly.
|
||||
start :: Command ()
|
||||
|
@ -1,22 +1,22 @@
|
||||
module Command.Telemetry
|
||||
( considerSendingData
|
||||
, telemetry
|
||||
) where
|
||||
|
||||
import Control.Monad (when, unless)
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Foldable (for_)
|
||||
import qualified System.Environment as ENV
|
||||
( considerSendingData,
|
||||
telemetry,
|
||||
)
|
||||
where
|
||||
|
||||
import Command (Command, CommandError (..))
|
||||
import Command.Common (waspSaysC)
|
||||
import qualified Command.Call
|
||||
import Command.Common (waspSaysC)
|
||||
import Command.Telemetry.Common (ensureTelemetryCacheDirExists)
|
||||
import qualified Command.Telemetry.Project as TlmProject
|
||||
import qualified Command.Telemetry.User as TlmUser
|
||||
import Control.Monad (unless, when)
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Maybe (isJust)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.Environment as ENV
|
||||
|
||||
isTelemetryDisabled :: IO Bool
|
||||
isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
|
||||
@ -25,9 +25,12 @@ isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
|
||||
telemetry :: Command ()
|
||||
telemetry = do
|
||||
telemetryDisabled <- liftIO isTelemetryDisabled
|
||||
waspSaysC $ "Telemetry is currently: " <> (if telemetryDisabled
|
||||
waspSaysC $
|
||||
"Telemetry is currently: "
|
||||
<> ( if telemetryDisabled
|
||||
then "DISABLED"
|
||||
else "ENABLED")
|
||||
else "ENABLED"
|
||||
)
|
||||
|
||||
unless telemetryDisabled $ do
|
||||
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
|
||||
|
@ -1,15 +1,14 @@
|
||||
module Command.Telemetry.Common
|
||||
( TelemetryCacheDir
|
||||
, ensureTelemetryCacheDirExists
|
||||
, getTelemetryCacheDirPath
|
||||
) where
|
||||
( TelemetryCacheDir,
|
||||
ensureTelemetryCacheDirExists,
|
||||
getTelemetryCacheDirPath,
|
||||
)
|
||||
where
|
||||
|
||||
import Path (reldir)
|
||||
import qualified System.Directory as SD
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified System.Directory as SD
|
||||
|
||||
data UserCacheDir
|
||||
|
||||
|
@ -1,13 +1,18 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Command.Telemetry.Project
|
||||
( getWaspProjectPathHash
|
||||
, considerSendingData
|
||||
, readProjectTelemetryFile
|
||||
, getTimeOfLastTelemetryDataSent
|
||||
) where
|
||||
( getWaspProjectPathHash,
|
||||
considerSendingData,
|
||||
readProjectTelemetryFile,
|
||||
getTimeOfLastTelemetryDataSent,
|
||||
)
|
||||
where
|
||||
|
||||
import Command (Command)
|
||||
import qualified Command.Call
|
||||
import Command.Common (findWaspProjectRootDirFromCwd)
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import Command.Telemetry.User (UserSignature (..))
|
||||
import Control.Monad (void, when)
|
||||
import Crypto.Hash (SHA256 (..), hashWith)
|
||||
import Data.Aeson ((.=))
|
||||
@ -20,16 +25,10 @@ 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 Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import Command.Telemetry.User (UserSignature (..))
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified System.Directory as SD
|
||||
import qualified System.Info
|
||||
|
||||
considerSendingData :: Path Abs (Dir TelemetryCacheDir) -> UserSignature -> ProjectHash -> Command.Call.Call -> IO ()
|
||||
considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
|
||||
@ -52,15 +51,17 @@ considerSendingData telemetryCacheDirPath userSignature projectHash cmdCall = do
|
||||
isOlderThan12Hours time = do
|
||||
now <- T.getCurrentTime
|
||||
let secondsSinceLastCheckIn = T.nominalDiffTimeToSeconds (now `T.diffUTCTime` time)
|
||||
return $ let numSecondsInHour = 3600
|
||||
return $
|
||||
let numSecondsInHour = 3600
|
||||
in secondsSinceLastCheckIn > 12 * numSecondsInHour
|
||||
|
||||
newProjectCache :: ProjectTelemetryCache -> IO ProjectTelemetryCache
|
||||
newProjectCache currentProjectCache = do
|
||||
now <- T.getCurrentTime
|
||||
return currentProjectCache
|
||||
{ _lastCheckIn = Just now
|
||||
, _lastCheckInBuild = case cmdCall of
|
||||
return
|
||||
currentProjectCache
|
||||
{ _lastCheckIn = Just now,
|
||||
_lastCheckInBuild = case cmdCall of
|
||||
Command.Call.Build -> Just now
|
||||
_ -> _lastCheckInBuild currentProjectCache
|
||||
}
|
||||
@ -78,12 +79,13 @@ getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> find
|
||||
-- * Project telemetry cache.
|
||||
|
||||
data ProjectTelemetryCache = ProjectTelemetryCache
|
||||
{ _lastCheckIn :: Maybe T.UTCTime -- Last time when CLI was called for this project, any command.
|
||||
, _lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
|
||||
{ _lastCheckIn :: Maybe T.UTCTime, -- Last time when CLI was called for this project, any command.
|
||||
_lastCheckInBuild :: Maybe T.UTCTime -- Last time when CLI was called for this project, with Build command.
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance Aeson.ToJSON ProjectTelemetryCache
|
||||
|
||||
instance Aeson.FromJSON ProjectTelemetryCache
|
||||
|
||||
initialCache :: ProjectTelemetryCache
|
||||
@ -122,40 +124,45 @@ getProjectTelemetryFilePath telemetryCacheDir (ProjectHash projectHash) =
|
||||
-- * Telemetry data.
|
||||
|
||||
data ProjectTelemetryData = ProjectTelemetryData
|
||||
{ _userSignature :: UserSignature
|
||||
, _projectHash :: ProjectHash
|
||||
, _waspVersion :: String
|
||||
, _os :: String
|
||||
, _isBuild :: Bool
|
||||
} deriving (Show)
|
||||
{ _userSignature :: UserSignature,
|
||||
_projectHash :: ProjectHash,
|
||||
_waspVersion :: String,
|
||||
_os :: String,
|
||||
_isBuild :: Bool
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
getProjectTelemetryData :: UserSignature -> ProjectHash -> Command.Call.Call -> ProjectTelemetryData
|
||||
getProjectTelemetryData userSignature projectHash cmdCall = ProjectTelemetryData
|
||||
{ _userSignature = userSignature
|
||||
, _projectHash = projectHash
|
||||
, _waspVersion = showVersion version
|
||||
, _os = System.Info.os
|
||||
, _isBuild = case cmdCall of
|
||||
getProjectTelemetryData userSignature projectHash cmdCall =
|
||||
ProjectTelemetryData
|
||||
{ _userSignature = userSignature,
|
||||
_projectHash = projectHash,
|
||||
_waspVersion = showVersion version,
|
||||
_os = System.Info.os,
|
||||
_isBuild = case cmdCall of
|
||||
Command.Call.Build -> True
|
||||
_ -> False
|
||||
}
|
||||
|
||||
sendTelemetryData :: ProjectTelemetryData -> IO ()
|
||||
sendTelemetryData telemetryData = do
|
||||
let reqBodyJson = Aeson.object
|
||||
let reqBodyJson =
|
||||
Aeson.object
|
||||
[ -- PostHog api_key is public so it is ok that we have it here.
|
||||
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String)
|
||||
, "event" .= ("cli" :: String)
|
||||
, "properties" .= Aeson.object
|
||||
"api_key" .= ("CdDd2A0jKTI2vFAsrI9JWm3MqpOcgHz1bMyogAcwsE4" :: String),
|
||||
"event" .= ("cli" :: String),
|
||||
"properties"
|
||||
.= Aeson.object
|
||||
[ -- distinct_id is special PostHog value, used as user id.
|
||||
"distinct_id" .= _userSignatureValue (_userSignature telemetryData)
|
||||
"distinct_id" .= _userSignatureValue (_userSignature telemetryData),
|
||||
-- Following are our custom metrics:
|
||||
, "project_hash" .= _projectHashValue (_projectHash telemetryData)
|
||||
, "wasp_version" .= _waspVersion telemetryData
|
||||
, "os" .= _os telemetryData
|
||||
, "is_build" .= _isBuild telemetryData
|
||||
"project_hash" .= _projectHashValue (_projectHash telemetryData),
|
||||
"wasp_version" .= _waspVersion telemetryData,
|
||||
"os" .= _os telemetryData,
|
||||
"is_build" .= _isBuild telemetryData
|
||||
]
|
||||
]
|
||||
request = HTTP.setRequestBodyJSON reqBodyJson $
|
||||
request =
|
||||
HTTP.setRequestBodyJSON reqBodyJson $
|
||||
HTTP.parseRequest_ "POST https://app.posthog.com/capture"
|
||||
void $ HTTP.httpNoBody request
|
||||
|
@ -1,19 +1,17 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Command.Telemetry.User
|
||||
( UserSignature(..)
|
||||
, readOrCreateUserSignatureFile
|
||||
) where
|
||||
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import Path (relfile)
|
||||
import qualified System.Directory as SD
|
||||
( UserSignature (..),
|
||||
readOrCreateUserSignatureFile,
|
||||
)
|
||||
where
|
||||
|
||||
import Command.Telemetry.Common (TelemetryCacheDir)
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import Path (relfile)
|
||||
import StrongPath (Abs, Dir, File, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
|
||||
import qualified System.Directory as SD
|
||||
|
||||
-- Random, non-identifyable UUID used to represent user in analytics.
|
||||
newtype UserSignature = UserSignature {_userSignatureValue :: String} deriving (Show)
|
||||
@ -23,12 +21,13 @@ readOrCreateUserSignatureFile telemetryCacheDirPath = do
|
||||
let filePath = getUserSignatureFilePath telemetryCacheDirPath
|
||||
let filePathFP = SP.toFilePath filePath
|
||||
fileExists <- SD.doesFileExist filePathFP
|
||||
UserSignature <$> if fileExists
|
||||
UserSignature
|
||||
<$> if fileExists
|
||||
then readFile filePathFP
|
||||
else do userSignature <- show <$> UUID.nextRandom
|
||||
else do
|
||||
userSignature <- show <$> UUID.nextRandom
|
||||
writeFile filePathFP userSignature
|
||||
return userSignature
|
||||
|
||||
getUserSignatureFilePath :: Path Abs (Dir TelemetryCacheDir) -> Path Abs File
|
||||
getUserSignatureFilePath telemetryCacheDir = telemetryCacheDir SP.</> SP.fromPathRelFile [relfile|signature|]
|
||||
|
||||
|
@ -1,20 +1,19 @@
|
||||
module Command.Watch
|
||||
( watch
|
||||
) where
|
||||
|
||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.FSNotify as FSN
|
||||
( watch,
|
||||
)
|
||||
where
|
||||
|
||||
import Cli.Common (waspSays)
|
||||
import qualified Cli.Common as Common
|
||||
import Command.Compile (compileIO)
|
||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||
import qualified Lib
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified System.FSNotify as FSN
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
-- TODO: Another possible problem: on re-generation, wasp re-generates a lot of files, even those that should not
|
||||
-- be generated again, since it is not smart enough yet to know which files do not need to be regenerated.
|
||||
@ -27,6 +26,7 @@ import qualified StrongPath as SP
|
||||
-- TODO: Idea: Read .gitignore file, and ignore everything from it. This will then also cover the
|
||||
-- .wasp dir, and users can easily add any custom stuff they want ignored. But, we also have to
|
||||
-- be ready for the case when there is no .gitignore, that could be possible.
|
||||
|
||||
-- | Forever listens for any file changes in waspProjectDir, and if there is a change,
|
||||
-- compiles Wasp source files in waspProjectDir and regenerates files in outDir.
|
||||
watch :: Path Abs (Dir Common.WaspProjectDir) -> Path Abs (Dir Lib.ProjectRootDir) -> IO ()
|
||||
@ -42,8 +42,8 @@ watch waspProjectDir outDir = FSN.withManager $ \mgr -> do
|
||||
event <- readChan chan
|
||||
let eventTime = FSN.eventTime event
|
||||
if eventTime < lastCompileTime
|
||||
-- If event happened before last compilation started, skip it.
|
||||
then listenForEvents chan lastCompileTime
|
||||
then -- If event happened before last compilation started, skip it.
|
||||
listenForEvents chan lastCompileTime
|
||||
else do
|
||||
currentTime <- getCurrentTime
|
||||
recompile
|
||||
|
@ -1,13 +1,5 @@
|
||||
module Main where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Version (showVersion)
|
||||
import Paths_waspc (version)
|
||||
import System.Environment
|
||||
|
||||
import Command (runCommand)
|
||||
import Command.Build (build)
|
||||
import qualified Command.Call
|
||||
@ -18,9 +10,15 @@ import Command.Db (runDbCommand, studio)
|
||||
import qualified Command.Db.Migrate
|
||||
import Command.Start (start)
|
||||
import qualified Command.Telemetry as Telemetry
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Version (showVersion)
|
||||
import Paths_waspc (version)
|
||||
import System.Environment
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
@ -52,32 +50,35 @@ main = do
|
||||
-- We also make sure here to catch all errors that might get thrown and silence them.
|
||||
void $ Async.race (threadDelaySeconds 1) (Async.waitCatch telemetryThread)
|
||||
where
|
||||
threadDelaySeconds = let microsecondsInASecond = 1000000
|
||||
threadDelaySeconds =
|
||||
let microsecondsInASecond = 1000000
|
||||
in threadDelay . (* microsecondsInASecond)
|
||||
|
||||
printUsage :: IO ()
|
||||
printUsage = putStrLn $ unlines
|
||||
[ title "USAGE"
|
||||
, " wasp <command> [command-args]"
|
||||
, ""
|
||||
, title "COMMANDS"
|
||||
, title " GENERAL"
|
||||
, cmd " new <project-name> Creates new Wasp project."
|
||||
, cmd " version Prints current version of CLI."
|
||||
, title " IN PROJECT"
|
||||
, cmd " start Runs Wasp app in development mode, watching for file changes."
|
||||
, cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info."
|
||||
, cmd " clean Deletes all generated code and other cached artifacts. Wasp equivalent of 'have you tried closing and opening it again?'."
|
||||
, cmd " build Generates full web app code, ready for deployment. Use when deploying or ejecting."
|
||||
, cmd " telemetry Prints telemetry status."
|
||||
, ""
|
||||
, title "EXAMPLES"
|
||||
, " wasp new MyApp"
|
||||
, " wasp start"
|
||||
, " wasp db migrate-dev"
|
||||
, ""
|
||||
, Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs"
|
||||
, Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
||||
printUsage =
|
||||
putStrLn $
|
||||
unlines
|
||||
[ title "USAGE",
|
||||
" wasp <command> [command-args]",
|
||||
"",
|
||||
title "COMMANDS",
|
||||
title " GENERAL",
|
||||
cmd " new <project-name> Creates new Wasp project.",
|
||||
cmd " version Prints current version of CLI.",
|
||||
title " IN PROJECT",
|
||||
cmd " start Runs Wasp app in development mode, watching for file changes.",
|
||||
cmd " db <db-cmd> [args] Executes a database command. Run 'wasp db' for more info.",
|
||||
cmd " clean Deletes all generated code and other cached artifacts. Wasp equivalent of 'have you tried closing and opening it again?'.",
|
||||
cmd " build Generates full web app code, ready for deployment. Use when deploying or ejecting.",
|
||||
cmd " telemetry Prints telemetry status.",
|
||||
"",
|
||||
title "EXAMPLES",
|
||||
" wasp new MyApp",
|
||||
" wasp start",
|
||||
" wasp db migrate-dev",
|
||||
"",
|
||||
Term.applyStyles [Term.Green] "Docs:" ++ " https://wasp-lang.dev/docs",
|
||||
Term.applyStyles [Term.Magenta] "Discord (chat):" ++ " https://discord.gg/rzdnErX"
|
||||
]
|
||||
|
||||
printVersion :: IO ()
|
||||
@ -91,21 +92,23 @@ dbCli args = case args of
|
||||
_ -> printDbUsage
|
||||
|
||||
printDbUsage :: IO ()
|
||||
printDbUsage = putStrLn $ unlines
|
||||
[ title "USAGE"
|
||||
, " wasp db <command> [command-args]"
|
||||
, ""
|
||||
, title "COMMANDS"
|
||||
, cmd (
|
||||
" migrate-dev Ensures dev database corresponds to the current state of schema(entities):\n" <>
|
||||
" - Generates a new migration if there are changes in the schema.\n" <>
|
||||
" - Applies any pending migrations to the database."
|
||||
)
|
||||
, cmd " studio GUI for inspecting your database."
|
||||
, ""
|
||||
, title "EXAMPLES"
|
||||
, " wasp db migrate-dev"
|
||||
, " wasp db studio"
|
||||
printDbUsage =
|
||||
putStrLn $
|
||||
unlines
|
||||
[ title "USAGE",
|
||||
" wasp db <command> [command-args]",
|
||||
"",
|
||||
title "COMMANDS",
|
||||
cmd
|
||||
( " migrate-dev Ensures dev database corresponds to the current state of schema(entities):\n"
|
||||
<> " - Generates a new migration if there are changes in the schema.\n"
|
||||
<> " - Applies any pending migrations to the database."
|
||||
),
|
||||
cmd " studio GUI for inspecting your database.",
|
||||
"",
|
||||
title "EXAMPLES",
|
||||
" wasp db migrate-dev",
|
||||
" wasp db studio"
|
||||
]
|
||||
|
||||
title :: String -> String
|
||||
|
@ -1,5 +1,6 @@
|
||||
module Common
|
||||
( WaspProjectDir
|
||||
) where
|
||||
( WaspProjectDir,
|
||||
)
|
||||
where
|
||||
|
||||
data WaspProjectDir -- Root dir of Wasp project, containing source files.
|
||||
|
@ -1,15 +1,15 @@
|
||||
module CompileOptions
|
||||
( CompileOptions(..)
|
||||
) where
|
||||
( CompileOptions (..),
|
||||
)
|
||||
where
|
||||
|
||||
import StrongPath (Path, Abs, Dir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
-- TODO(martin): Should these be merged with Wasp data? Is it really a separate thing or not?
|
||||
-- It would be easier to pass around if it is part of Wasp data. But is it semantically correct?
|
||||
-- Maybe it is, even more than this!
|
||||
data CompileOptions = CompileOptions
|
||||
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
||||
, isBuild :: !Bool
|
||||
{ externalCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||
isBuild :: !Bool
|
||||
}
|
||||
|
@ -1,13 +1,12 @@
|
||||
module Data
|
||||
( DataDir
|
||||
, getAbsDataDirPath
|
||||
) where
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
( DataDir,
|
||||
getAbsDataDirPath,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Paths_waspc
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
data DataDir
|
||||
|
||||
|
@ -1,32 +1,33 @@
|
||||
module ExternalCode
|
||||
( File
|
||||
, filePathInExtCodeDir
|
||||
, fileAbsPath
|
||||
, fileText
|
||||
, readFiles
|
||||
, SourceExternalCodeDir
|
||||
) where
|
||||
( File,
|
||||
filePathInExtCodeDir,
|
||||
fileAbsPath,
|
||||
fileText,
|
||||
readFiles,
|
||||
SourceExternalCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import qualified Data.Text.Lazy as TextL
|
||||
import qualified Data.Text.Lazy.IO as TextL.IO
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Lazy as TextL
|
||||
import qualified Data.Text.Lazy.IO as TextL.IO
|
||||
import qualified Path as P
|
||||
|
||||
import qualified Util.IO
|
||||
import StrongPath (Path, Abs, Rel, Dir, (</>))
|
||||
import StrongPath (Abs, Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import WaspignoreFile (readWaspignoreFile, ignores)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import qualified Util.IO
|
||||
import WaspignoreFile (ignores, readWaspignoreFile)
|
||||
|
||||
-- | External code directory in Wasp source, from which external code files are read.
|
||||
data SourceExternalCodeDir
|
||||
|
||||
data File = File
|
||||
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File)
|
||||
, _extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir))
|
||||
, _text :: TextL.Text -- ^ File content. It will throw error when evaluated if file is not textual file.
|
||||
{ _pathInExtCodeDir :: !(Path (Rel SourceExternalCodeDir) SP.File),
|
||||
_extCodeDirPath :: !(Path Abs (Dir SourceExternalCodeDir)),
|
||||
-- | File content. It will throw error when evaluated if file is not textual file.
|
||||
_text :: TextL.Text
|
||||
}
|
||||
|
||||
instance Show File where
|
||||
@ -56,9 +57,10 @@ readFiles :: Path Abs (Dir SourceExternalCodeDir) -> IO [File]
|
||||
readFiles extCodeDirPath = do
|
||||
let waspignoreFilePath = extCodeDirPath </> waspignorePathInExtCodeDir
|
||||
waspignoreFile <- readWaspignoreFile waspignoreFilePath
|
||||
relFilePaths <- filter (not . ignores waspignoreFile . SP.toFilePath) .
|
||||
map SP.fromPathRelFile <$>
|
||||
Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
||||
relFilePaths <-
|
||||
filter (not . ignores waspignoreFile . SP.toFilePath)
|
||||
. map SP.fromPathRelFile
|
||||
<$> Util.IO.listDirectoryDeep (SP.toPathAbsDir extCodeDirPath)
|
||||
let absFilePaths = map (extCodeDirPath </>) relFilePaths
|
||||
-- NOTE: We read text from all the files, regardless if they are text files or not, because
|
||||
-- we don't know if they are a text file or not.
|
||||
@ -81,6 +83,10 @@ readFiles extCodeDirPath = do
|
||||
-- but then got deleted before actual reading was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
tryReadFile :: FilePath -> IO (Maybe TextL.Text)
|
||||
tryReadFile fp = (Just <$> TextL.IO.readFile fp) `catch` (\e -> if isDoesNotExistError e
|
||||
tryReadFile fp =
|
||||
(Just <$> TextL.IO.readFile fp)
|
||||
`catch` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return Nothing
|
||||
else throwIO e)
|
||||
else throwIO e
|
||||
)
|
||||
|
@ -1,31 +1,30 @@
|
||||
module Generator
|
||||
( writeWebAppCode
|
||||
, Generator.Setup.setup
|
||||
, Generator.Start.start
|
||||
) where
|
||||
( writeWebAppCode,
|
||||
Generator.Setup.setup,
|
||||
Generator.Start.start,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.IO
|
||||
import Data.Time.Clock
|
||||
import qualified Data.Version
|
||||
import qualified Path as P
|
||||
import qualified Paths_waspc
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (genDb)
|
||||
import Generator.DockerGenerator (genDockerFiles)
|
||||
import Generator.FileDraft (FileDraft, write)
|
||||
import Generator.ServerGenerator (genServer)
|
||||
import qualified Generator.ServerGenerator as ServerGenerator
|
||||
import Generator.DockerGenerator (genDockerFiles)
|
||||
import qualified Generator.Setup
|
||||
import qualified Generator.Start
|
||||
import Generator.WebAppGenerator (generateWebApp)
|
||||
import qualified Path as P
|
||||
import qualified Paths_waspc
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
|
||||
|
||||
-- | Generates web app code from given Wasp and writes it to given destination directory.
|
||||
-- If dstDir does not exist yet, it will be created.
|
||||
-- NOTE(martin): What if there is already smth in the dstDir? It is probably best
|
||||
|
@ -1,8 +1,9 @@
|
||||
module Generator.Common
|
||||
( ProjectRootDir
|
||||
, nodeVersion
|
||||
, nodeVersionAsText
|
||||
) where
|
||||
( ProjectRootDir,
|
||||
nodeVersion,
|
||||
nodeVersionAsText,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Printf (printf)
|
||||
|
||||
@ -16,4 +17,5 @@ nodeVersion = (12, 18, 0) -- Latest LTS version.
|
||||
|
||||
nodeVersionAsText :: String
|
||||
nodeVersionAsText = printf "%d.%d.%d" major minor patch
|
||||
where (major, minor, patch) = nodeVersion
|
||||
where
|
||||
(major, minor, patch) = nodeVersion
|
||||
|
@ -1,17 +1,17 @@
|
||||
module Generator.DbGenerator
|
||||
( genDb
|
||||
, dbRootDirInProjectRootDir
|
||||
, dbSchemaFileInProjectRootDir
|
||||
) where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Path as P
|
||||
import Data.Maybe (fromMaybe)
|
||||
( genDb,
|
||||
dbRootDirInProjectRootDir,
|
||||
dbSchemaFileInProjectRootDir,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
import qualified Psl.Ast.Model
|
||||
import qualified Psl.Generator.Model
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
@ -25,6 +25,7 @@ import qualified Wasp.Entity
|
||||
-- * Path definitions
|
||||
|
||||
data DbRootDir
|
||||
|
||||
data DbTemplatesDir
|
||||
|
||||
dbRootDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir DbRootDir)
|
||||
@ -57,20 +58,23 @@ genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templat
|
||||
dstPath = dbSchemaFileInProjectRootDir
|
||||
tmplSrcPath = dbTemplatesDirInTemplatesDir </> dbSchemaFileInDbTemplatesDir
|
||||
|
||||
templateData = object
|
||||
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp)
|
||||
, "datasourceProvider" .= (datasourceProvider :: String)
|
||||
, "datasourceUrl" .= (datasourceUrl :: String)
|
||||
templateData =
|
||||
object
|
||||
[ "modelSchemas" .= map entityToPslModelSchema (Wasp.getPSLEntities wasp),
|
||||
"datasourceProvider" .= (datasourceProvider :: String),
|
||||
"datasourceUrl" .= (datasourceUrl :: String)
|
||||
]
|
||||
|
||||
dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp
|
||||
(datasourceProvider, datasourceUrl) = case dbSystem of
|
||||
Wasp.Db.PostgreSQL -> ("postgresql", "env(\"DATABASE_URL\")")
|
||||
-- TODO: Report this error with some better mechanism, not `error`.
|
||||
Wasp.Db.SQLite -> if Wasp.getIsBuild wasp
|
||||
Wasp.Db.SQLite ->
|
||||
if Wasp.getIsBuild wasp
|
||||
then error "SQLite is not supported in production. Set db.system to smth else."
|
||||
else ("sqlite", "\"file:./dev.db\"")
|
||||
|
||||
entityToPslModelSchema :: Entity -> String
|
||||
entityToPslModelSchema entity = Psl.Generator.Model.generateModel $
|
||||
entityToPslModelSchema entity =
|
||||
Psl.Generator.Model.generateModel $
|
||||
Psl.Ast.Model.Model (Wasp.Entity._name entity) (Wasp.Entity._pslModelBody entity)
|
||||
|
@ -1,16 +1,16 @@
|
||||
module Generator.DbGenerator.Jobs
|
||||
( migrateDev
|
||||
, runStudio
|
||||
) where
|
||||
( migrateDev,
|
||||
runStudio,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.DbGenerator (dbSchemaFileInProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import Generator.ServerGenerator.Common (serverRootDirInProjectRootDir)
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ServerGenerator.Common (serverRootDirInProjectRootDir)
|
||||
import Generator.DbGenerator (dbSchemaFileInProjectRootDir)
|
||||
|
||||
|
||||
migrateDev :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
migrateDev projectDir = do
|
||||
@ -19,10 +19,16 @@ migrateDev projectDir = do
|
||||
|
||||
-- NOTE(matija): We are running this command from server's root dir since that is where
|
||||
-- Prisma packages (cli and client) are currently installed.
|
||||
runNodeCommandAsJob serverDir "npx"
|
||||
[ "prisma", "migrate", "dev"
|
||||
, "--schema", SP.toFilePath schemaFile
|
||||
] J.Db
|
||||
runNodeCommandAsJob
|
||||
serverDir
|
||||
"npx"
|
||||
[ "prisma",
|
||||
"migrate",
|
||||
"dev",
|
||||
"--schema",
|
||||
SP.toFilePath schemaFile
|
||||
]
|
||||
J.Db
|
||||
|
||||
-- | Runs `prisma studio` - Prisma's db inspector.
|
||||
runStudio :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
@ -30,7 +36,12 @@ runStudio projectDir = do
|
||||
let serverDir = projectDir </> serverRootDirInProjectRootDir
|
||||
let schemaFile = projectDir </> dbSchemaFileInProjectRootDir
|
||||
|
||||
runNodeCommandAsJob serverDir "npx"
|
||||
[ "prisma", "studio"
|
||||
, "--schema", SP.toFilePath schemaFile
|
||||
] J.Db
|
||||
runNodeCommandAsJob
|
||||
serverDir
|
||||
"npx"
|
||||
[ "prisma",
|
||||
"studio",
|
||||
"--schema",
|
||||
SP.toFilePath schemaFile
|
||||
]
|
||||
J.Db
|
||||
|
@ -1,17 +1,17 @@
|
||||
module Generator.DbGenerator.Operations
|
||||
( migrateDev
|
||||
) where
|
||||
( migrateDev,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, newChan, readChan)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Job.IO (printJobMessage)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job (JobMessage)
|
||||
import qualified Generator.DbGenerator.Jobs as DbJobs
|
||||
import Generator.Job (JobMessage)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.IO (printJobMessage)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
printJobMsgsUntilExitReceived :: Chan JobMessage -> IO ()
|
||||
printJobMsgsUntilExitReceived chan = do
|
||||
@ -23,7 +23,9 @@ printJobMsgsUntilExitReceived chan = do
|
||||
migrateDev :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
migrateDev projectDir = do
|
||||
chan <- newChan
|
||||
(_, dbExitCode) <- concurrently (printJobMsgsUntilExitReceived chan)
|
||||
(_, dbExitCode) <-
|
||||
concurrently
|
||||
(printJobMsgsUntilExitReceived chan)
|
||||
(DbJobs.migrateDev projectDir chan)
|
||||
case dbExitCode of
|
||||
ExitSuccess -> return (Right ())
|
||||
|
@ -1,36 +1,41 @@
|
||||
module Generator.DockerGenerator
|
||||
( genDockerFiles
|
||||
) where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
( genDockerFiles,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
genDockerFiles :: Wasp -> CompileOptions -> [FileDraft]
|
||||
genDockerFiles wasp _ = concat
|
||||
[ [genDockerfile wasp]
|
||||
, [genDockerignore wasp]
|
||||
genDockerFiles wasp _ =
|
||||
concat
|
||||
[ [genDockerfile wasp],
|
||||
[genDockerignore wasp]
|
||||
]
|
||||
|
||||
-- TODO: Inject paths to server and db files/dirs, right now they are hardcoded in the templates.
|
||||
genDockerfile :: Wasp -> FileDraft
|
||||
genDockerfile wasp = createTemplateFileDraft
|
||||
genDockerfile wasp =
|
||||
createTemplateFileDraft
|
||||
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel ProjectRootDir) File)
|
||||
(SP.fromPathRelFile [P.relfile|Dockerfile|] :: Path (Rel TemplatesDir) File)
|
||||
(Just $ object
|
||||
( Just $
|
||||
object
|
||||
[ "usingPrisma" .= not (null $ Wasp.getPSLEntities wasp)
|
||||
])
|
||||
]
|
||||
)
|
||||
|
||||
genDockerignore :: Wasp -> FileDraft
|
||||
genDockerignore _ = createTemplateFileDraft
|
||||
genDockerignore _ =
|
||||
createTemplateFileDraft
|
||||
(SP.fromPathRelFile [P.relfile|.dockerignore|] :: Path (Rel ProjectRootDir) File)
|
||||
(SP.fromPathRelFile [P.relfile|dockerignore|] :: Path (Rel TemplatesDir) File)
|
||||
Nothing
|
||||
|
@ -1,31 +1,33 @@
|
||||
module Generator.ExternalCodeGenerator
|
||||
( generateExternalCodeDir
|
||||
) where
|
||||
( generateExternalCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
import StrongPath (Path, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified ExternalCode as EC
|
||||
import qualified Generator.FileDraft as FD
|
||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Js (generateJsFile)
|
||||
|
||||
import qualified Generator.FileDraft as FD
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.FilePath as FP
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
-- | Takes external code files from Wasp and generates them in new location as part of the generated project.
|
||||
-- It might not just copy them but also do some changes on them, as needed.
|
||||
generateExternalCodeDir :: C.ExternalCodeGeneratorStrategy
|
||||
-> Wasp
|
||||
-> [FD.FileDraft]
|
||||
generateExternalCodeDir ::
|
||||
C.ExternalCodeGeneratorStrategy ->
|
||||
Wasp ->
|
||||
[FD.FileDraft]
|
||||
generateExternalCodeDir strategy wasp =
|
||||
map (generateFile strategy) (Wasp.getExternalCodeFiles wasp)
|
||||
|
||||
generateFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||
generateFile strategy file
|
||||
| extension `elem` [".js", ".jsx"] = generateJsFile strategy file
|
||||
| otherwise = let relDstPath = (C._extCodeDirInProjectRootDir strategy)
|
||||
| otherwise =
|
||||
let relDstPath =
|
||||
(C._extCodeDirInProjectRootDir strategy)
|
||||
</> dstPathInGenExtCodeDir
|
||||
absSrcPath = EC.fileAbsPath file
|
||||
in FD.createCopyFileDraft relDstPath absSrcPath
|
||||
@ -34,6 +36,3 @@ generateFile strategy file
|
||||
dstPathInGenExtCodeDir = C.castRelPathFromSrcToGenExtCodeDir $ EC.filePathInExtCodeDir file
|
||||
|
||||
extension = FP.takeExtension $ SP.toFilePath $ EC.filePathInExtCodeDir file
|
||||
|
||||
|
||||
|
||||
|
@ -1,17 +1,17 @@
|
||||
module Generator.ExternalCodeGenerator.Common
|
||||
( ExternalCodeGeneratorStrategy(..)
|
||||
, GeneratedExternalCodeDir
|
||||
, castRelPathFromSrcToGenExtCodeDir
|
||||
, asGenExtFile
|
||||
) where
|
||||
( ExternalCodeGeneratorStrategy (..),
|
||||
GeneratedExternalCodeDir,
|
||||
castRelPathFromSrcToGenExtCodeDir,
|
||||
asGenExtFile,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir)
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Path to the directory where ext code will be generated.
|
||||
data GeneratedExternalCodeDir
|
||||
@ -26,6 +26,6 @@ data ExternalCodeGeneratorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ -- | Takes a path where the external code js file will be generated.
|
||||
-- Also takes text of the file. Returns text where special @wasp imports have been replaced with
|
||||
-- imports that will work.
|
||||
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text
|
||||
, _extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
||||
_resolveJsFileWaspImports :: Path (Rel GeneratedExternalCodeDir) File -> Text -> Text,
|
||||
_extCodeDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir GeneratedExternalCodeDir)
|
||||
}
|
||||
|
@ -1,20 +1,19 @@
|
||||
module Generator.ExternalCodeGenerator.Js
|
||||
( generateJsFile
|
||||
, resolveJsFileWaspImportsForExtCodeDir
|
||||
) where
|
||||
( generateJsFile,
|
||||
resolveJsFileWaspImportsForExtCodeDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Text.Regex.TDFA as TR
|
||||
import Data.Text (Text, unpack)
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Path.Extra (reversePosixPath, toPosixFilePath)
|
||||
import qualified Generator.FileDraft as FD
|
||||
import qualified Data.Text as T
|
||||
import qualified ExternalCode as EC
|
||||
import Generator.ExternalCodeGenerator.Common (GeneratedExternalCodeDir)
|
||||
import qualified Generator.ExternalCodeGenerator.Common as C
|
||||
|
||||
import qualified Generator.FileDraft as FD
|
||||
import Path.Extra (reversePosixPath, toPosixFilePath)
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import qualified Text.Regex.TDFA as TR
|
||||
|
||||
generateJsFile :: C.ExternalCodeGeneratorStrategy -> EC.File -> FD.FileDraft
|
||||
generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
||||
@ -29,11 +28,15 @@ generateJsFile strategy file = FD.createTextFileDraft dstPath text'
|
||||
dstPath = (C._extCodeDirInProjectRootDir strategy) </> filePathInGenExtCodeDir
|
||||
|
||||
-- | Replaces imports that start with "@wasp/" with imports that start from the src dir of the app.
|
||||
resolveJsFileWaspImportsForExtCodeDir
|
||||
:: Path (Rel ()) (Dir GeneratedExternalCodeDir) -- ^ Relative path of ext code dir in src dir of app (web app, server (app), ...)
|
||||
-> Path (Rel GeneratedExternalCodeDir) File -- ^ Path where this JS file will be generated.
|
||||
-> Text -- ^ Original text of the file.
|
||||
-> Text -- ^ Text of the file with special "@wasp" imports resolved (replaced with normal JS imports).
|
||||
resolveJsFileWaspImportsForExtCodeDir ::
|
||||
-- | Relative path of ext code dir in src dir of app (web app, server (app), ...)
|
||||
Path (Rel ()) (Dir GeneratedExternalCodeDir) ->
|
||||
-- | Path where this JS file will be generated.
|
||||
Path (Rel GeneratedExternalCodeDir) File ->
|
||||
-- | Original text of the file.
|
||||
Text ->
|
||||
-- | Text of the file with special "@wasp" imports resolved (replaced with normal JS imports).
|
||||
Text
|
||||
resolveJsFileWaspImportsForExtCodeDir extCodeDirInAppSrcDir jsFileDstPathInExtCodeDir jsFileText =
|
||||
let matches = concat (unpack jsFileText TR.=~ ("(from +['\"]@wasp/)" :: String) :: [[String]])
|
||||
in foldr replaceFromWasp jsFileText matches
|
||||
|
@ -1,23 +1,22 @@
|
||||
module Generator.FileDraft
|
||||
( FileDraft(..)
|
||||
, Writeable(..)
|
||||
, createTemplateFileDraft
|
||||
, createCopyFileDraft
|
||||
, createCopyFileDraftIfExists
|
||||
, createTextFileDraft
|
||||
) where
|
||||
( FileDraft (..),
|
||||
Writeable (..),
|
||||
createTemplateFileDraft,
|
||||
createCopyFileDraft,
|
||||
createCopyFileDraftIfExists,
|
||||
createTextFileDraft,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
|
||||
import StrongPath (Path, Abs, Rel, File)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import qualified Generator.FileDraft.TemplateFileDraft as TmplFD
|
||||
import qualified Generator.FileDraft.CopyFileDraft as CopyFD
|
||||
import qualified Generator.FileDraft.TemplateFileDraft as TmplFD
|
||||
import qualified Generator.FileDraft.TextFileDraft as TextFD
|
||||
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import StrongPath (Abs, File, Path, Rel)
|
||||
|
||||
-- | FileDraft unites different file draft types into a single type,
|
||||
-- so that in the rest of the system they can be passed around as heterogeneous
|
||||
@ -33,31 +32,35 @@ instance Writeable FileDraft where
|
||||
write dstDir (FileDraftCopyFd draft) = write dstDir draft
|
||||
write dstDir (FileDraftTextFd draft) = write dstDir draft
|
||||
|
||||
|
||||
createTemplateFileDraft :: Path (Rel ProjectRootDir) File
|
||||
-> Path (Rel TemplatesDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
createTemplateFileDraft ::
|
||||
Path (Rel ProjectRootDir) File ->
|
||||
Path (Rel TemplatesDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
createTemplateFileDraft dstPath tmplSrcPath tmplData =
|
||||
FileDraftTemplateFd $ TmplFD.TemplateFileDraft { TmplFD._dstPath = dstPath
|
||||
, TmplFD._srcPathInTmplDir = tmplSrcPath
|
||||
, TmplFD._tmplData = tmplData
|
||||
FileDraftTemplateFd $
|
||||
TmplFD.TemplateFileDraft
|
||||
{ TmplFD._dstPath = dstPath,
|
||||
TmplFD._srcPathInTmplDir = tmplSrcPath,
|
||||
TmplFD._tmplData = tmplData
|
||||
}
|
||||
|
||||
createCopyFileDraft :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||
createCopyFileDraft dstPath srcPath =
|
||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath
|
||||
, CopyFD._srcPath = srcPath
|
||||
, CopyFD._failIfSrcDoesNotExist = True
|
||||
FileDraftCopyFd $
|
||||
CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath,
|
||||
CopyFD._srcPath = srcPath,
|
||||
CopyFD._failIfSrcDoesNotExist = True
|
||||
}
|
||||
|
||||
createCopyFileDraftIfExists :: Path (Rel ProjectRootDir) File -> Path Abs File -> FileDraft
|
||||
createCopyFileDraftIfExists dstPath srcPath =
|
||||
FileDraftCopyFd $ CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath
|
||||
, CopyFD._srcPath = srcPath
|
||||
, CopyFD._failIfSrcDoesNotExist = False
|
||||
FileDraftCopyFd $
|
||||
CopyFD.CopyFileDraft
|
||||
{ CopyFD._dstPath = dstPath,
|
||||
CopyFD._srcPath = srcPath,
|
||||
CopyFD._failIfSrcDoesNotExist = False
|
||||
}
|
||||
|
||||
createTextFileDraft :: Path (Rel ProjectRootDir) File -> Text -> FileDraft
|
||||
|
@ -1,25 +1,29 @@
|
||||
module Generator.FileDraft.CopyFileDraft
|
||||
( CopyFileDraft(..)
|
||||
) where
|
||||
( CopyFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (when)
|
||||
import System.IO.Error (doesNotExistErrorType, mkIOError)
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
import StrongPath (Abs, File, Path, Rel,
|
||||
(</>))
|
||||
import StrongPath
|
||||
( Abs,
|
||||
File,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import System.IO.Error (doesNotExistErrorType, mkIOError)
|
||||
|
||||
-- | File draft based purely on another file, that is just copied.
|
||||
data CopyFileDraft = CopyFileDraft
|
||||
{ -- | Path where the file will be copied to.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File)
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
-- | Absolute path of source file to copy.
|
||||
, _srcPath :: !(Path Abs File)
|
||||
, _failIfSrcDoesNotExist :: Bool
|
||||
_srcPath :: !(Path Abs File),
|
||||
_failIfSrcDoesNotExist :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -33,7 +37,8 @@ instance Writeable CopyFileDraft where
|
||||
else
|
||||
when
|
||||
(_failIfSrcDoesNotExist draft)
|
||||
(throwIO $ mkIOError
|
||||
( throwIO $
|
||||
mkIOError
|
||||
doesNotExistErrorType
|
||||
"Source file of CopyFileDraft does not exist."
|
||||
Nothing
|
||||
|
@ -1,21 +1,24 @@
|
||||
module Generator.FileDraft.TemplateFileDraft
|
||||
( TemplateFileDraft(..)
|
||||
) where
|
||||
( TemplateFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
|
||||
import StrongPath (Path, Abs, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import StrongPath (Abs, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | File draft based on template file that gets combined with data.
|
||||
data TemplateFileDraft = TemplateFileDraft
|
||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
||||
, _srcPathInTmplDir :: !(Path (Rel TemplatesDir) File) -- ^ Path of template source file.
|
||||
, _tmplData :: Maybe Aeson.Value -- ^ Data to be fed to the template while rendering it.
|
||||
{ -- | Path where file will be generated.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
-- | Path of template source file.
|
||||
_srcPathInTmplDir :: !(Path (Rel TemplatesDir) File),
|
||||
-- | Data to be fed to the template while rendering it.
|
||||
_tmplData :: Maybe Aeson.Value
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
@ -1,20 +1,20 @@
|
||||
module Generator.FileDraft.TextFileDraft
|
||||
( TextFileDraft(..)
|
||||
) where
|
||||
( TextFileDraft (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text (Text)
|
||||
|
||||
import StrongPath (Path, Rel, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.Writeable
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | File draft based on text, that is to be written to file when time comes.
|
||||
data TextFileDraft = TextFileDraft
|
||||
{ _dstPath :: !(Path (Rel ProjectRootDir) File) -- ^ Path where file will be generated.
|
||||
, _content :: Text
|
||||
{ -- | Path where file will be generated.
|
||||
_dstPath :: !(Path (Rel ProjectRootDir) File),
|
||||
_content :: Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
@ -1,15 +1,16 @@
|
||||
module Generator.FileDraft.Writeable
|
||||
( Writeable(..)
|
||||
) where
|
||||
( Writeable (..),
|
||||
)
|
||||
where
|
||||
|
||||
import StrongPath (Path, Abs, Dir)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft.WriteableMonad
|
||||
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
class Writeable w where
|
||||
-- | Write file somewhere in the provided project root directory.
|
||||
write :: (WriteableMonad m)
|
||||
=> Path Abs (Dir ProjectRootDir)
|
||||
-> w
|
||||
-> m ()
|
||||
write ::
|
||||
(WriteableMonad m) =>
|
||||
Path Abs (Dir ProjectRootDir) ->
|
||||
w ->
|
||||
m ()
|
||||
|
@ -1,63 +1,73 @@
|
||||
module Generator.FileDraft.WriteableMonad
|
||||
( WriteableMonad(..)
|
||||
) where
|
||||
( WriteableMonad (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.IO
|
||||
import qualified Generator.Templates as Templates
|
||||
import StrongPath (Abs, Dir, File, Path, Rel)
|
||||
import qualified System.Directory
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (Exception, catch)
|
||||
import qualified UnliftIO.Exception as E
|
||||
|
||||
import qualified Generator.Templates as Templates
|
||||
import StrongPath (Abs, Dir, File, Path, Rel)
|
||||
|
||||
|
||||
-- TODO: Should we use DI via data instead of typeclasses?
|
||||
-- https://news.ycombinator.com/item?id=10392044
|
||||
|
||||
-- | Describes effects needed by File Drafts.
|
||||
class (MonadIO m) => WriteableMonad m where
|
||||
createDirectoryIfMissing
|
||||
:: Bool -- ^ True if parents should also be created.
|
||||
-> FilePath -- ^ Path to the directory to create.
|
||||
-> m ()
|
||||
createDirectoryIfMissing ::
|
||||
-- | True if parents should also be created.
|
||||
Bool ->
|
||||
-- | Path to the directory to create.
|
||||
FilePath ->
|
||||
m ()
|
||||
|
||||
copyFile
|
||||
:: FilePath -- ^ Src path.
|
||||
-> FilePath -- ^ Dst path.
|
||||
-> m ()
|
||||
copyFile ::
|
||||
-- | Src path.
|
||||
FilePath ->
|
||||
-- | Dst path.
|
||||
FilePath ->
|
||||
m ()
|
||||
|
||||
doesFileExist :: FilePath -> m Bool
|
||||
|
||||
writeFileFromText :: FilePath -> Text -> m ()
|
||||
|
||||
getTemplateFileAbsPath
|
||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
||||
-> m (Path Abs File)
|
||||
getTemplateFileAbsPath ::
|
||||
-- | Template file path.
|
||||
Path (Rel Templates.TemplatesDir) File ->
|
||||
m (Path Abs File)
|
||||
|
||||
getTemplatesDirAbsPath :: m (Path Abs (Dir Templates.TemplatesDir))
|
||||
|
||||
compileAndRenderTemplate
|
||||
:: Path (Rel Templates.TemplatesDir) File -- ^ Template file path.
|
||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
||||
-> m Text
|
||||
compileAndRenderTemplate ::
|
||||
-- | Template file path.
|
||||
Path (Rel Templates.TemplatesDir) File ->
|
||||
-- | JSON to be provided as template data.
|
||||
Aeson.Value ->
|
||||
m Text
|
||||
|
||||
throwIO :: (Exception e) => e -> m a
|
||||
|
||||
instance WriteableMonad IO where
|
||||
createDirectoryIfMissing = System.Directory.createDirectoryIfMissing
|
||||
|
||||
-- TODO(matija): we should rename this function to make it clear it won't throw an exception when
|
||||
-- a file does not exist.
|
||||
copyFile src dst = do
|
||||
-- NOTE(matija): we had cases (e.g. tmp Vim files) where a file initially existed
|
||||
-- when the filedraft was created but then got deleted before actual copying was invoked.
|
||||
-- That would make this function crash, so we just ignore those errors.
|
||||
System.Directory.copyFile src dst `catch` (\e -> if isDoesNotExistError e
|
||||
System.Directory.copyFile src dst
|
||||
`catch` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return ()
|
||||
else throwIO e)
|
||||
else throwIO e
|
||||
)
|
||||
|
||||
doesFileExist = System.Directory.doesFileExist
|
||||
writeFileFromText = Data.Text.IO.writeFile
|
||||
|
@ -1,27 +1,28 @@
|
||||
module Generator.Job
|
||||
( Job
|
||||
, JobMessage (..)
|
||||
, JobMessageData (..)
|
||||
, JobOutputType (..)
|
||||
, JobType (..)
|
||||
) where
|
||||
( Job,
|
||||
JobMessage (..),
|
||||
JobMessageData (..),
|
||||
JobOutputType (..),
|
||||
JobType (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan)
|
||||
import Data.Text (Text)
|
||||
import System.Exit (ExitCode)
|
||||
|
||||
|
||||
-- | Job is an IO action that communicates progress by writing messages to given channel
|
||||
-- until it is done, when it returns exit code.
|
||||
type Job = Chan JobMessage -> IO ExitCode
|
||||
|
||||
data JobMessage = JobMessage
|
||||
{ _data :: JobMessageData
|
||||
, _jobType :: JobType
|
||||
{ _data :: JobMessageData,
|
||||
_jobType :: JobType
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data JobMessageData = JobOutput Text JobOutputType
|
||||
data JobMessageData
|
||||
= JobOutput Text JobOutputType
|
||||
| JobExit ExitCode
|
||||
deriving (Show)
|
||||
|
||||
|
@ -1,16 +1,16 @@
|
||||
module Generator.Job.IO
|
||||
( readJobMessagesAndPrintThemPrefixed
|
||||
, printPrefixedJobMessage
|
||||
, printJobMessage
|
||||
) where
|
||||
( readJobMessagesAndPrintThemPrefixed,
|
||||
printPrefixedJobMessage,
|
||||
printJobMessage,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, readChan)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T.IO
|
||||
import qualified Generator.Job as J
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO (Handle, hFlush, stderr, stdout)
|
||||
|
||||
import qualified Generator.Job as J
|
||||
import qualified Util.Terminal as Term
|
||||
|
||||
readJobMessagesAndPrintThemPrefixed :: Chan J.JobMessage -> IO ()
|
||||
|
@ -1,28 +1,28 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Generator.Job.Process
|
||||
( runProcessAsJob
|
||||
, runNodeCommandAsJob
|
||||
) where
|
||||
( runProcessAsJob,
|
||||
runNodeCommandAsJob,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (writeChan)
|
||||
import Control.Concurrent.Async (Concurrently (..))
|
||||
import UnliftIO.Exception (bracket)
|
||||
import Data.Conduit (runConduit, (.|))
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.Conduit.Process as CP
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
import qualified Generator.Common as C
|
||||
import qualified Generator.Job as J
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import System.Exit (ExitCode (..))
|
||||
import System.IO.Error (catchIOError, isDoesNotExistError)
|
||||
import qualified System.Process as P
|
||||
import Text.Read (readMaybe)
|
||||
import qualified Text.Regex.TDFA as R
|
||||
|
||||
import qualified Generator.Common as C
|
||||
import qualified Generator.Job as J
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import UnliftIO.Exception (bracket)
|
||||
|
||||
-- TODO:
|
||||
-- Switch from Data.Conduit.Process to Data.Conduit.Process.Typed.
|
||||
@ -32,27 +32,48 @@ import qualified StrongPath as SP
|
||||
-- Returns exit code of the process once it finishes, and also sends it to the channel.
|
||||
-- Makes sure to terminate the process if exception occurs.
|
||||
runProcessAsJob :: P.CreateProcess -> J.JobType -> J.Job
|
||||
runProcessAsJob process jobType chan = bracket
|
||||
runProcessAsJob process jobType chan =
|
||||
bracket
|
||||
(CP.streamingProcess process)
|
||||
(\(_, _, _, sph) -> terminateStreamingProcess sph)
|
||||
runStreamingProcessAsJob
|
||||
where
|
||||
runStreamingProcessAsJob (CP.Inherited, stdoutStream, stderrStream, processHandle) = do
|
||||
let forwardStdoutToChan = runConduit $ stdoutStream .| CL.mapM_
|
||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stdout
|
||||
, J._jobType = jobType })
|
||||
let forwardStdoutToChan =
|
||||
runConduit $
|
||||
stdoutStream
|
||||
.| CL.mapM_
|
||||
( \bs ->
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput (decodeUtf8 bs) J.Stdout,
|
||||
J._jobType = jobType
|
||||
}
|
||||
)
|
||||
|
||||
let forwardStderrToChan = runConduit $ stderrStream .| CL.mapM_
|
||||
(\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (decodeUtf8 bs) J.Stderr
|
||||
, J._jobType = jobType })
|
||||
let forwardStderrToChan =
|
||||
runConduit $
|
||||
stderrStream
|
||||
.| CL.mapM_
|
||||
( \bs ->
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput (decodeUtf8 bs) J.Stderr,
|
||||
J._jobType = jobType
|
||||
}
|
||||
)
|
||||
|
||||
exitCode <- runConcurrently $
|
||||
Concurrently forwardStdoutToChan *>
|
||||
Concurrently forwardStderrToChan *>
|
||||
Concurrently (CP.waitForStreamingProcess processHandle)
|
||||
exitCode <-
|
||||
runConcurrently $
|
||||
Concurrently forwardStdoutToChan
|
||||
*> Concurrently forwardStderrToChan
|
||||
*> Concurrently (CP.waitForStreamingProcess processHandle)
|
||||
|
||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
||||
, J._jobType = jobType }
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobExit exitCode,
|
||||
J._jobType = jobType
|
||||
}
|
||||
|
||||
return exitCode
|
||||
|
||||
@ -66,33 +87,51 @@ runNodeCommandAsJob fromDir command args jobType chan = do
|
||||
errorOrNodeVersion <- getNodeVersion
|
||||
case errorOrNodeVersion of
|
||||
Left errorMsg -> exitWithError (ExitFailure 1) (T.pack errorMsg)
|
||||
Right nodeVersion -> if nodeVersion < C.nodeVersion
|
||||
then exitWithError (ExitFailure 1)
|
||||
Right nodeVersion ->
|
||||
if nodeVersion < C.nodeVersion
|
||||
then
|
||||
exitWithError
|
||||
(ExitFailure 1)
|
||||
(T.pack $ "Your node version is too low. " ++ waspNodeRequirementMessage)
|
||||
else do
|
||||
let process = (P.proc command args) {P.cwd = Just $ SP.toFilePath fromDir}
|
||||
runProcessAsJob process jobType chan
|
||||
where
|
||||
exitWithError exitCode errorMsg = do
|
||||
writeChan chan $ J.JobMessage
|
||||
{ J._data = J.JobOutput errorMsg J.Stderr
|
||||
, J._jobType = jobType }
|
||||
writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode
|
||||
, J._jobType = jobType }
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobOutput errorMsg J.Stderr,
|
||||
J._jobType = jobType
|
||||
}
|
||||
writeChan chan $
|
||||
J.JobMessage
|
||||
{ J._data = J.JobExit exitCode,
|
||||
J._jobType = jobType
|
||||
}
|
||||
return exitCode
|
||||
|
||||
getNodeVersion :: IO (Either String (Int, Int, Int))
|
||||
getNodeVersion = do
|
||||
(exitCode, stdout, stderr) <- P.readProcessWithExitCode "node" ["--version"] ""
|
||||
`catchIOError` (\e -> if isDoesNotExistError e
|
||||
(exitCode, stdout, stderr) <-
|
||||
P.readProcessWithExitCode "node" ["--version"] ""
|
||||
`catchIOError` ( \e ->
|
||||
if isDoesNotExistError e
|
||||
then return (ExitFailure 1, "", "Command 'node' not found.")
|
||||
else ioError e)
|
||||
else ioError e
|
||||
)
|
||||
return $ case exitCode of
|
||||
ExitFailure _ -> Left ("Running 'node --version' failed: " ++ stderr
|
||||
++ " " ++ waspNodeRequirementMessage)
|
||||
ExitFailure _ ->
|
||||
Left
|
||||
( "Running 'node --version' failed: " ++ stderr
|
||||
++ " "
|
||||
++ waspNodeRequirementMessage
|
||||
)
|
||||
ExitSuccess -> case parseNodeVersion stdout of
|
||||
Nothing -> Left ("Wasp failed to parse node version."
|
||||
++ " This is most likely a bug in Wasp, please file an issue.")
|
||||
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)
|
||||
@ -105,5 +144,6 @@ runNodeCommandAsJob fromDir command args jobType chan = do
|
||||
return (major, minor, patch)
|
||||
_ -> Nothing
|
||||
|
||||
waspNodeRequirementMessage = "Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
||||
waspNodeRequirementMessage =
|
||||
"Wasp requires node >= " ++ C.nodeVersionAsText ++ " ."
|
||||
++ " Check Wasp docs for more details: https://wasp-lang.dev/docs#requirements ."
|
||||
|
@ -1,14 +1,13 @@
|
||||
module Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps
|
||||
, toPackageJsonDependenciesString
|
||||
) where
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.List (find, intercalate)
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
|
||||
import qualified NpmDependency as ND
|
||||
|
||||
|
||||
type NpmDependenciesConflictError = String
|
||||
|
||||
-- | Takes wasp npm dependencies and user npm dependencies and figures out how to
|
||||
@ -18,31 +17,39 @@ type NpmDependenciesConflictError = String
|
||||
-- be different.
|
||||
-- On error (Left), returns list of conflicting user deps together with the error message
|
||||
-- explaining what the error is.
|
||||
resolveNpmDeps
|
||||
:: [ND.NpmDependency]
|
||||
-> [ND.NpmDependency]
|
||||
-> Either [(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
resolveNpmDeps ::
|
||||
[ND.NpmDependency] ->
|
||||
[ND.NpmDependency] ->
|
||||
Either
|
||||
[(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
([ND.NpmDependency], [ND.NpmDependency])
|
||||
resolveNpmDeps waspDeps userDeps = if null conflictingUserDeps
|
||||
resolveNpmDeps waspDeps userDeps =
|
||||
if null conflictingUserDeps
|
||||
then Right (waspDeps, userDepsNotInWaspDeps)
|
||||
else Left conflictingUserDeps
|
||||
where
|
||||
conflictingUserDeps :: [(ND.NpmDependency, NpmDependenciesConflictError)]
|
||||
conflictingUserDeps = map (\(dep, err) -> (dep, fromJust err))
|
||||
$ filter (isJust . snd)
|
||||
$ map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
||||
conflictingUserDeps =
|
||||
map (\(dep, err) -> (dep, fromJust err)) $
|
||||
filter (isJust . snd) $
|
||||
map (\dep -> (dep, checkIfConflictingUserDep dep)) userDeps
|
||||
|
||||
checkIfConflictingUserDep :: ND.NpmDependency -> Maybe NpmDependenciesConflictError
|
||||
checkIfConflictingUserDep userDep =
|
||||
let attachErrorMessage dep = "Error: Dependency conflict for user npm dependency ("
|
||||
++ ND._name dep ++ ", " ++ ND._version dep ++ "): "
|
||||
let attachErrorMessage dep =
|
||||
"Error: Dependency conflict for user npm dependency ("
|
||||
++ ND._name dep
|
||||
++ ", "
|
||||
++ ND._version dep
|
||||
++ "): "
|
||||
++ "Version must be set to the exactly the same version as"
|
||||
++ " the one wasp is using: "
|
||||
++ ND._version dep
|
||||
in attachErrorMessage <$> find (areTwoDepsInConflict userDep) waspDeps
|
||||
|
||||
areTwoDepsInConflict :: ND.NpmDependency -> ND.NpmDependency -> Bool
|
||||
areTwoDepsInConflict d1 d2 = ND._name d1 == ND._name d2
|
||||
areTwoDepsInConflict d1 d2 =
|
||||
ND._name d1 == ND._name d2
|
||||
&& ND._version d1 /= ND._version d2
|
||||
|
||||
userDepsNotInWaspDeps :: [ND.NpmDependency]
|
||||
|
@ -1,52 +1,58 @@
|
||||
module Generator.ServerGenerator
|
||||
( genServer
|
||||
, preCleanup
|
||||
, operationsRouteInRootRouter
|
||||
) where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust,
|
||||
isJust)
|
||||
import qualified Path as P
|
||||
import StrongPath ((</>), Path, Rel, File, Abs, Dir)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (removeFile)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Control.Monad (when)
|
||||
( genServer,
|
||||
preCleanup,
|
||||
operationsRouteInRootRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Generator.Common (nodeVersionAsText, ProjectRootDir)
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe
|
||||
( fromJust,
|
||||
isJust,
|
||||
)
|
||||
import Generator.Common (ProjectRootDir, nodeVersionAsText)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft (FileDraft, createCopyFileDraft)
|
||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
||||
toPackageJsonDependenciesString)
|
||||
import Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
import Generator.ServerGenerator.AuthG (genAuth)
|
||||
import Generator.ServerGenerator.Common (asServerFile,
|
||||
asTmplFile)
|
||||
import Generator.ServerGenerator.Common
|
||||
( asServerFile,
|
||||
asTmplFile,
|
||||
)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.ConfigG (genConfigFile)
|
||||
import qualified Generator.ServerGenerator.ExternalCodeGenerator as ServerExternalCodeGenerator
|
||||
import Generator.ServerGenerator.OperationsG (genOperations)
|
||||
import Generator.ServerGenerator.OperationsRoutesG (genOperationsRoutes)
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (removeFile)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Auth
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
|
||||
genServer :: Wasp -> CompileOptions -> [FileDraft]
|
||||
genServer wasp _ = concat
|
||||
[ [genReadme wasp]
|
||||
, [genPackageJson wasp waspNpmDeps]
|
||||
, [genNpmrc wasp]
|
||||
, [genNvmrc wasp]
|
||||
, [genGitignore wasp]
|
||||
, genSrcDir wasp
|
||||
, generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp
|
||||
, genDotEnv wasp
|
||||
genServer wasp _ =
|
||||
concat
|
||||
[ [genReadme wasp],
|
||||
[genPackageJson wasp waspNpmDeps],
|
||||
[genNpmrc wasp],
|
||||
[genNvmrc wasp],
|
||||
[genGitignore wasp],
|
||||
genSrcDir wasp,
|
||||
generateExternalCodeDir ServerExternalCodeGenerator.generatorStrategy wasp,
|
||||
genDotEnv wasp
|
||||
]
|
||||
|
||||
-- Cleanup to be performed before generating new server code.
|
||||
@ -80,18 +86,22 @@ genReadme :: Wasp -> FileDraft
|
||||
genReadme _ = C.copyTmplAsIs (asTmplFile [P.relfile|README.md|])
|
||||
|
||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
genPackageJson wasp waspDeps =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|package.json|])
|
||||
(asServerFile [P.relfile|package.json|])
|
||||
(Just $ object
|
||||
[ "wasp" .= wasp
|
||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
, "nodeVersion" .= nodeVersionAsText
|
||||
, "startProductionScript" .= concat
|
||||
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else ""
|
||||
, "NODE_ENV=production node ./src/server.js"
|
||||
( Just $
|
||||
object
|
||||
[ "wasp" .= wasp,
|
||||
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps),
|
||||
"nodeVersion" .= nodeVersionAsText,
|
||||
"startProductionScript"
|
||||
.= concat
|
||||
[ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else "",
|
||||
"NODE_ENV=production node ./src/server.js"
|
||||
]
|
||||
])
|
||||
]
|
||||
)
|
||||
where
|
||||
(resolvedWaspDeps, resolvedUserDeps) =
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
@ -102,47 +112,55 @@ genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||
|
||||
waspNpmDeps :: [ND.NpmDependency]
|
||||
waspNpmDeps = ND.fromList
|
||||
[ ("cookie-parser", "~1.4.4")
|
||||
, ("cors", "^2.8.5")
|
||||
, ("debug", "~2.6.9")
|
||||
, ("express", "~4.16.1")
|
||||
, ("morgan", "~1.9.1")
|
||||
, ("@prisma/client", "2.21.0")
|
||||
, ("jsonwebtoken", "^8.5.1")
|
||||
, ("secure-password", "^4.0.0")
|
||||
, ("dotenv", "8.2.0")
|
||||
waspNpmDeps =
|
||||
ND.fromList
|
||||
[ ("cookie-parser", "~1.4.4"),
|
||||
("cors", "^2.8.5"),
|
||||
("debug", "~2.6.9"),
|
||||
("express", "~4.16.1"),
|
||||
("morgan", "~1.9.1"),
|
||||
("@prisma/client", "2.21.0"),
|
||||
("jsonwebtoken", "^8.5.1"),
|
||||
("secure-password", "^4.0.0"),
|
||||
("dotenv", "8.2.0")
|
||||
]
|
||||
|
||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||
|
||||
genNpmrc :: Wasp -> FileDraft
|
||||
genNpmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|npmrc|])
|
||||
genNpmrc _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|npmrc|])
|
||||
(asServerFile [P.relfile|.npmrc|])
|
||||
Nothing
|
||||
|
||||
genNvmrc :: Wasp -> FileDraft
|
||||
genNvmrc _ = C.makeTemplateFD (asTmplFile [P.relfile|nvmrc|])
|
||||
genNvmrc _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|nvmrc|])
|
||||
(asServerFile [P.relfile|.nvmrc|])
|
||||
(Just (object ["nodeVersion" .= ('v' : nodeVersionAsText)]))
|
||||
|
||||
genGitignore :: Wasp -> FileDraft
|
||||
genGitignore _ = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
||||
genGitignore _ =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|gitignore|])
|
||||
(asServerFile [P.relfile|.gitignore|])
|
||||
Nothing
|
||||
|
||||
genSrcDir :: Wasp -> [FileDraft]
|
||||
genSrcDir wasp = concat
|
||||
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]]
|
||||
, [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]]
|
||||
, [genDbClient wasp]
|
||||
, [genConfigFile wasp]
|
||||
, genRoutesDir wasp
|
||||
, genOperationsRoutes wasp
|
||||
, genOperations wasp
|
||||
, genAuth wasp
|
||||
genSrcDir wasp =
|
||||
concat
|
||||
[ [C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|app.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|server.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|utils.js|]],
|
||||
[C.copySrcTmplAsIs $ C.asTmplSrcFile [P.relfile|core/HttpError.js|]],
|
||||
[genDbClient wasp],
|
||||
[genConfigFile wasp],
|
||||
genRoutesDir wasp,
|
||||
genOperationsRoutes wasp,
|
||||
genOperations wasp,
|
||||
genAuth wasp
|
||||
]
|
||||
|
||||
genDbClient :: Wasp -> FileDraft
|
||||
@ -156,9 +174,10 @@ genDbClient wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
|
||||
tmplData =
|
||||
if isJust maybeAuth
|
||||
then object
|
||||
[ "isAuthEnabled" .= True
|
||||
, "userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
||||
then
|
||||
object
|
||||
[ "isAuthEnabled" .= True,
|
||||
"userEntityUpper" .= Wasp.Auth._userEntity (fromJust maybeAuth)
|
||||
]
|
||||
else object []
|
||||
|
||||
@ -169,9 +188,10 @@ genRoutesDir wasp =
|
||||
[ C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|src/routes/index.js|])
|
||||
(asServerFile [P.relfile|src/routes/index.js|])
|
||||
(Just $ object
|
||||
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter
|
||||
, "isAuthEnabled" .= isJust (getAuth wasp)
|
||||
( Just $
|
||||
object
|
||||
[ "operationsRouteInRootRouter" .= operationsRouteInRootRouter,
|
||||
"isAuthEnabled" .= isJust (getAuth wasp)
|
||||
]
|
||||
)
|
||||
]
|
||||
|
@ -1,25 +1,26 @@
|
||||
module Generator.ServerGenerator.AuthG
|
||||
( genAuth
|
||||
) where
|
||||
( genAuth,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
import Data.Aeson (object, (.=))
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath ((</>))
|
||||
import qualified Util
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp.Auth
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import StrongPath ((</>))
|
||||
|
||||
genAuth :: Wasp -> [FileDraft]
|
||||
genAuth wasp = case maybeAuth of
|
||||
Just auth -> [ genCoreAuth auth
|
||||
Just auth ->
|
||||
[ genCoreAuth auth,
|
||||
-- Auth routes
|
||||
, genAuthRoutesIndex
|
||||
, genLoginRoute auth
|
||||
, genSignupRoute auth
|
||||
, genMeRoute auth
|
||||
genAuthRoutesIndex,
|
||||
genLoginRoute auth,
|
||||
genSignupRoute auth,
|
||||
genMeRoute auth
|
||||
]
|
||||
Nothing -> []
|
||||
where
|
||||
@ -33,9 +34,11 @@ genCoreAuth auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> coreAuthRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile coreAuthRelToSrc)
|
||||
|
||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
||||
[ "userEntityUpper" .= userEntity
|
||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
||||
tmplData =
|
||||
let userEntity = (Wasp.Auth._userEntity auth)
|
||||
in object
|
||||
[ "userEntityUpper" .= userEntity,
|
||||
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||
]
|
||||
|
||||
genAuthRoutesIndex :: FileDraft
|
||||
@ -48,9 +51,11 @@ genLoginRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> loginRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile loginRouteRelToSrc)
|
||||
|
||||
tmplData = let userEntity = (Wasp.Auth._userEntity auth) in object
|
||||
[ "userEntityUpper" .= userEntity
|
||||
, "userEntityLower" .= Util.toLowerFirst userEntity
|
||||
tmplData =
|
||||
let userEntity = (Wasp.Auth._userEntity auth)
|
||||
in object
|
||||
[ "userEntityUpper" .= userEntity,
|
||||
"userEntityLower" .= Util.toLowerFirst userEntity
|
||||
]
|
||||
|
||||
genSignupRoute :: Wasp.Auth.Auth -> FileDraft
|
||||
@ -60,7 +65,8 @@ genSignupRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> signupRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile signupRouteRelToSrc)
|
||||
|
||||
tmplData = object
|
||||
tmplData =
|
||||
object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
|
||||
@ -71,6 +77,7 @@ genMeRoute auth = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplFile = C.asTmplFile $ [P.reldir|src|] P.</> meRouteRelToSrc
|
||||
dstFile = C.serverSrcDirInServerRootDir </> (C.asServerSrcFile meRouteRelToSrc)
|
||||
|
||||
tmplData = object
|
||||
tmplData =
|
||||
object
|
||||
[ "userEntityLower" .= Util.toLowerFirst (Wasp.Auth._userEntity auth)
|
||||
]
|
||||
|
@ -1,38 +1,39 @@
|
||||
module Generator.ServerGenerator.Common
|
||||
( serverRootDirInProjectRootDir
|
||||
, serverSrcDirInServerRootDir
|
||||
, serverSrcDirInProjectRootDir
|
||||
, copyTmplAsIs
|
||||
, makeSimpleTemplateFD
|
||||
, makeTemplateFD
|
||||
, copySrcTmplAsIs
|
||||
, srcDirInServerTemplatesDir
|
||||
, asTmplFile
|
||||
, asTmplSrcFile
|
||||
, asServerFile
|
||||
, asServerSrcFile
|
||||
, ServerRootDir
|
||||
, ServerSrcDir
|
||||
, ServerTemplatesDir
|
||||
, ServerTemplatesSrcDir
|
||||
) where
|
||||
( serverRootDirInProjectRootDir,
|
||||
serverSrcDirInServerRootDir,
|
||||
serverSrcDirInProjectRootDir,
|
||||
copyTmplAsIs,
|
||||
makeSimpleTemplateFD,
|
||||
makeTemplateFD,
|
||||
copySrcTmplAsIs,
|
||||
srcDirInServerTemplatesDir,
|
||||
asTmplFile,
|
||||
asTmplSrcFile,
|
||||
asServerFile,
|
||||
asServerSrcFile,
|
||||
ServerRootDir,
|
||||
ServerSrcDir,
|
||||
ServerTemplatesDir,
|
||||
ServerTemplatesSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, File, Dir, (</>))
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
|
||||
|
||||
data ServerRootDir
|
||||
data ServerSrcDir
|
||||
data ServerTemplatesDir
|
||||
data ServerTemplatesSrcDir
|
||||
|
||||
data ServerSrcDir
|
||||
|
||||
data ServerTemplatesDir
|
||||
|
||||
data ServerTemplatesSrcDir
|
||||
|
||||
asTmplFile :: P.Path P.Rel P.File -> Path (Rel ServerTemplatesDir) File
|
||||
asTmplFile = SP.fromPathRelFile
|
||||
@ -59,21 +60,23 @@ serverSrcDirInServerRootDir = SP.fromPathRelDir [P.reldir|src|]
|
||||
serverSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir ServerSrcDir)
|
||||
serverSrcDirInProjectRootDir = serverRootDirInProjectRootDir </> serverSrcDirInServerRootDir
|
||||
|
||||
|
||||
-- * Templates
|
||||
|
||||
copyTmplAsIs :: Path (Rel ServerTemplatesDir) File -> FileDraft
|
||||
copyTmplAsIs srcPath = makeTemplateFD srcPath dstPath Nothing
|
||||
where dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
where
|
||||
dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
|
||||
makeSimpleTemplateFD :: Path (Rel ServerTemplatesDir) File -> Wasp -> FileDraft
|
||||
makeSimpleTemplateFD srcPath wasp = makeTemplateFD srcPath dstPath (Just $ Aeson.toJSON wasp)
|
||||
where dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
where
|
||||
dstPath = (SP.castRel srcPath) :: Path (Rel ServerRootDir) File
|
||||
|
||||
makeTemplateFD :: Path (Rel ServerTemplatesDir) File
|
||||
-> Path (Rel ServerRootDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
makeTemplateFD ::
|
||||
Path (Rel ServerTemplatesDir) File ->
|
||||
Path (Rel ServerRootDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
makeTemplateFD relSrcPath relDstPath tmplData =
|
||||
createTemplateFileDraft
|
||||
(serverRootDirInProjectRootDir </> relDstPath)
|
||||
@ -82,8 +85,10 @@ makeTemplateFD relSrcPath relDstPath tmplData =
|
||||
|
||||
copySrcTmplAsIs :: Path (Rel ServerTemplatesSrcDir) File -> FileDraft
|
||||
copySrcTmplAsIs pathInTemplatesSrcDir = makeTemplateFD srcPath dstPath Nothing
|
||||
where srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
||||
dstPath = serverSrcDirInServerRootDir
|
||||
where
|
||||
srcPath = srcDirInServerTemplatesDir </> pathInTemplatesSrcDir
|
||||
dstPath =
|
||||
serverSrcDirInServerRootDir
|
||||
</> ((SP.castRel pathInTemplatesSrcDir) :: Path (Rel ServerSrcDir) File)
|
||||
|
||||
-- | Path where server app templates reside.
|
||||
|
@ -1,25 +1,25 @@
|
||||
module Generator.ServerGenerator.ConfigG
|
||||
( genConfigFile
|
||||
, configFileInSrcDir
|
||||
) where
|
||||
( genConfigFile,
|
||||
configFileInSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Wasp (Wasp, getAuth)
|
||||
|
||||
|
||||
genConfigFile :: Wasp -> FileDraft
|
||||
genConfigFile wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.srcDirInServerTemplatesDir </> SP.castRel configFileInSrcDir
|
||||
dstFile = C.serverSrcDirInServerRootDir </> configFileInSrcDir
|
||||
tmplData = object
|
||||
tmplData =
|
||||
object
|
||||
[ "isAuthEnabled" .= isJust (getAuth wasp)
|
||||
]
|
||||
|
||||
|
@ -1,24 +1,26 @@
|
||||
module Generator.ServerGenerator.ExternalCodeGenerator
|
||||
( extCodeDirInServerSrcDir
|
||||
, generatorStrategy
|
||||
) where
|
||||
( extCodeDirInServerSrcDir,
|
||||
generatorStrategy,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Js (resolveJsFileWaspImportsForExtCodeDir)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Relative path to directory where external code will be generated.
|
||||
extCodeDirInServerSrcDir :: Path (Rel C.ServerSrcDir) (Dir GeneratedExternalCodeDir)
|
||||
extCodeDirInServerSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||
|
||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir)
|
||||
, _extCodeDirInProjectRootDir = C.serverRootDirInProjectRootDir
|
||||
generatorStrategy =
|
||||
ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInServerSrcDir),
|
||||
_extCodeDirInProjectRootDir =
|
||||
C.serverRootDirInProjectRootDir
|
||||
</> C.serverSrcDirInServerRootDir
|
||||
</> extCodeDirInServerSrcDir
|
||||
}
|
||||
|
@ -1,18 +1,18 @@
|
||||
module Generator.ServerGenerator.OperationsG
|
||||
( genOperations
|
||||
, queryFileInSrcDir
|
||||
, actionFileInSrcDir
|
||||
, operationFileInSrcDir
|
||||
) where
|
||||
( genOperations,
|
||||
queryFileInSrcDir,
|
||||
actionFileInSrcDir,
|
||||
operationFileInSrcDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Char (toLower)
|
||||
import Data.Maybe (fromJust, fromMaybe)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
@ -22,20 +22,22 @@ import qualified Wasp.JsImport
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
|
||||
|
||||
genOperations :: Wasp -> [FileDraft]
|
||||
genOperations wasp = concat
|
||||
[ genQueries wasp
|
||||
, genActions wasp
|
||||
genOperations wasp =
|
||||
concat
|
||||
[ genQueries wasp,
|
||||
genActions wasp
|
||||
]
|
||||
|
||||
genQueries :: Wasp -> [FileDraft]
|
||||
genQueries wasp = concat
|
||||
genQueries wasp =
|
||||
concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
||||
]
|
||||
|
||||
genActions :: Wasp -> [FileDraft]
|
||||
genActions wasp = concat
|
||||
genActions wasp =
|
||||
concat
|
||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||
]
|
||||
|
||||
@ -60,13 +62,15 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
tmplData = operationTmplData operation
|
||||
|
||||
queryFileInSrcDir :: Wasp.Query.Query -> Path (Rel C.ServerSrcDir) File
|
||||
queryFileInSrcDir query = SP.fromPathRelFile $
|
||||
queryFileInSrcDir query =
|
||||
SP.fromPathRelFile $
|
||||
[P.reldir|queries|]
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Query._name query ++ ".js")
|
||||
|
||||
actionFileInSrcDir :: Wasp.Action.Action -> Path (Rel C.ServerSrcDir) File
|
||||
actionFileInSrcDir action = SP.fromPathRelFile $
|
||||
actionFileInSrcDir action =
|
||||
SP.fromPathRelFile $
|
||||
[P.reldir|actions|]
|
||||
-- TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
P.</> fromJust (P.parseRelFile $ Wasp.Action._name action ++ ".js")
|
||||
@ -80,28 +84,32 @@ relPosixPathFromOperationFileToExtSrcDir :: FilePath -- Posix
|
||||
relPosixPathFromOperationFileToExtSrcDir = "../ext-src/"
|
||||
|
||||
operationTmplData :: Wasp.Operation.Operation -> Aeson.Value
|
||||
operationTmplData operation = object
|
||||
[ "jsFnImportStatement" .= importStmt
|
||||
, "jsFnIdentifier" .= importIdentifier
|
||||
, "entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
||||
operationTmplData operation =
|
||||
object
|
||||
[ "jsFnImportStatement" .= importStmt,
|
||||
"jsFnIdentifier" .= importIdentifier,
|
||||
"entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation)
|
||||
]
|
||||
where
|
||||
(importIdentifier, importStmt) =
|
||||
getImportDetailsForOperationUserJsFn operation relPosixPathFromOperationFileToExtSrcDir
|
||||
buildEntityData :: String -> Aeson.Value
|
||||
buildEntityData entityName = object [ "name" .= entityName
|
||||
, "prismaIdentifier" .= (toLower (head entityName) : tail entityName)
|
||||
buildEntityData entityName =
|
||||
object
|
||||
[ "name" .= entityName,
|
||||
"prismaIdentifier" .= (toLower (head entityName) : tail entityName)
|
||||
]
|
||||
|
||||
-- | Given Wasp operation, it returns details on how to import its user js function and use it,
|
||||
-- "user js function" meaning the one provided by user directly to wasp, untouched.
|
||||
getImportDetailsForOperationUserJsFn
|
||||
:: Wasp.Operation.Operation
|
||||
-> FilePath -- ^ Relative posix path from js file where you want to do importing to generated ext code dir.
|
||||
getImportDetailsForOperationUserJsFn ::
|
||||
Wasp.Operation.Operation ->
|
||||
-- | Relative posix path from js file where you want to do importing to generated ext code dir.
|
||||
-- | (importIdentifier, importStmt)
|
||||
-- - importIdentifier -> Identifier via which you can access js function after you import it with importStmt.
|
||||
-- - importStmt -> Import statement via which you should do the import.
|
||||
-> (String, String)
|
||||
FilePath ->
|
||||
(String, String)
|
||||
getImportDetailsForOperationUserJsFn operation relPosixPathToExtCodeDir = (importIdentifier, importStmt)
|
||||
where
|
||||
importStmt = "import " ++ importWhat ++ " from '" ++ importFrom ++ "'"
|
||||
|
@ -1,44 +1,51 @@
|
||||
module Generator.ServerGenerator.OperationsRoutesG
|
||||
( genOperationsRoutes
|
||||
, operationRouteInOperationsRouter
|
||||
) where
|
||||
( genOperationsRoutes,
|
||||
operationRouteInOperationsRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import qualified Path as P
|
||||
import qualified System.FilePath.Posix as FPPosix
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator.Common as C
|
||||
import Generator.ServerGenerator.OperationsG (operationFileInSrcDir)
|
||||
import StrongPath (Dir, File, Path, Rel,
|
||||
(</>))
|
||||
import qualified Path as P
|
||||
import StrongPath
|
||||
( Dir,
|
||||
File,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
import qualified System.FilePath.Posix as FPPosix
|
||||
import qualified Util as U
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Action
|
||||
import qualified Wasp.Auth
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
import qualified Wasp.Auth
|
||||
|
||||
|
||||
genOperationsRoutes :: Wasp -> [FileDraft]
|
||||
genOperationsRoutes wasp = concat
|
||||
[ map (genActionRoute wasp) (Wasp.getActions wasp)
|
||||
, map (genQueryRoute wasp) (Wasp.getQueries wasp)
|
||||
, [genOperationsRouter wasp]
|
||||
genOperationsRoutes wasp =
|
||||
concat
|
||||
[ map (genActionRoute wasp) (Wasp.getActions wasp),
|
||||
map (genQueryRoute wasp) (Wasp.getQueries wasp),
|
||||
[genOperationsRouter wasp]
|
||||
]
|
||||
|
||||
genActionRoute :: Wasp -> Wasp.Action.Action -> FileDraft
|
||||
genActionRoute wasp action = genOperationRoute wasp op tmplFile
|
||||
where op = Wasp.Operation.ActionOp action
|
||||
where
|
||||
op = Wasp.Operation.ActionOp action
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_action.js|]
|
||||
|
||||
genQueryRoute :: Wasp -> Wasp.Query.Query -> FileDraft
|
||||
genQueryRoute wasp query = genOperationRoute wasp op tmplFile
|
||||
where op = Wasp.Operation.QueryOp query
|
||||
where
|
||||
op = Wasp.Operation.QueryOp query
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/_query.js|]
|
||||
|
||||
genOperationRoute :: Wasp -> Wasp.Operation.Operation -> Path (Rel C.ServerTemplatesDir) File -> FileDraft
|
||||
@ -46,18 +53,22 @@ genOperationRoute wasp operation tmplFile = C.makeTemplateFD tmplFile dstFile (J
|
||||
where
|
||||
dstFile = operationsRoutesDirInServerRootDir </> operationRouteFileInOperationsRoutesDir operation
|
||||
|
||||
baseTmplData = object
|
||||
[ "operationImportPath" .= operationImportPath
|
||||
, "operationName" .= Wasp.Operation.getName operation
|
||||
baseTmplData =
|
||||
object
|
||||
[ "operationImportPath" .= operationImportPath,
|
||||
"operationName" .= Wasp.Operation.getName operation
|
||||
]
|
||||
|
||||
tmplData = case (Wasp.getAuth wasp) of
|
||||
Nothing -> baseTmplData
|
||||
Just auth -> U.jsonSet ("userEntityLower")
|
||||
Just auth ->
|
||||
U.jsonSet
|
||||
("userEntityLower")
|
||||
(Aeson.toJSON (U.toLowerFirst $ Wasp.Auth._userEntity auth))
|
||||
baseTmplData
|
||||
|
||||
operationImportPath = relPosixPathFromOperationsRoutesDirToSrcDir
|
||||
operationImportPath =
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir
|
||||
FPPosix.</> SP.toFilePath (SP.relFileToPosix' $ operationFileInSrcDir operation)
|
||||
|
||||
data OperationsRoutesDir
|
||||
@ -75,24 +86,25 @@ operationRouteFileInOperationsRoutesDir operation = fromJust $ SP.parseRelFile $
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir :: FilePath -- Posix
|
||||
relPosixPathFromOperationsRoutesDirToSrcDir = "../.."
|
||||
|
||||
|
||||
genOperationsRouter :: Wasp -> FileDraft
|
||||
genOperationsRouter wasp = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/routes/operations/index.js|]
|
||||
dstFile = operationsRoutesDirInServerRootDir </> SP.fromPathRelFile [P.relfile|index.js|]
|
||||
operations = map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
||||
operations =
|
||||
map Wasp.Operation.ActionOp (Wasp.getActions wasp)
|
||||
++ map Wasp.Operation.QueryOp (Wasp.getQueries wasp)
|
||||
tmplData = object
|
||||
[ "operationRoutes" .= map makeOperationRoute operations
|
||||
, "isAuthEnabled" .= (isJust $ getAuth wasp)
|
||||
tmplData =
|
||||
object
|
||||
[ "operationRoutes" .= map makeOperationRoute operations,
|
||||
"isAuthEnabled" .= (isJust $ getAuth wasp)
|
||||
]
|
||||
makeOperationRoute operation =
|
||||
let operationName = Wasp.Operation.getName operation
|
||||
in object
|
||||
[ "importIdentifier" .= operationName
|
||||
, "importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation))
|
||||
, "routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
||||
[ "importIdentifier" .= operationName,
|
||||
"importPath" .= ("./" ++ SP.toFilePath (SP.relFileToPosix' $ operationRouteFileInOperationsRoutesDir operation)),
|
||||
"routePath" .= ("/" ++ operationRouteInOperationsRouter operation)
|
||||
]
|
||||
|
||||
operationRouteInOperationsRouter :: Wasp.Operation.Operation -> String
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Generator.ServerGenerator.Setup
|
||||
( setupServer
|
||||
) where
|
||||
( setupServer,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
@ -8,7 +9,6 @@ import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.ServerGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
|
||||
setupServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
setupServer projectDir = do
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Generator.ServerGenerator.Start
|
||||
( startServer
|
||||
) where
|
||||
( startServer,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
@ -8,7 +9,6 @@ import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.ServerGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
|
||||
startServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
startServer projectDir = do
|
||||
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||
|
@ -1,18 +1,17 @@
|
||||
module Generator.Setup
|
||||
( setup
|
||||
) where
|
||||
( setup,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (Chan, newChan, readChan)
|
||||
import Control.Concurrent.Async (concurrently)
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
import Generator.Job.IO (printPrefixedJobMessage)
|
||||
import Generator.ServerGenerator.Setup (setupServer)
|
||||
import Generator.WebAppGenerator.Setup (setupWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
import System.Exit (ExitCode (..))
|
||||
|
||||
setup :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
setup projectDir = do
|
||||
@ -30,7 +29,8 @@ setup projectDir = do
|
||||
go prevJobMsg (isWebAppDone, isServerDone) chan = do
|
||||
jobMsg <- readChan chan
|
||||
case J._data jobMsg of
|
||||
J.JobOutput {} -> printPrefixedJobMessage prevJobMsg jobMsg
|
||||
J.JobOutput {} ->
|
||||
printPrefixedJobMessage prevJobMsg jobMsg
|
||||
>> go (Just jobMsg) (isWebAppDone, isServerDone) chan
|
||||
J.JobExit {} -> case J._jobType jobMsg of
|
||||
J.WebApp -> go (Just jobMsg) (True, isServerDone) chan
|
||||
|
@ -1,17 +1,16 @@
|
||||
module Generator.Start
|
||||
( start
|
||||
) where
|
||||
( start,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent (newChan)
|
||||
import Control.Concurrent.Async (race, concurrently)
|
||||
|
||||
import Control.Concurrent.Async (concurrently, race)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
|
||||
import Generator.ServerGenerator.Start (startServer)
|
||||
import Generator.WebAppGenerator.Start (startWebApp)
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
|
||||
|
||||
-- | This is a blocking action, that will start the processes that run web app and server.
|
||||
-- It will run as long as one of those processes does not fail.
|
||||
start :: Path Abs (Dir ProjectRootDir) -> IO (Either String ())
|
||||
|
@ -1,21 +1,20 @@
|
||||
module Generator.Templates
|
||||
( getTemplatesDirAbsPath
|
||||
, getTemplateFileAbsPath
|
||||
, compileAndRenderTemplate
|
||||
, TemplatesDir
|
||||
) where
|
||||
|
||||
import qualified Text.Mustache as Mustache
|
||||
import Text.Mustache.Render (SubstitutionError(..))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import Text.Printf (printf)
|
||||
import qualified Path as P
|
||||
( getTemplatesDirAbsPath,
|
||||
getTemplateFileAbsPath,
|
||||
compileAndRenderTemplate,
|
||||
TemplatesDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data
|
||||
import StrongPath (Path, File, Dir, Abs, Rel, (</>))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Text (Text)
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import qualified Text.Mustache as Mustache
|
||||
import Text.Mustache.Render (SubstitutionError (..))
|
||||
import Text.Printf (printf)
|
||||
|
||||
-- TODO: Write tests for this file! But first we need to decouple logic from IO
|
||||
-- so that we can mock it.
|
||||
@ -34,26 +33,31 @@ getTemplateFileAbsPath relTmplFilePath = (</> relTmplFilePath) <$> getTemplatesD
|
||||
templatesDirPathInDataDir :: Path (Rel Data.DataDir) (Dir TemplatesDir)
|
||||
templatesDirPathInDataDir = SP.fromPathRelDir [P.reldir|Generator/templates|]
|
||||
|
||||
|
||||
compileAndRenderTemplate
|
||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
||||
-> Aeson.Value -- ^ JSON to be provided as template data.
|
||||
-> IO Text
|
||||
compileAndRenderTemplate ::
|
||||
-- | Path to the template file.
|
||||
Path (Rel TemplatesDir) File ->
|
||||
-- | JSON to be provided as template data.
|
||||
Aeson.Value ->
|
||||
IO Text
|
||||
compileAndRenderTemplate relTmplPath tmplData = do
|
||||
mustacheTemplate <- compileMustacheTemplate relTmplPath
|
||||
renderMustacheTemplate mustacheTemplate tmplData
|
||||
|
||||
compileMustacheTemplate
|
||||
:: Path (Rel TemplatesDir) File -- ^ Path to the template file.
|
||||
-> IO Mustache.Template
|
||||
compileMustacheTemplate ::
|
||||
-- | Path to the template file.
|
||||
Path (Rel TemplatesDir) File ->
|
||||
IO Mustache.Template
|
||||
compileMustacheTemplate relTmplPath = do
|
||||
templatesDirAbsPath <- getTemplatesDirAbsPath
|
||||
absTmplPath <- getTemplateFileAbsPath relTmplPath
|
||||
eitherTemplate <- Mustache.automaticCompile [SP.toFilePath templatesDirAbsPath]
|
||||
eitherTemplate <-
|
||||
Mustache.automaticCompile
|
||||
[SP.toFilePath templatesDirAbsPath]
|
||||
(SP.toFilePath absTmplPath)
|
||||
return $ either raiseCompileError id eitherTemplate
|
||||
where
|
||||
raiseCompileError err = error $ -- TODO: Handle these errors better?
|
||||
raiseCompileError err =
|
||||
error $ -- TODO: Handle these errors better?
|
||||
printf "Compilation of template %s failed. %s" (show relTmplPath) (show err)
|
||||
|
||||
areAllErrorsSectionDataNotFound :: [SubstitutionError] -> Bool
|
||||
|
@ -1,56 +1,70 @@
|
||||
module Generator.WebAppGenerator
|
||||
( generateWebApp
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON (..),
|
||||
object, (.=))
|
||||
import Data.List (intercalate)
|
||||
import qualified Path as P
|
||||
( generateWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import CompileOptions (CompileOptions)
|
||||
import Data.Aeson
|
||||
( ToJSON (..),
|
||||
object,
|
||||
(.=),
|
||||
)
|
||||
import Data.List (intercalate)
|
||||
import Generator.ExternalCodeGenerator (generateExternalCodeDir)
|
||||
import Generator.FileDraft
|
||||
import Generator.PackageJsonGenerator (resolveNpmDeps,
|
||||
toPackageJsonDependenciesString)
|
||||
import Generator.PackageJsonGenerator
|
||||
( resolveNpmDeps,
|
||||
toPackageJsonDependenciesString,
|
||||
)
|
||||
import qualified Generator.WebAppGenerator.AuthG as AuthG
|
||||
import Generator.WebAppGenerator.Common (asTmplFile,
|
||||
import Generator.WebAppGenerator.Common
|
||||
( asTmplFile,
|
||||
asWebAppFile,
|
||||
asWebAppSrcFile)
|
||||
asWebAppSrcFile,
|
||||
)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Generator.WebAppGenerator.ExternalCodeGenerator as WebAppExternalCodeGenerator
|
||||
import Generator.WebAppGenerator.OperationsGenerator (genOperations)
|
||||
import qualified Generator.WebAppGenerator.RouterGenerator as RouterGenerator
|
||||
import qualified NpmDependency as ND
|
||||
import StrongPath (Dir, Path,
|
||||
Rel, (</>))
|
||||
import qualified Path as P
|
||||
import StrongPath
|
||||
( Dir,
|
||||
Path,
|
||||
Rel,
|
||||
(</>),
|
||||
)
|
||||
import qualified StrongPath as SP
|
||||
import Wasp
|
||||
import qualified Wasp.App
|
||||
import qualified Wasp.NpmDependencies as WND
|
||||
|
||||
|
||||
generateWebApp :: Wasp -> CompileOptions -> [FileDraft]
|
||||
generateWebApp wasp _ = concat
|
||||
[ [generateReadme wasp]
|
||||
, [genPackageJson wasp waspNpmDeps]
|
||||
, [generateGitignore wasp]
|
||||
, generatePublicDir wasp
|
||||
, generateSrcDir wasp
|
||||
, generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp
|
||||
, [C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
||||
generateWebApp wasp _ =
|
||||
concat
|
||||
[ [generateReadme wasp],
|
||||
[genPackageJson wasp waspNpmDeps],
|
||||
[generateGitignore wasp],
|
||||
generatePublicDir wasp,
|
||||
generateSrcDir wasp,
|
||||
generateExternalCodeDir WebAppExternalCodeGenerator.generatorStrategy wasp,
|
||||
[C.makeSimpleTemplateFD (asTmplFile [P.relfile|netlify.toml|]) wasp]
|
||||
]
|
||||
|
||||
generateReadme :: Wasp -> FileDraft
|
||||
generateReadme wasp = C.makeSimpleTemplateFD (asTmplFile [P.relfile|README.md|]) wasp
|
||||
|
||||
genPackageJson :: Wasp -> [ND.NpmDependency] -> FileDraft
|
||||
genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
genPackageJson wasp waspDeps =
|
||||
C.makeTemplateFD
|
||||
(C.asTmplFile [P.relfile|package.json|])
|
||||
(C.asWebAppFile [P.relfile|package.json|])
|
||||
(Just $ object
|
||||
[ "wasp" .= wasp
|
||||
, "depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
])
|
||||
( Just $
|
||||
object
|
||||
[ "wasp" .= wasp,
|
||||
"depsChunk" .= toPackageJsonDependenciesString (resolvedWaspDeps ++ resolvedUserDeps)
|
||||
]
|
||||
)
|
||||
where
|
||||
(resolvedWaspDeps, resolvedUserDeps) =
|
||||
case resolveNpmDeps waspDeps userDeps of
|
||||
@ -61,42 +75,48 @@ genPackageJson wasp waspDeps = C.makeTemplateFD
|
||||
userDeps = WND._dependencies $ Wasp.getNpmDependencies wasp
|
||||
|
||||
waspNpmDeps :: [ND.NpmDependency]
|
||||
waspNpmDeps = ND.fromList
|
||||
[ ("axios", "^0.21.1")
|
||||
, ("lodash", "^4.17.15")
|
||||
, ("react", "^16.12.0")
|
||||
, ("react-dom", "^16.12.0")
|
||||
, ("react-query", "^2.14.1")
|
||||
, ("react-router-dom", "^5.1.2")
|
||||
, ("react-scripts", "4.0.3")
|
||||
, ("uuid", "^3.4.0")
|
||||
waspNpmDeps =
|
||||
ND.fromList
|
||||
[ ("axios", "^0.21.1"),
|
||||
("lodash", "^4.17.15"),
|
||||
("react", "^16.12.0"),
|
||||
("react-dom", "^16.12.0"),
|
||||
("react-query", "^2.14.1"),
|
||||
("react-router-dom", "^5.1.2"),
|
||||
("react-scripts", "4.0.3"),
|
||||
("uuid", "^3.4.0")
|
||||
]
|
||||
|
||||
-- TODO: Also extract devDependencies like we did dependencies (waspNpmDeps).
|
||||
|
||||
generateGitignore :: Wasp -> FileDraft
|
||||
generateGitignore wasp = C.makeTemplateFD (asTmplFile [P.relfile|gitignore|])
|
||||
generateGitignore wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|gitignore|])
|
||||
(asWebAppFile [P.relfile|.gitignore|])
|
||||
(Just $ toJSON wasp)
|
||||
|
||||
generatePublicDir :: Wasp -> [FileDraft]
|
||||
generatePublicDir wasp =
|
||||
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|])
|
||||
: generatePublicIndexHtml wasp
|
||||
: map (\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
||||
C.copyTmplAsIs (asTmplFile [P.relfile|public/favicon.ico|]) :
|
||||
generatePublicIndexHtml wasp :
|
||||
map
|
||||
(\path -> C.makeSimpleTemplateFD (asTmplFile $ [P.reldir|public|] P.</> path) wasp)
|
||||
[ [P.relfile|manifest.json|]
|
||||
]
|
||||
|
||||
generatePublicIndexHtml :: Wasp -> FileDraft
|
||||
generatePublicIndexHtml wasp = C.makeTemplateFD
|
||||
generatePublicIndexHtml wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.relfile|public/index.html|])
|
||||
targetPath
|
||||
(Just templateData)
|
||||
where
|
||||
targetPath = SP.fromPathRelFile [P.relfile|public/index.html|]
|
||||
templateData = object
|
||||
[ "title" .= (Wasp.App.appTitle $ getApp wasp)
|
||||
, "head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
||||
templateData =
|
||||
object
|
||||
[ "title" .= (Wasp.App.appTitle $ getApp wasp),
|
||||
"head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp))
|
||||
]
|
||||
|
||||
-- * Src dir
|
||||
@ -108,28 +128,34 @@ srcDir = C.webAppSrcDirInWebAppRootDir
|
||||
-- although they are not used anywhere outside.
|
||||
-- We could further "templatize" this file so only what is needed is generated.
|
||||
--
|
||||
|
||||
-- | Generates api.js file which contains token management and configured api (e.g. axios) instance.
|
||||
genApi :: FileDraft
|
||||
genApi = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/api.js|])
|
||||
|
||||
generateSrcDir :: Wasp -> [FileDraft]
|
||||
generateSrcDir wasp
|
||||
= generateLogo
|
||||
: RouterGenerator.generateRouter wasp
|
||||
: genApi
|
||||
: map makeSimpleSrcTemplateFD
|
||||
[ [P.relfile|index.js|]
|
||||
, [P.relfile|index.css|]
|
||||
, [P.relfile|serviceWorker.js|]
|
||||
, [P.relfile|config.js|]
|
||||
, [P.relfile|queryCache.js|]
|
||||
generateSrcDir wasp =
|
||||
generateLogo :
|
||||
RouterGenerator.generateRouter wasp :
|
||||
genApi :
|
||||
map
|
||||
makeSimpleSrcTemplateFD
|
||||
[ [P.relfile|index.js|],
|
||||
[P.relfile|index.css|],
|
||||
[P.relfile|serviceWorker.js|],
|
||||
[P.relfile|config.js|],
|
||||
[P.relfile|queryCache.js|]
|
||||
]
|
||||
++ genOperations wasp
|
||||
++ AuthG.genAuth wasp
|
||||
where
|
||||
generateLogo = C.makeTemplateFD (asTmplFile [P.relfile|src/logo.png|])
|
||||
generateLogo =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile [P.relfile|src/logo.png|])
|
||||
(srcDir </> asWebAppSrcFile [P.relfile|logo.png|])
|
||||
Nothing
|
||||
makeSimpleSrcTemplateFD path = C.makeTemplateFD (asTmplFile $ [P.reldir|src|] P.</> path)
|
||||
makeSimpleSrcTemplateFD path =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> path)
|
||||
(srcDir </> asWebAppSrcFile path)
|
||||
(Just $ toJSON wasp)
|
||||
|
@ -1,23 +1,24 @@
|
||||
module Generator.WebAppGenerator.AuthG
|
||||
( genAuth
|
||||
) where
|
||||
( genAuth,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object, (.=))
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath ((</>))
|
||||
import Wasp (Wasp, getAuth)
|
||||
import qualified Wasp.Auth
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common as C
|
||||
|
||||
genAuth :: Wasp -> [FileDraft]
|
||||
genAuth wasp = case maybeAuth of
|
||||
Just auth -> [ genSignup
|
||||
, genLogin
|
||||
, genLogout
|
||||
, genUseAuth
|
||||
, genCreateAuthRequiredPage auth
|
||||
Just auth ->
|
||||
[ genSignup,
|
||||
genLogin,
|
||||
genLogout,
|
||||
genUseAuth,
|
||||
genCreateAuthRequiredPage auth
|
||||
]
|
||||
++ genAuthForms
|
||||
Nothing -> []
|
||||
@ -38,7 +39,8 @@ genLogout = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/logout.js|])
|
||||
|
||||
-- | Generates HOC that handles auth for the given page.
|
||||
genCreateAuthRequiredPage :: Wasp.Auth.Auth -> FileDraft
|
||||
genCreateAuthRequiredPage auth = C.makeTemplateFD
|
||||
genCreateAuthRequiredPage auth =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> authReqPagePath)
|
||||
targetPath
|
||||
(Just templateData)
|
||||
@ -55,8 +57,8 @@ genUseAuth = C.copyTmplAsIs (C.asTmplFile [P.relfile|src/auth/useAuth.js|])
|
||||
|
||||
genAuthForms :: [FileDraft]
|
||||
genAuthForms =
|
||||
[ genLoginForm
|
||||
, genSignupForm
|
||||
[ genLoginForm,
|
||||
genSignupForm
|
||||
]
|
||||
|
||||
genLoginForm :: FileDraft
|
||||
|
@ -1,34 +1,34 @@
|
||||
module Generator.WebAppGenerator.Common
|
||||
( webAppRootDirInProjectRootDir
|
||||
, webAppSrcDirInWebAppRootDir
|
||||
, copyTmplAsIs
|
||||
, makeSimpleTemplateFD
|
||||
, makeTemplateFD
|
||||
, webAppSrcDirInProjectRootDir
|
||||
, webAppTemplatesDirInTemplatesDir
|
||||
, asTmplFile
|
||||
, asWebAppFile
|
||||
, asWebAppSrcFile
|
||||
, WebAppRootDir
|
||||
, WebAppSrcDir
|
||||
, WebAppTemplatesDir
|
||||
) where
|
||||
( webAppRootDirInProjectRootDir,
|
||||
webAppSrcDirInWebAppRootDir,
|
||||
copyTmplAsIs,
|
||||
makeSimpleTemplateFD,
|
||||
makeTemplateFD,
|
||||
webAppSrcDirInProjectRootDir,
|
||||
webAppTemplatesDirInTemplatesDir,
|
||||
asTmplFile,
|
||||
asWebAppFile,
|
||||
asWebAppSrcFile,
|
||||
WebAppRootDir,
|
||||
WebAppSrcDir,
|
||||
WebAppTemplatesDir,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, File, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import Generator.FileDraft (FileDraft, createTemplateFileDraft)
|
||||
import Generator.Templates (TemplatesDir)
|
||||
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, File, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
|
||||
data WebAppRootDir
|
||||
data WebAppSrcDir
|
||||
data WebAppTemplatesDir
|
||||
|
||||
data WebAppSrcDir
|
||||
|
||||
data WebAppTemplatesDir
|
||||
|
||||
asTmplFile :: P.Path P.Rel P.File -> Path (Rel WebAppTemplatesDir) File
|
||||
asTmplFile = SP.fromPathRelFile
|
||||
@ -39,7 +39,6 @@ asWebAppFile = SP.fromPathRelFile
|
||||
asWebAppSrcFile :: P.Path P.Rel P.File -> Path (Rel WebAppSrcDir) File
|
||||
asWebAppSrcFile = SP.fromPathRelFile
|
||||
|
||||
|
||||
-- * Paths
|
||||
|
||||
-- | Path where web app root dir is generated, relative to the root directory of the whole generated project.
|
||||
@ -53,7 +52,6 @@ webAppSrcDirInWebAppRootDir = SP.fromPathRelDir [P.reldir|src|]
|
||||
webAppSrcDirInProjectRootDir :: Path (Rel ProjectRootDir) (Dir WebAppSrcDir)
|
||||
webAppSrcDirInProjectRootDir = webAppRootDirInProjectRootDir </> webAppSrcDirInWebAppRootDir
|
||||
|
||||
|
||||
-- * Templates
|
||||
|
||||
-- | Path in templates directory where web app templates reside.
|
||||
@ -66,11 +64,11 @@ copyTmplAsIs path = makeTemplateFD path (SP.castRel path) Nothing
|
||||
makeSimpleTemplateFD :: Path (Rel WebAppTemplatesDir) File -> Wasp -> FileDraft
|
||||
makeSimpleTemplateFD path wasp = makeTemplateFD path (SP.castRel path) (Just $ Aeson.toJSON wasp)
|
||||
|
||||
makeTemplateFD
|
||||
:: Path (Rel WebAppTemplatesDir) File
|
||||
-> Path (Rel WebAppRootDir) File
|
||||
-> Maybe Aeson.Value
|
||||
-> FileDraft
|
||||
makeTemplateFD ::
|
||||
Path (Rel WebAppTemplatesDir) File ->
|
||||
Path (Rel WebAppRootDir) File ->
|
||||
Maybe Aeson.Value ->
|
||||
FileDraft
|
||||
makeTemplateFD srcPathInWebAppTemplatesDir dstPathInWebAppRootDir tmplData =
|
||||
createTemplateFileDraft
|
||||
(webAppRootDirInProjectRootDir </> dstPathInWebAppRootDir)
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Generator.WebAppGenerator.ExternalCodeGenerator
|
||||
( extCodeDirInWebAppSrcDir
|
||||
, generatorStrategy
|
||||
) where
|
||||
( extCodeDirInWebAppSrcDir,
|
||||
generatorStrategy,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Path as P
|
||||
|
||||
import StrongPath (Path, Rel, Dir, (</>))
|
||||
import qualified StrongPath as SP
|
||||
import Generator.ExternalCodeGenerator.Common (ExternalCodeGeneratorStrategy (..), GeneratedExternalCodeDir)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import Generator.ExternalCodeGenerator.Js (resolveJsFileWaspImportsForExtCodeDir)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath (Dir, Path, Rel, (</>))
|
||||
import qualified StrongPath as SP
|
||||
|
||||
-- | Relative path to directory where external code will be generated.
|
||||
-- Relative to web app src dir.
|
||||
@ -17,9 +17,11 @@ extCodeDirInWebAppSrcDir :: Path (Rel C.WebAppSrcDir) (Dir GeneratedExternalCode
|
||||
extCodeDirInWebAppSrcDir = SP.fromPathRelDir [P.reldir|ext-src|]
|
||||
|
||||
generatorStrategy :: ExternalCodeGeneratorStrategy
|
||||
generatorStrategy = ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir)
|
||||
, _extCodeDirInProjectRootDir = C.webAppRootDirInProjectRootDir
|
||||
generatorStrategy =
|
||||
ExternalCodeGeneratorStrategy
|
||||
{ _resolveJsFileWaspImports = resolveJsFileWaspImportsForExtCodeDir (SP.castRel extCodeDirInWebAppSrcDir),
|
||||
_extCodeDirInProjectRootDir =
|
||||
C.webAppRootDirInProjectRootDir
|
||||
</> C.webAppSrcDirInWebAppRootDir
|
||||
</> extCodeDirInWebAppSrcDir
|
||||
}
|
||||
|
@ -1,42 +1,48 @@
|
||||
module Generator.WebAppGenerator.OperationsGenerator
|
||||
( genOperations
|
||||
) where
|
||||
( genOperations,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object,
|
||||
(.=))
|
||||
import Data.Aeson
|
||||
( object,
|
||||
(.=),
|
||||
)
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe (fromJust,
|
||||
fromMaybe)
|
||||
import qualified Path as P
|
||||
|
||||
import Data.Maybe
|
||||
( fromJust,
|
||||
fromMaybe,
|
||||
)
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.ServerGenerator as ServerGenerator
|
||||
import qualified Generator.ServerGenerator.OperationsRoutesG as ServerOperationsRoutesG
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Generator.WebAppGenerator.OperationsGenerator.ResourcesG as Resources
|
||||
import qualified Path as P
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
import qualified Wasp.Action
|
||||
import qualified Wasp.Operation
|
||||
import qualified Wasp.Query
|
||||
|
||||
|
||||
genOperations :: Wasp -> [FileDraft]
|
||||
genOperations wasp = concat
|
||||
[ genQueries wasp
|
||||
, genActions wasp
|
||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp]
|
||||
, Resources.genResources wasp
|
||||
genOperations wasp =
|
||||
concat
|
||||
[ genQueries wasp,
|
||||
genActions wasp,
|
||||
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/operations/index.js|]) wasp],
|
||||
Resources.genResources wasp
|
||||
]
|
||||
|
||||
genQueries :: Wasp -> [FileDraft]
|
||||
genQueries wasp = concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp)
|
||||
, [C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
||||
genQueries wasp =
|
||||
concat
|
||||
[ map (genQuery wasp) (Wasp.getQueries wasp),
|
||||
[C.makeSimpleTemplateFD (C.asTmplFile [P.relfile|src/queries/index.js|]) wasp]
|
||||
]
|
||||
|
||||
genActions :: Wasp -> [FileDraft]
|
||||
genActions wasp = concat
|
||||
genActions wasp =
|
||||
concat
|
||||
[ map (genAction wasp) (Wasp.getActions wasp)
|
||||
]
|
||||
|
||||
@ -44,14 +50,17 @@ genQuery :: Wasp -> Wasp.Query.Query -> FileDraft
|
||||
genQuery _ query = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/queries/_query.js|]
|
||||
-- | TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
|
||||
dstFile = C.asWebAppFile $ [P.reldir|src/queries/|] P.</> fromJust (getOperationDstFileName operation)
|
||||
tmplData = object
|
||||
[ "queryFnName" .= Wasp.Query._name query
|
||||
, "queryRoute" .=
|
||||
(ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
tmplData =
|
||||
object
|
||||
[ "queryFnName" .= Wasp.Query._name query,
|
||||
"queryRoute"
|
||||
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/"
|
||||
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||
),
|
||||
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
]
|
||||
operation = Wasp.Operation.QueryOp query
|
||||
|
||||
@ -59,14 +68,17 @@ genAction :: Wasp -> Wasp.Action.Action -> FileDraft
|
||||
genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
where
|
||||
tmplFile = C.asTmplFile [P.relfile|src/actions/_action.js|]
|
||||
-- | TODO: fromJust here could fail if there is some problem with the name, we should handle this.
|
||||
|
||||
dstFile = C.asWebAppFile $ [P.reldir|src/actions/|] P.</> fromJust (getOperationDstFileName operation)
|
||||
tmplData = object
|
||||
[ "actionFnName" .= Wasp.Action._name action
|
||||
, "actionRoute" .=
|
||||
(ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/" ++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation)
|
||||
, "entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
tmplData =
|
||||
object
|
||||
[ "actionFnName" .= Wasp.Action._name action,
|
||||
"actionRoute"
|
||||
.= ( ServerGenerator.operationsRouteInRootRouter
|
||||
++ "/"
|
||||
++ ServerOperationsRoutesG.operationRouteInOperationsRouter operation
|
||||
),
|
||||
"entitiesArray" .= makeJsArrayOfEntityNames operation
|
||||
]
|
||||
operation = Wasp.Operation.ActionOp action
|
||||
|
||||
@ -74,7 +86,8 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData)
|
||||
-- E.g. "['Task', 'Project']"
|
||||
makeJsArrayOfEntityNames :: Wasp.Operation.Operation -> String
|
||||
makeJsArrayOfEntityNames operation = "[" ++ intercalate ", " entityStrings ++ "]"
|
||||
where entityStrings = map (\x -> "'" ++ x ++ "'") $ fromMaybe [] $ Wasp.Operation.getEntities operation
|
||||
where
|
||||
entityStrings = map (\x -> "'" ++ x ++ "'") $ fromMaybe [] $ Wasp.Operation.getEntities operation
|
||||
|
||||
getOperationDstFileName :: Wasp.Operation.Operation -> Maybe (P.Path P.Rel P.File)
|
||||
getOperationDstFileName operation = P.parseRelFile (Wasp.Operation.getName operation ++ ".js")
|
||||
|
@ -1,15 +1,14 @@
|
||||
module Generator.WebAppGenerator.OperationsGenerator.ResourcesG
|
||||
( genResources
|
||||
) where
|
||||
( genResources,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (object)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import Wasp (Wasp)
|
||||
|
||||
|
||||
genResources :: Wasp -> [FileDraft]
|
||||
genResources _ = [C.makeTemplateFD tmplFile dstFile (Just tmplData)]
|
||||
where
|
||||
|
@ -1,14 +1,14 @@
|
||||
module Generator.WebAppGenerator.RouterGenerator
|
||||
( generateRouter
|
||||
) where
|
||||
( generateRouter,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Data.Maybe (isJust)
|
||||
import qualified Path as P
|
||||
|
||||
import Generator.FileDraft (FileDraft)
|
||||
import Generator.WebAppGenerator.Common (asTmplFile, asWebAppSrcFile)
|
||||
import qualified Generator.WebAppGenerator.Common as C
|
||||
import qualified Path as P
|
||||
import StrongPath ((</>))
|
||||
import qualified StrongPath as SP
|
||||
import Wasp (Wasp)
|
||||
@ -17,44 +17,48 @@ import qualified Wasp.JsImport
|
||||
import qualified Wasp.Page
|
||||
import qualified Wasp.Route
|
||||
|
||||
|
||||
data RouterTemplateData = RouterTemplateData
|
||||
{ _routes :: ![RouteTemplateData]
|
||||
, _pagesToImport :: ![PageTemplateData]
|
||||
, _isAuthEnabled :: Bool
|
||||
{ _routes :: ![RouteTemplateData],
|
||||
_pagesToImport :: ![PageTemplateData],
|
||||
_isAuthEnabled :: Bool
|
||||
}
|
||||
|
||||
instance ToJSON RouterTemplateData where
|
||||
toJSON routerTD = object
|
||||
[ "routes" .= _routes routerTD
|
||||
, "pagesToImport" .= _pagesToImport routerTD
|
||||
, "isAuthEnabled" .= _isAuthEnabled routerTD
|
||||
toJSON routerTD =
|
||||
object
|
||||
[ "routes" .= _routes routerTD,
|
||||
"pagesToImport" .= _pagesToImport routerTD,
|
||||
"isAuthEnabled" .= _isAuthEnabled routerTD
|
||||
]
|
||||
|
||||
data RouteTemplateData = RouteTemplateData
|
||||
{ _urlPath :: !String
|
||||
, _targetComponent :: !String
|
||||
{ _urlPath :: !String,
|
||||
_targetComponent :: !String
|
||||
}
|
||||
|
||||
instance ToJSON RouteTemplateData where
|
||||
toJSON routeTD = object
|
||||
[ "urlPath" .= _urlPath routeTD
|
||||
, "targetComponent" .= _targetComponent routeTD
|
||||
toJSON routeTD =
|
||||
object
|
||||
[ "urlPath" .= _urlPath routeTD,
|
||||
"targetComponent" .= _targetComponent routeTD
|
||||
]
|
||||
|
||||
data PageTemplateData = PageTemplateData
|
||||
{ _importWhat :: !String
|
||||
, _importFrom :: !String
|
||||
} deriving (Show, Eq)
|
||||
{ _importWhat :: !String,
|
||||
_importFrom :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PageTemplateData where
|
||||
toJSON pageTD = object
|
||||
[ "importWhat" .= _importWhat pageTD
|
||||
, "importFrom" .= _importFrom pageTD
|
||||
toJSON pageTD =
|
||||
object
|
||||
[ "importWhat" .= _importWhat pageTD,
|
||||
"importFrom" .= _importFrom pageTD
|
||||
]
|
||||
|
||||
generateRouter :: Wasp -> FileDraft
|
||||
generateRouter wasp = C.makeTemplateFD
|
||||
generateRouter wasp =
|
||||
C.makeTemplateFD
|
||||
(asTmplFile $ [P.reldir|src|] P.</> routerPath)
|
||||
targetPath
|
||||
(Just $ toJSON templateData)
|
||||
@ -64,19 +68,21 @@ generateRouter wasp = C.makeTemplateFD
|
||||
targetPath = C.webAppSrcDirInWebAppRootDir </> asWebAppSrcFile routerPath
|
||||
|
||||
createRouterTemplateData :: Wasp -> RouterTemplateData
|
||||
createRouterTemplateData wasp = RouterTemplateData
|
||||
{ _routes = routes
|
||||
, _pagesToImport = pages
|
||||
, _isAuthEnabled = isJust $ Wasp.getAuth wasp
|
||||
createRouterTemplateData wasp =
|
||||
RouterTemplateData
|
||||
{ _routes = routes,
|
||||
_pagesToImport = pages,
|
||||
_isAuthEnabled = isJust $ Wasp.getAuth wasp
|
||||
}
|
||||
where
|
||||
routes = map (createRouteTemplateData wasp) $ Wasp.getRoutes wasp
|
||||
pages = map createPageTemplateData $ Wasp.getPages wasp
|
||||
|
||||
createRouteTemplateData :: Wasp -> Wasp.Route.Route -> RouteTemplateData
|
||||
createRouteTemplateData wasp route = RouteTemplateData
|
||||
{ _urlPath = Wasp.Route._urlPath route
|
||||
, _targetComponent = determineRouteTargetComponent wasp route
|
||||
createRouteTemplateData wasp route =
|
||||
RouteTemplateData
|
||||
{ _urlPath = Wasp.Route._urlPath route,
|
||||
_targetComponent = determineRouteTargetComponent wasp route
|
||||
}
|
||||
|
||||
determineRouteTargetComponent :: Wasp -> Wasp.Route.Route -> String
|
||||
@ -90,21 +96,20 @@ determineRouteTargetComponent wasp route =
|
||||
-- NOTE(matija): if no page with the name specified in the route, head will fail.
|
||||
targetPage = head $ filter ((==) targetPageName . Wasp.Page._name) (Wasp.getPages wasp)
|
||||
|
||||
-- | Applied if authRequired property is present.
|
||||
determineRouteTargetComponent' :: Bool -> String
|
||||
determineRouteTargetComponent' authRequired =
|
||||
if authRequired
|
||||
-- TODO(matija): would be nicer if this function name wasn't hardcoded here.
|
||||
then "createAuthRequiredPage(" ++ targetPageName ++ ")"
|
||||
then -- TODO(matija): would be nicer if this function name wasn't hardcoded here.
|
||||
"createAuthRequiredPage(" ++ targetPageName ++ ")"
|
||||
else targetPageName
|
||||
|
||||
|
||||
|
||||
createPageTemplateData :: Wasp.Page.Page -> PageTemplateData
|
||||
createPageTemplateData page = PageTemplateData
|
||||
{ _importFrom = relPathToExtSrcDir ++
|
||||
SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent)
|
||||
, _importWhat = case Wasp.JsImport._namedImports pageComponent of
|
||||
createPageTemplateData page =
|
||||
PageTemplateData
|
||||
{ _importFrom =
|
||||
relPathToExtSrcDir
|
||||
++ SP.toFilePath (SP.relFileToPosix' $ Wasp.JsImport._from pageComponent),
|
||||
_importWhat = case Wasp.JsImport._namedImports pageComponent of
|
||||
-- If no named imports, we go with the default import.
|
||||
[] -> pageName
|
||||
[namedImport] -> "{ " ++ namedImport ++ " as " ++ pageName ++ " }"
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Generator.WebAppGenerator.Setup
|
||||
( setupWebApp
|
||||
) where
|
||||
( setupWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
@ -8,7 +9,6 @@ import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.WebAppGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
|
||||
setupWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
setupWebApp projectDir = do
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Generator.WebAppGenerator.Start
|
||||
( startWebApp
|
||||
) where
|
||||
( startWebApp,
|
||||
)
|
||||
where
|
||||
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Generator.Job as J
|
||||
@ -8,7 +9,6 @@ import Generator.Job.Process (runNodeCommandAsJob)
|
||||
import qualified Generator.WebAppGenerator.Common as Common
|
||||
import StrongPath (Abs, Dir, Path, (</>))
|
||||
|
||||
|
||||
startWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||
startWebApp projectDir = do
|
||||
let webAppDir = projectDir </> Common.webAppRootDirInProjectRootDir
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Lexer where
|
||||
|
||||
import Text.Parsec (letter, alphaNum, (<|>), char, between)
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec (alphaNum, between, char, letter, (<|>))
|
||||
import Text.Parsec.Language (emptyDef)
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Text.Parsec.Token as Token
|
||||
|
||||
reservedNameImport :: String
|
||||
@ -56,32 +56,33 @@ reservedNameBooleanFalse = "false"
|
||||
|
||||
reservedNames :: [String]
|
||||
reservedNames =
|
||||
[ reservedNameImport
|
||||
, reservedNameFrom
|
||||
[ reservedNameImport,
|
||||
reservedNameFrom,
|
||||
-- Wasp element types
|
||||
, reservedNameApp
|
||||
, reservedNameDependencies
|
||||
, reservedNamePage
|
||||
, reservedNameRoute
|
||||
, reservedNameEntity
|
||||
, reservedNameAuth
|
||||
, reservedNameQuery
|
||||
, reservedNameAction
|
||||
reservedNameApp,
|
||||
reservedNameDependencies,
|
||||
reservedNamePage,
|
||||
reservedNameRoute,
|
||||
reservedNameEntity,
|
||||
reservedNameAuth,
|
||||
reservedNameQuery,
|
||||
reservedNameAction,
|
||||
-- Data types
|
||||
, reservedNameString
|
||||
, reservedNameBoolean
|
||||
, reservedNameBooleanTrue
|
||||
, reservedNameBooleanFalse
|
||||
reservedNameString,
|
||||
reservedNameBoolean,
|
||||
reservedNameBooleanTrue,
|
||||
reservedNameBooleanFalse
|
||||
]
|
||||
|
||||
waspLanguageDef :: Token.LanguageDef ()
|
||||
waspLanguageDef = emptyDef
|
||||
{ Token.commentLine = "//"
|
||||
, Token.reservedNames = reservedNames
|
||||
, Token.caseSensitive = True
|
||||
waspLanguageDef =
|
||||
emptyDef
|
||||
{ Token.commentLine = "//",
|
||||
Token.reservedNames = reservedNames,
|
||||
Token.caseSensitive = True,
|
||||
-- Identifier
|
||||
, Token.identStart = letter
|
||||
, Token.identLetter = alphaNum <|> char '_'
|
||||
Token.identStart = letter,
|
||||
Token.identLetter = alphaNum <|> char '_'
|
||||
}
|
||||
|
||||
waspLexer :: Token.TokenParser ()
|
||||
|
@ -1,12 +1,10 @@
|
||||
module Lib
|
||||
( compile
|
||||
, Generator.setup
|
||||
, Generator.start
|
||||
, ProjectRootDir
|
||||
) where
|
||||
|
||||
import qualified Path as P
|
||||
import System.Directory (doesFileExist)
|
||||
( compile,
|
||||
Generator.setup,
|
||||
Generator.start,
|
||||
ProjectRootDir,
|
||||
)
|
||||
where
|
||||
|
||||
import Common (WaspProjectDir)
|
||||
import CompileOptions (CompileOptions)
|
||||
@ -17,19 +15,21 @@ import qualified ExternalCode
|
||||
import qualified Generator
|
||||
import Generator.Common (ProjectRootDir)
|
||||
import qualified Parser
|
||||
import qualified Path as P
|
||||
import StrongPath (Abs, Dir, Path)
|
||||
import qualified StrongPath as SP
|
||||
import System.Directory (doesFileExist)
|
||||
import qualified Util.IO
|
||||
import Wasp (Wasp)
|
||||
import qualified Wasp
|
||||
|
||||
|
||||
type CompileError = String
|
||||
|
||||
compile :: Path Abs (Dir WaspProjectDir)
|
||||
-> Path Abs (Dir ProjectRootDir)
|
||||
-> CompileOptions
|
||||
-> IO (Either CompileError ())
|
||||
compile ::
|
||||
Path Abs (Dir WaspProjectDir) ->
|
||||
Path Abs (Dir ProjectRootDir) ->
|
||||
CompileOptions ->
|
||||
IO (Either CompileError ())
|
||||
compile waspDir outDir options = do
|
||||
maybeWaspFile <- findWaspFile waspDir
|
||||
case maybeWaspFile of
|
||||
@ -44,14 +44,16 @@ compile waspDir outDir options = do
|
||||
( wasp
|
||||
`Wasp.setDotEnvFile` maybeDotEnvFile
|
||||
`enrichWaspASTBasedOnCompileOptions` options
|
||||
) >>= generateCode
|
||||
)
|
||||
>>= generateCode
|
||||
where
|
||||
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
||||
|
||||
enrichWaspASTBasedOnCompileOptions :: Wasp -> CompileOptions -> IO Wasp
|
||||
enrichWaspASTBasedOnCompileOptions wasp options = do
|
||||
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
|
||||
return (wasp
|
||||
return
|
||||
( wasp
|
||||
`Wasp.setExternalCodeFiles` externalCodeFiles
|
||||
`Wasp.setIsBuild` CompileOptions.isBuild options
|
||||
)
|
||||
@ -62,7 +64,8 @@ findWaspFile waspDir = do
|
||||
return $ (waspDir SP.</>) . SP.fromPathRelFile <$> find isWaspFile files
|
||||
where
|
||||
isWaspFile :: P.Path P.Rel P.File -> Bool
|
||||
isWaspFile path = ".wasp" `isSuffixOf` P.toFilePath path
|
||||
isWaspFile path =
|
||||
".wasp" `isSuffixOf` P.toFilePath path
|
||||
&& (length (P.toFilePath path) > length (".wasp" :: String))
|
||||
|
||||
findDotEnvFile :: Path Abs (Dir WaspProjectDir) -> IO (Maybe (Path Abs SP.File))
|
||||
|
@ -1,21 +1,23 @@
|
||||
module NpmDependency
|
||||
( NpmDependency (..)
|
||||
, fromList
|
||||
) where
|
||||
( NpmDependency (..),
|
||||
fromList,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
|
||||
data NpmDependency = NpmDependency
|
||||
{ _name :: !String
|
||||
, _version :: !String }
|
||||
{ _name :: !String,
|
||||
_version :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
fromList :: [(String, String)] -> [NpmDependency]
|
||||
fromList = map (\(name, version) -> NpmDependency {_name = name, _version = version})
|
||||
|
||||
instance ToJSON NpmDependency where
|
||||
toJSON npmDep = object
|
||||
[ "name" .= _name npmDep
|
||||
, "version" .= _version npmDep
|
||||
toJSON npmDep =
|
||||
object
|
||||
[ "name" .= _name npmDep,
|
||||
"version" .= _version npmDep
|
||||
]
|
||||
|
@ -1,30 +1,27 @@
|
||||
module Parser
|
||||
( parseWasp
|
||||
) where
|
||||
|
||||
import Text.Parsec (ParseError, (<|>), many1, eof, many)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Wasp
|
||||
( parseWasp,
|
||||
)
|
||||
where
|
||||
|
||||
import Lexer
|
||||
|
||||
import qualified Parser.Action
|
||||
import Parser.App (app)
|
||||
import Parser.Auth (auth)
|
||||
import Parser.Db (db)
|
||||
import Parser.Route (route)
|
||||
import Parser.Page (page)
|
||||
import Parser.Entity (entity)
|
||||
|
||||
import Parser.JsImport (jsImport)
|
||||
import Parser.Common (runWaspParser)
|
||||
import qualified Parser.Query
|
||||
import qualified Parser.Action
|
||||
import Parser.Db (db)
|
||||
import Parser.Entity (entity)
|
||||
import Parser.JsImport (jsImport)
|
||||
import qualified Parser.NpmDependencies
|
||||
import Parser.Page (page)
|
||||
import qualified Parser.Query
|
||||
import Parser.Route (route)
|
||||
import Text.Parsec (ParseError, eof, many, many1, (<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp
|
||||
|
||||
waspElement :: Parser Wasp.WaspElement
|
||||
waspElement
|
||||
= waspElementApp
|
||||
waspElement =
|
||||
waspElementApp
|
||||
<|> waspElementAuth
|
||||
<|> waspElementPage
|
||||
<|> waspElementDb
|
||||
@ -52,7 +49,6 @@ waspElementRoute = Wasp.WaspElementRoute <$> route
|
||||
waspElementEntity :: Parser Wasp.WaspElement
|
||||
waspElementEntity = Wasp.WaspElementEntity <$> entity
|
||||
|
||||
|
||||
waspElementQuery :: Parser Wasp.WaspElement
|
||||
waspElementQuery = Wasp.WaspElementQuery <$> Parser.Query.query
|
||||
|
||||
@ -62,7 +58,6 @@ waspElementAction = Wasp.WaspElementAction <$> Parser.Action.action
|
||||
waspElementNpmDependencies :: Parser Wasp.WaspElement
|
||||
waspElementNpmDependencies = Wasp.WaspElementNpmDependencies <$> Parser.NpmDependencies.npmDependencies
|
||||
|
||||
|
||||
-- | Top level parser, produces Wasp.
|
||||
waspParser :: Parser Wasp.Wasp
|
||||
waspParser = do
|
||||
|
@ -1,23 +1,23 @@
|
||||
module Parser.Action
|
||||
( action
|
||||
) where
|
||||
( action,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
|
||||
|
||||
action :: Parser Action
|
||||
action = do
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameAction Operation.properties
|
||||
return Action.Action
|
||||
{ Action._name = name
|
||||
, Action._jsFunction =
|
||||
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props)
|
||||
, Action._entities = Operation.getEntitiesFromProps props
|
||||
return
|
||||
Action.Action
|
||||
{ Action._name = name,
|
||||
Action._jsFunction =
|
||||
fromMaybe (error "Action js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||
Action._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
|
@ -1,15 +1,15 @@
|
||||
module Parser.App
|
||||
( app
|
||||
) where
|
||||
( app,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Lexer
|
||||
import qualified Lexer as L
|
||||
import Parser.Common
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Data.Maybe (listToMaybe)
|
||||
|
||||
import Lexer
|
||||
import qualified Wasp.App as App
|
||||
import Parser.Common
|
||||
import qualified Lexer as L
|
||||
|
||||
-- | A type that describes supported app properties.
|
||||
data AppProperty
|
||||
@ -20,8 +20,9 @@ data AppProperty
|
||||
|
||||
-- | Parses supported app properties, expects format "key1: value1, key2: value2, ..."
|
||||
appProperties :: Parser [AppProperty]
|
||||
appProperties = commaSep1
|
||||
$ appPropertyTitle
|
||||
appProperties =
|
||||
commaSep1 $
|
||||
appPropertyTitle
|
||||
<|> appPropertyFavicon
|
||||
<|> appPropertyHead
|
||||
|
||||
@ -47,9 +48,10 @@ app :: Parser App.App
|
||||
app = do
|
||||
(appName, appProps) <- waspElementNameAndClosureContent reservedNameApp appProperties
|
||||
|
||||
return App.App
|
||||
{ App.appName = appName
|
||||
, App.appTitle = getAppTitle appProps
|
||||
, App.appHead = getAppHead appProps
|
||||
return
|
||||
App.App
|
||||
{ App.appName = appName,
|
||||
App.appTitle = getAppTitle appProps,
|
||||
App.appHead = getAppHead appProps
|
||||
-- TODO(matija): add favicon.
|
||||
}
|
||||
|
@ -1,14 +1,14 @@
|
||||
module Parser.Auth
|
||||
( auth
|
||||
) where
|
||||
( auth,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec ((<|>))
|
||||
import Control.Monad (when)
|
||||
|
||||
import qualified Wasp.Auth
|
||||
import qualified Parser.Common as P
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Auth
|
||||
|
||||
auth :: Parser Wasp.Auth.Auth
|
||||
auth = do
|
||||
@ -24,16 +24,18 @@ auth = do
|
||||
let redirectProps = [r | AuthPropertyOnAuthFailedRedirectTo r <- authProperties]
|
||||
failIfPropMissing propOnAuthFailedRedirectToName redirectProps
|
||||
|
||||
return Wasp.Auth.Auth
|
||||
{ Wasp.Auth._userEntity = head userEntityProps
|
||||
, Wasp.Auth._methods = head methodsProps
|
||||
, Wasp.Auth._onAuthFailedRedirectTo = head redirectProps
|
||||
return
|
||||
Wasp.Auth.Auth
|
||||
{ Wasp.Auth._userEntity = head userEntityProps,
|
||||
Wasp.Auth._methods = head methodsProps,
|
||||
Wasp.Auth._onAuthFailedRedirectTo = head redirectProps
|
||||
}
|
||||
|
||||
-- TODO(matija): this should be extracted if we want to use in other places too.
|
||||
failIfPropMissing :: (Applicative m, MonadFail m) => String -> [p] -> m ()
|
||||
failIfPropMissing propName ps = when (null ps) $ fail errorMsg
|
||||
where errorMsg = propName ++ " is required!"
|
||||
where
|
||||
errorMsg = propName ++ " is required!"
|
||||
|
||||
-- Auxiliary data structure used by parser.
|
||||
data AuthProperty
|
||||
@ -53,8 +55,8 @@ propOnAuthFailedRedirectToName = "onAuthFailedRedirectTo"
|
||||
-- Sub-parsers
|
||||
|
||||
authProperty :: Parser AuthProperty
|
||||
authProperty
|
||||
= authPropertyUserEntity
|
||||
authProperty =
|
||||
authPropertyUserEntity
|
||||
<|> authPropertyMethods
|
||||
<|> authPropertyOnAuthFailedRedirectTo
|
||||
|
||||
|
@ -5,15 +5,19 @@
|
||||
module Parser.Common where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Lexer as L
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PPosix
|
||||
import Text.Parsec (ParseError, anyChar, manyTill, parse, try,
|
||||
unexpected)
|
||||
import Text.Parsec
|
||||
( ParseError,
|
||||
anyChar,
|
||||
manyTill,
|
||||
parse,
|
||||
try,
|
||||
unexpected,
|
||||
)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
|
||||
|
||||
-- | Runs given wasp parser on a specified input.
|
||||
runWaspParser :: Parser a -> String -> Either ParseError a
|
||||
runWaspParser waspParser input = parse waspParser sourceName input
|
||||
@ -24,19 +28,26 @@ runWaspParser waspParser input = parse waspParser sourceName input
|
||||
sourceName = ""
|
||||
|
||||
-- TODO(matija): rename to just "waspElement"?
|
||||
|
||||
-- | Parses declaration of a wasp element (e.g. App or Page) and the closure content.
|
||||
waspElementNameAndClosureContent
|
||||
:: String -- ^ Type of the wasp element (e.g. "app" or "page").
|
||||
-> Parser a -- ^ Parser to be used for parsing closure content of the wasp element.
|
||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
||||
waspElementNameAndClosureContent ::
|
||||
-- | Type of the wasp element (e.g. "app" or "page").
|
||||
String ->
|
||||
-- | Parser to be used for parsing closure content of the wasp element.
|
||||
Parser a ->
|
||||
-- | Name of the element and parsed closure content.
|
||||
Parser (String, a)
|
||||
waspElementNameAndClosureContent elementType closureContent =
|
||||
waspElementNameAndClosure elementType (waspClosure closureContent)
|
||||
|
||||
-- | Parses declaration of a wasp element (e.g. App or Page) and the belonging closure.
|
||||
waspElementNameAndClosure
|
||||
:: String -- ^ Element type
|
||||
-> Parser a -- ^ Closure parser (needs to parse braces as well, not just the content)
|
||||
-> Parser (String, a) -- ^ Name of the element and parsed closure content.
|
||||
waspElementNameAndClosure ::
|
||||
-- | Element type
|
||||
String ->
|
||||
-- | Closure parser (needs to parse braces as well, not just the content)
|
||||
Parser a ->
|
||||
-- | Name of the element and parsed closure content.
|
||||
Parser (String, a)
|
||||
waspElementNameAndClosure elementType closure =
|
||||
-- NOTE(matija): It is important to have `try` here because we don't want to consume the
|
||||
-- content intended for other parsers.
|
||||
@ -59,10 +70,13 @@ waspElementNameAndClosure elementType closure =
|
||||
|
||||
-- | Parses declaration of a wasp element linked to an entity.
|
||||
-- E.g. "entity-form<Task> ..." or "action<Task> ..."
|
||||
waspElementLinkedToEntity
|
||||
:: String -- ^ Type of the linked wasp element (e.g. "entity-form").
|
||||
-> Parser a -- ^ Parser to be used for parsing body of the wasp element.
|
||||
-> Parser (String, String, a) -- ^ Name of the linked entity, element name and body.
|
||||
waspElementLinkedToEntity ::
|
||||
-- | Type of the linked wasp element (e.g. "entity-form").
|
||||
String ->
|
||||
-- | Parser to be used for parsing body of the wasp element.
|
||||
Parser a ->
|
||||
-- | Name of the linked entity, element name and body.
|
||||
Parser (String, String, a)
|
||||
waspElementLinkedToEntity elementType bodyParser = do
|
||||
L.reserved elementType
|
||||
linkedEntityName <- L.angles L.identifier
|
||||
@ -128,6 +142,7 @@ waspCssClosure :: Parser String
|
||||
waspCssClosure = waspNamedClosure "css"
|
||||
|
||||
-- TODO(martin): write tests and comments.
|
||||
|
||||
-- | Parses named wasp closure, which is {=name...name=}. Returns content within the closure.
|
||||
waspNamedClosure :: String -> Parser String
|
||||
waspNamedClosure name = do
|
||||
@ -150,7 +165,8 @@ strip = T.unpack . T.strip . T.pack
|
||||
relFilePathString :: Parser (P.Path P.Rel P.File)
|
||||
relFilePathString = do
|
||||
path <- L.stringLiteral
|
||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(P.parseRelFile path)
|
||||
|
||||
@ -158,6 +174,7 @@ relFilePathString = do
|
||||
relPosixFilePathString :: Parser (PPosix.Path PPosix.Rel PPosix.File)
|
||||
relPosixFilePathString = do
|
||||
path <- L.stringLiteral
|
||||
maybe (unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ path ++ "\": Expected relative file path.")
|
||||
return
|
||||
(PPosix.parseRelFile path)
|
||||
|
@ -1,24 +1,27 @@
|
||||
module Parser.Db
|
||||
( db
|
||||
) where
|
||||
( db,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import Text.Parsec ((<|>), try)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
|
||||
import qualified Wasp.Db
|
||||
import qualified Parser.Common as P
|
||||
import Data.Maybe (fromMaybe, listToMaybe)
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec (try, (<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Db
|
||||
|
||||
db :: Parser Wasp.Db.Db
|
||||
db = do
|
||||
L.reserved L.reservedNameDb
|
||||
dbProperties <- P.waspClosure (L.commaSep1 dbProperty)
|
||||
|
||||
system <- fromMaybe (fail "'system' property is required!") $ return <$>
|
||||
listToMaybe [p | DbPropertySystem p <- dbProperties]
|
||||
system <-
|
||||
fromMaybe (fail "'system' property is required!") $
|
||||
return
|
||||
<$> listToMaybe [p | DbPropertySystem p <- dbProperties]
|
||||
|
||||
return Wasp.Db.Db
|
||||
return
|
||||
Wasp.Db.Db
|
||||
{ Wasp.Db._system = system
|
||||
}
|
||||
|
||||
@ -26,11 +29,12 @@ data DbProperty
|
||||
= DbPropertySystem Wasp.Db.DbSystem
|
||||
|
||||
dbProperty :: Parser DbProperty
|
||||
dbProperty
|
||||
= dbPropertySystem
|
||||
dbProperty =
|
||||
dbPropertySystem
|
||||
|
||||
dbPropertySystem :: Parser DbProperty
|
||||
dbPropertySystem = DbPropertySystem <$> (P.waspProperty "system" dbPropertySystemValue)
|
||||
where
|
||||
dbPropertySystemValue = try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
||||
dbPropertySystemValue =
|
||||
try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL)
|
||||
<|> try (L.symbol "SQLite" >> return Wasp.Db.SQLite)
|
||||
|
@ -1,12 +1,12 @@
|
||||
module Parser.Entity
|
||||
( entity
|
||||
) where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
( entity,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Psl.Ast.Model as PslModel
|
||||
import qualified Psl.Parser.Model
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Entity as Entity
|
||||
|
||||
entity :: Parser Entity.Entity
|
||||
@ -17,10 +17,11 @@ entity = do
|
||||
pslModelBody <- Psl.Parser.Model.body
|
||||
_ <- L.symbol "psl=}"
|
||||
|
||||
return Entity.Entity
|
||||
{ Entity._name = name
|
||||
, Entity._fields = getEntityFields pslModelBody
|
||||
, Entity._pslModelBody = pslModelBody
|
||||
return
|
||||
Entity.Entity
|
||||
{ Entity._name = name,
|
||||
Entity._fields = getEntityFields pslModelBody,
|
||||
Entity._pslModelBody = pslModelBody
|
||||
}
|
||||
|
||||
getEntityFields :: PslModel.Body -> [Entity.Field]
|
||||
@ -29,17 +30,19 @@ getEntityFields (PslModel.Body pslElements) = map pslFieldToEntityField pslField
|
||||
pslFields = [field | (PslModel.ElementField field) <- pslElements]
|
||||
|
||||
pslFieldToEntityField :: PslModel.Field -> Entity.Field
|
||||
pslFieldToEntityField pslField = Entity.Field
|
||||
{ Entity._fieldName = PslModel._name pslField
|
||||
, Entity._fieldType = pslFieldTypeToEntityFieldType
|
||||
pslFieldToEntityField pslField =
|
||||
Entity.Field
|
||||
{ Entity._fieldName = PslModel._name pslField,
|
||||
Entity._fieldType =
|
||||
pslFieldTypeToEntityFieldType
|
||||
(PslModel._type pslField)
|
||||
(PslModel._typeModifiers pslField)
|
||||
}
|
||||
|
||||
pslFieldTypeToEntityFieldType
|
||||
:: PslModel.FieldType
|
||||
-> [PslModel.FieldTypeModifier]
|
||||
-> Entity.FieldType
|
||||
pslFieldTypeToEntityFieldType ::
|
||||
PslModel.FieldType ->
|
||||
[PslModel.FieldTypeModifier] ->
|
||||
Entity.FieldType
|
||||
pslFieldTypeToEntityFieldType fType fTypeModifiers =
|
||||
let scalar = pslFieldTypeToScalar fType
|
||||
in case fTypeModifiers of
|
||||
|
@ -1,16 +1,15 @@
|
||||
module Parser.ExternalCode
|
||||
( extCodeFilePathString
|
||||
) where
|
||||
|
||||
import qualified Path.Posix as PPosix
|
||||
import Text.Parsec (unexpected)
|
||||
import Text.Parsec.String (Parser)
|
||||
( extCodeFilePathString,
|
||||
)
|
||||
where
|
||||
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import qualified Parser.Common
|
||||
import qualified Path.Posix as PPosix
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
import Text.Parsec (unexpected)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
-- Parses string literal that is file path to file in source external code dir.
|
||||
-- Returns file path relative to the external code dir.
|
||||
@ -18,6 +17,7 @@ import qualified StrongPath as SP
|
||||
extCodeFilePathString :: Parser (Path' Posix (Rel SourceExternalCodeDir) File)
|
||||
extCodeFilePathString = do
|
||||
path <- Parser.Common.relPosixFilePathString
|
||||
maybe (unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
||||
maybe
|
||||
(unexpected $ "string \"" ++ show path ++ "\": External code file path should start with \"@ext/\".")
|
||||
(return . SP.fromPathRelFileP)
|
||||
(PPosix.stripProperPrefix [PPosix.reldir|@ext|] path)
|
||||
|
@ -1,11 +1,11 @@
|
||||
module Parser.JsCode
|
||||
( jsCode
|
||||
) where
|
||||
( jsCode,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.JsCode as WJS
|
||||
|
||||
jsCode :: Parser WJS.JsCode
|
||||
|
@ -1,15 +1,14 @@
|
||||
module Parser.JsImport
|
||||
( jsImport
|
||||
) where
|
||||
( jsImport,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.ExternalCode
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Parser.ExternalCode
|
||||
import qualified Lexer as L
|
||||
import qualified Wasp.JsImport
|
||||
|
||||
|
||||
-- | Parses subset of JS import statement (only default or single named import, and only external code files):
|
||||
-- import <identifier> from "@ext/..."
|
||||
-- import { <identifier> } from "@ext/..."
|
||||
@ -18,14 +17,16 @@ jsImport = do
|
||||
L.whiteSpace
|
||||
_ <- L.reserved L.reservedNameImport
|
||||
-- For now we support only default import or one named import.
|
||||
(defaultImport, namedImports) <- ((\i -> (Just i, [])) <$> L.identifier)
|
||||
(defaultImport, namedImports) <-
|
||||
((\i -> (Just i, [])) <$> L.identifier)
|
||||
<|> ((\i -> (Nothing, [i])) <$> L.braces L.identifier)
|
||||
_ <- L.reserved L.reservedNameFrom
|
||||
-- TODO: For now we only support double quotes here, we should also support single quotes.
|
||||
-- We would need to write this from scratch, with single quote escaping enabled.
|
||||
from <- Parser.ExternalCode.extCodeFilePathString
|
||||
return Wasp.JsImport.JsImport
|
||||
{ Wasp.JsImport._defaultImport = defaultImport
|
||||
, Wasp.JsImport._namedImports = namedImports
|
||||
, Wasp.JsImport._from = from
|
||||
return
|
||||
Wasp.JsImport.JsImport
|
||||
{ Wasp.JsImport._defaultImport = defaultImport,
|
||||
Wasp.JsImport._namedImports = namedImports,
|
||||
Wasp.JsImport._from = from
|
||||
}
|
||||
|
@ -1,20 +1,19 @@
|
||||
module Parser.NpmDependencies
|
||||
( npmDependencies
|
||||
) where
|
||||
( npmDependencies,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.ByteString.Lazy.UTF8 as BLU
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import Text.Parsec (try)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified NpmDependency as ND
|
||||
import qualified Parser.Common as P
|
||||
import Text.Parsec (try)
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.NpmDependencies (NpmDependencies)
|
||||
import qualified Wasp.NpmDependencies as NpmDependencies
|
||||
|
||||
|
||||
npmDependencies :: Parser NpmDependencies
|
||||
npmDependencies = try $ do
|
||||
L.reserved L.reservedNameDependencies
|
||||
@ -23,7 +22,8 @@ npmDependencies = try $ do
|
||||
npmDeps <- case Aeson.eitherDecode' jsonBytestring :: Either String (M.HashMap String String) of
|
||||
Left errorMessage -> fail $ "Failed to parse dependencies JSON: " ++ errorMessage
|
||||
Right rawDeps -> return $ map rawDepToNpmDep (M.toList rawDeps)
|
||||
return NpmDependencies.NpmDependencies
|
||||
return
|
||||
NpmDependencies.NpmDependencies
|
||||
{ NpmDependencies._dependencies = npmDeps
|
||||
}
|
||||
where
|
||||
|
@ -1,29 +1,30 @@
|
||||
module Parser.Operation
|
||||
( jsFunctionPropParser
|
||||
, entitiesPropParser
|
||||
, getJsFunctionFromProps
|
||||
, getEntitiesFromProps
|
||||
, properties
|
||||
( jsFunctionPropParser,
|
||||
entitiesPropParser,
|
||||
getJsFunctionFromProps,
|
||||
getEntitiesFromProps,
|
||||
properties,
|
||||
-- FOR TESTS:
|
||||
, Property(..)
|
||||
) where
|
||||
Property (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.JsImport
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.JsImport
|
||||
|
||||
|
||||
data Property = JsFunction !Wasp.JsImport.JsImport
|
||||
data Property
|
||||
= JsFunction !Wasp.JsImport.JsImport
|
||||
| Entities ![String]
|
||||
deriving (Show, Eq)
|
||||
|
||||
properties :: Parser [Property]
|
||||
properties = L.commaSep1 $
|
||||
properties =
|
||||
L.commaSep1 $
|
||||
jsFunctionPropParser
|
||||
<|> entitiesPropParser
|
||||
|
||||
|
@ -1,17 +1,16 @@
|
||||
module Parser.Page
|
||||
( page
|
||||
) where
|
||||
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
|
||||
import qualified Wasp.Page as Page
|
||||
import Wasp.JsImport (JsImport)
|
||||
( page,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe, listToMaybe)
|
||||
import Lexer
|
||||
import Parser.Common
|
||||
import qualified Parser.JsImport
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.JsImport (JsImport)
|
||||
import qualified Wasp.Page as Page
|
||||
|
||||
data PageProperty
|
||||
= Title !String
|
||||
@ -21,7 +20,8 @@ data PageProperty
|
||||
|
||||
-- | Parses Page properties, separated by a comma.
|
||||
pageProperties :: Parser [PageProperty]
|
||||
pageProperties = commaSep1 $
|
||||
pageProperties =
|
||||
commaSep1 $
|
||||
pagePropertyTitle
|
||||
<|> pagePropertyComponent
|
||||
<|> pagePropertyAuthRequired
|
||||
@ -47,8 +47,9 @@ page :: Parser Page.Page
|
||||
page = do
|
||||
(pageName, pageProps) <- waspElementNameAndClosureContent reservedNamePage pageProperties
|
||||
|
||||
return Page.Page
|
||||
{ Page._name = pageName
|
||||
, Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps)
|
||||
, Page._authRequired = getPageAuthRequired pageProps
|
||||
return
|
||||
Page.Page
|
||||
{ Page._name = pageName,
|
||||
Page._component = fromMaybe (error "Page component is missing.") (getPageComponent pageProps),
|
||||
Page._authRequired = getPageAuthRequired pageProps
|
||||
}
|
||||
|
@ -1,23 +1,23 @@
|
||||
module Parser.Query
|
||||
( query
|
||||
) where
|
||||
( query,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Text.Parsec.String (Parser)
|
||||
|
||||
import qualified Lexer as L
|
||||
import qualified Parser.Common as C
|
||||
import qualified Parser.Operation as Operation
|
||||
import Text.Parsec.String (Parser)
|
||||
import Wasp.Query (Query)
|
||||
import qualified Wasp.Query as Query
|
||||
|
||||
|
||||
query :: Parser Query
|
||||
query = do
|
||||
(name, props) <- C.waspElementNameAndClosureContent L.reservedNameQuery Operation.properties
|
||||
return Query.Query
|
||||
{ Query._name = name
|
||||
, Query._jsFunction =
|
||||
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props)
|
||||
, Query._entities = Operation.getEntitiesFromProps props
|
||||
return
|
||||
Query.Query
|
||||
{ Query._name = name,
|
||||
Query._jsFunction =
|
||||
fromMaybe (error "Query js function is missing.") (Operation.getJsFunctionFromProps props),
|
||||
Query._entities = Operation.getEntitiesFromProps props
|
||||
}
|
||||
|
@ -1,10 +1,10 @@
|
||||
module Parser.Route
|
||||
( route
|
||||
) where
|
||||
|
||||
import Text.Parsec.String (Parser)
|
||||
( route,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Lexer as L
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Route as Route
|
||||
|
||||
-- | Top level parser, parses route Wasp element.
|
||||
@ -19,8 +19,8 @@ route = do
|
||||
L.reserved L.reservedNamePage
|
||||
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
|
||||
( style
|
||||
) where
|
||||
( style,
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Parser.Common
|
||||
import qualified Parser.ExternalCode
|
||||
import Text.Parsec ((<|>))
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Wasp.Style
|
||||
|
||||
|
||||
style :: Parser Wasp.Style.Style
|
||||
style = cssFile <|> cssCode
|
||||
|
||||
|
@ -1,11 +1,12 @@
|
||||
module Path.Extra
|
||||
( reversePosixPath
|
||||
, toPosixFilePath
|
||||
) where
|
||||
( reversePosixPath,
|
||||
toPosixFilePath,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (assert)
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import Path
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
|
||||
-- | For given posix path P, returns posix path P', such that (terminal pseudocode incoming)
|
||||
-- `pwd == (cd P && cd P' && pwd)`, or to put it differently, such that
|
||||
@ -15,7 +16,8 @@ import Path
|
||||
reversePosixPath :: FilePath -> FilePath
|
||||
reversePosixPath path
|
||||
| null parts = "."
|
||||
| otherwise = assert (".." `notElem` parts) $
|
||||
| otherwise =
|
||||
assert (".." `notElem` parts) $
|
||||
FPP.joinPath $ map (const "..") parts
|
||||
where
|
||||
parts :: [String]
|
||||
|
@ -1,7 +1,9 @@
|
||||
module Psl.Ast.Model where
|
||||
|
||||
data Model = Model
|
||||
String -- ^ Name of the model
|
||||
data Model
|
||||
= Model
|
||||
String
|
||||
-- ^ Name of the model
|
||||
Body
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -15,14 +17,15 @@ data Element = ElementField Field | ElementBlockAttribute Attribute
|
||||
-- we could just have `attrsBefore :: [[Attr]]`,
|
||||
-- which represents lines, each one with list of attributes.
|
||||
data Field = Field
|
||||
{ _name :: String
|
||||
, _type :: FieldType
|
||||
, _typeModifiers :: [FieldTypeModifier]
|
||||
, _attrs :: [Attribute]
|
||||
{ _name :: String,
|
||||
_type :: FieldType,
|
||||
_typeModifiers :: [FieldTypeModifier],
|
||||
_attrs :: [Attribute]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data FieldType = String
|
||||
data FieldType
|
||||
= String
|
||||
| Boolean
|
||||
| Int
|
||||
| BigInt
|
||||
@ -44,8 +47,8 @@ data FieldTypeModifier = List | Optional
|
||||
-- TODO: In the future, we might want to be "smarter" about this and actually have a special representation
|
||||
-- for them -> but let's see if that will be needed.
|
||||
data Attribute = Attribute
|
||||
{ _attrName :: String
|
||||
, _attrArgs :: [AttributeArg]
|
||||
{ _attrName :: String,
|
||||
_attrArgs :: [AttributeArg]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
@ -1,12 +1,11 @@
|
||||
module Psl.Generator.Model
|
||||
( generateModel
|
||||
) where
|
||||
( generateModel,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.List (intercalate)
|
||||
|
||||
import qualified Psl.Ast.Model as Ast
|
||||
|
||||
|
||||
generateModel :: Ast.Model -> String
|
||||
generateModel (Ast.Model name body) = "model " ++ name ++ " {\n" ++ generateBody body ++ "\n}"
|
||||
|
||||
@ -16,7 +15,8 @@ generateBody (Ast.Body elements) = unlines $ map ((" " ++) . generateElement) e
|
||||
generateElement :: Ast.Element -> String
|
||||
generateElement (Ast.ElementField field) =
|
||||
Ast._name field ++ " "
|
||||
++ generateFieldType (Ast._type field) ++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
||||
++ generateFieldType (Ast._type field)
|
||||
++ concatMap generateFieldTypeModifier (Ast._typeModifiers field)
|
||||
++ concatMap ((" " ++) . generateAttribute) (Ast._attrs field)
|
||||
generateElement (Ast.ElementBlockAttribute attribute) =
|
||||
"@" ++ generateAttribute attribute
|
||||
|
@ -1,20 +1,31 @@
|
||||
module Psl.Parser.Model
|
||||
( model
|
||||
, body
|
||||
( model,
|
||||
body,
|
||||
-- NOTE: Only for testing:
|
||||
, attrArgument
|
||||
) where
|
||||
attrArgument,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import Text.Parsec (alphaNum, char, choice, letter,
|
||||
lookAhead, many, many1, noneOf, oneOf,
|
||||
optionMaybe, try, (<|>))
|
||||
import qualified Psl.Ast.Model as Model
|
||||
import Text.Parsec
|
||||
( alphaNum,
|
||||
char,
|
||||
choice,
|
||||
letter,
|
||||
lookAhead,
|
||||
many,
|
||||
many1,
|
||||
noneOf,
|
||||
oneOf,
|
||||
optionMaybe,
|
||||
try,
|
||||
(<|>),
|
||||
)
|
||||
import Text.Parsec.Language (emptyDef)
|
||||
import Text.Parsec.String (Parser)
|
||||
import qualified Text.Parsec.Token as T
|
||||
|
||||
import qualified Psl.Ast.Model as Model
|
||||
|
||||
-- | Parses PSL (Prisma Schema Language model).
|
||||
-- Example of PSL model:
|
||||
-- model User {
|
||||
@ -38,8 +49,9 @@ body = do
|
||||
Model.Body <$> many1 element
|
||||
|
||||
element :: Parser Model.Element
|
||||
element = try (Model.ElementField <$> field) <|>
|
||||
try (Model.ElementBlockAttribute <$> blockAttribute)
|
||||
element =
|
||||
try (Model.ElementField <$> field)
|
||||
<|> try (Model.ElementBlockAttribute <$> blockAttribute)
|
||||
|
||||
field :: Parser Model.Field
|
||||
field = do
|
||||
@ -47,26 +59,28 @@ field = do
|
||||
type' <- fieldType
|
||||
maybeTypeModifier <- fieldTypeModifier
|
||||
attrs <- many (try attribute)
|
||||
return $ Model.Field
|
||||
{ Model._name = name
|
||||
, Model._type = type'
|
||||
, Model._typeModifiers = maybeToList maybeTypeModifier
|
||||
, Model._attrs = attrs
|
||||
return $
|
||||
Model.Field
|
||||
{ Model._name = name,
|
||||
Model._type = type',
|
||||
Model._typeModifiers = maybeToList maybeTypeModifier,
|
||||
Model._attrs = attrs
|
||||
}
|
||||
where
|
||||
fieldType :: Parser Model.FieldType
|
||||
fieldType =
|
||||
( foldl1 (<|>) $
|
||||
map (\(s, t) -> try (T.symbol lexer s) >> return t)
|
||||
[ ("String", Model.String)
|
||||
, ("Boolean", Model.Boolean)
|
||||
, ("Int", Model.Int)
|
||||
, ("BigInt", Model.BigInt)
|
||||
, ("Float", Model.Float)
|
||||
, ("Decimal", Model.Decimal)
|
||||
, ("DateTime", Model.DateTime)
|
||||
, ("Json", Model.Json)
|
||||
, ("Bytes", Model.Bytes)
|
||||
map
|
||||
(\(s, t) -> try (T.symbol lexer s) >> return t)
|
||||
[ ("String", Model.String),
|
||||
("Boolean", Model.Boolean),
|
||||
("Int", Model.Int),
|
||||
("BigInt", Model.BigInt),
|
||||
("Float", Model.Float),
|
||||
("Decimal", Model.Decimal),
|
||||
("DateTime", Model.DateTime),
|
||||
("Json", Model.Json),
|
||||
("Bytes", Model.Bytes)
|
||||
]
|
||||
)
|
||||
<|> (try $ Model.Unsupported <$> (T.symbol lexer "Unsupported" >> T.parens lexer (T.stringLiteral lexer)))
|
||||
@ -74,9 +88,10 @@ field = do
|
||||
|
||||
-- NOTE: As is Prisma currently implemented, there can be only one type modifier at one time: [] or ?.
|
||||
fieldTypeModifier :: Parser (Maybe Model.FieldTypeModifier)
|
||||
fieldTypeModifier = optionMaybe
|
||||
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List) <|>
|
||||
(try (T.symbol lexer "?") >> return Model.Optional)
|
||||
fieldTypeModifier =
|
||||
optionMaybe
|
||||
( (try (T.brackets lexer (T.whiteSpace lexer)) >> return Model.List)
|
||||
<|> (try (T.symbol lexer "?") >> return Model.Optional)
|
||||
)
|
||||
|
||||
attribute :: Parser Model.Attribute
|
||||
@ -95,11 +110,12 @@ attribute = do
|
||||
maybeSelector <- optionMaybe $ try $ char '.' >> T.identifier lexer
|
||||
|
||||
maybeArgs <- optionMaybe (T.parens lexer (T.commaSep1 lexer (try attrArgument)))
|
||||
return $ Model.Attribute
|
||||
return $
|
||||
Model.Attribute
|
||||
{ Model._attrName = case maybeSelector of
|
||||
Just selector -> name ++ "." ++ selector
|
||||
Nothing -> name
|
||||
, Model._attrArgs = fromMaybe [] maybeArgs
|
||||
Nothing -> name,
|
||||
Model._attrArgs = fromMaybe [] maybeArgs
|
||||
}
|
||||
|
||||
-- Parses attribute argument that ends with delimiter: , or ).
|
||||
@ -119,28 +135,33 @@ attrArgument = do
|
||||
unnamedArg = Model.AttrArgUnnamed <$> argValue
|
||||
|
||||
argValue :: Parser Model.AttrArgValue
|
||||
argValue = choice $ map (try . delimitedArgValue)
|
||||
[ argValueString
|
||||
, argValueFunc
|
||||
, argValueFieldReferenceList
|
||||
, argValueNumberFloat
|
||||
, argValueNumberInt
|
||||
, argValueIdentifier
|
||||
, argValueUnknown
|
||||
argValue =
|
||||
choice $
|
||||
map
|
||||
(try . delimitedArgValue)
|
||||
[ argValueString,
|
||||
argValueFunc,
|
||||
argValueFieldReferenceList,
|
||||
argValueNumberFloat,
|
||||
argValueNumberInt,
|
||||
argValueIdentifier,
|
||||
argValueUnknown
|
||||
]
|
||||
|
||||
argValueString :: Parser Model.AttrArgValue
|
||||
argValueString = Model.AttrArgString <$> T.stringLiteral lexer
|
||||
|
||||
argValueFunc :: Parser Model.AttrArgValue
|
||||
argValueFunc = do -- TODO: Could I implement this with applicative?
|
||||
argValueFunc = do
|
||||
-- TODO: Could I implement this with applicative?
|
||||
name <- T.identifier lexer
|
||||
T.parens lexer $ T.whiteSpace lexer
|
||||
return $ Model.AttrArgFunc name
|
||||
|
||||
argValueFieldReferenceList :: Parser Model.AttrArgValue
|
||||
argValueFieldReferenceList = Model.AttrArgFieldRefList <$>
|
||||
(T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
||||
argValueFieldReferenceList =
|
||||
Model.AttrArgFieldRefList
|
||||
<$> (T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer)
|
||||
|
||||
-- NOTE: For now we are not supporting negative numbers.
|
||||
-- I couldn't figure out from Prisma docs if there could be the case
|
||||
@ -157,10 +178,10 @@ attrArgument = do
|
||||
argValueIdentifier :: Parser Model.AttrArgValue
|
||||
argValueIdentifier = Model.AttrArgIdentifier <$> T.identifier lexer
|
||||
|
||||
-- | Our "wildcard" -> tries to capture anything.
|
||||
argValueUnknown :: Parser Model.AttrArgValue
|
||||
argValueUnknown = Model.AttrArgUnknown <$>
|
||||
(many1 $ try $ noneOf argDelimiters)
|
||||
argValueUnknown =
|
||||
Model.AttrArgUnknown
|
||||
<$> (many1 $ try $ noneOf argDelimiters)
|
||||
|
||||
delimitedArgValue :: Parser Model.AttrArgValue -> Parser Model.AttrArgValue
|
||||
delimitedArgValue argValueP = do
|
||||
@ -174,9 +195,11 @@ blockAttribute :: Parser Model.Attribute
|
||||
blockAttribute = char '@' >> attribute
|
||||
|
||||
lexer :: T.TokenParser ()
|
||||
lexer = T.makeTokenParser emptyDef
|
||||
{ T.commentLine = "//"
|
||||
, T.caseSensitive = True
|
||||
, T.identStart = letter
|
||||
, T.identLetter = alphaNum <|> char '_'
|
||||
lexer =
|
||||
T.makeTokenParser
|
||||
emptyDef
|
||||
{ T.commentLine = "//",
|
||||
T.caseSensitive = True,
|
||||
T.identStart = letter,
|
||||
T.identLetter = alphaNum <|> char '_'
|
||||
}
|
||||
|
@ -1,35 +1,75 @@
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
|
||||
module StrongPath
|
||||
( Path, Path'
|
||||
, Abs, Rel, Dir, File, File'
|
||||
, System, Windows, Posix
|
||||
|
||||
, parseRelDir, parseRelFile, parseAbsDir, parseAbsFile
|
||||
, parseRelDirW, parseRelFileW, parseAbsDirW, parseAbsFileW
|
||||
, parseRelDirP, parseRelFileP, parseAbsDirP, parseAbsFileP
|
||||
|
||||
, fromPathRelDir, fromPathRelFile, fromPathAbsDir, fromPathAbsFile
|
||||
, fromPathRelDirW, fromPathRelFileW, fromPathAbsDirW, fromPathAbsFileW
|
||||
, fromPathRelDirP, fromPathRelFileP, fromPathAbsDirP, fromPathAbsFileP
|
||||
|
||||
, toPathRelDir, toPathRelFile, toPathAbsDir, toPathAbsFile
|
||||
, toPathRelDirW, toPathRelFileW, toPathAbsDirW, toPathAbsFileW
|
||||
, toPathRelDirP, toPathRelFileP, toPathAbsDirP, toPathAbsFileP
|
||||
|
||||
, fromRelDir, fromRelFile, fromAbsDir, fromAbsFile
|
||||
, fromRelDirP, fromRelFileP, fromAbsDirP, fromAbsFileP
|
||||
, fromRelDirW, fromRelFileW, fromAbsDirW, fromAbsFileW
|
||||
|
||||
, toFilePath
|
||||
|
||||
, (</>)
|
||||
|
||||
, castRel, castDir
|
||||
|
||||
, parent
|
||||
|
||||
, relDirToPosix, relFileToPosix, relDirToPosix', relFileToPosix'
|
||||
) where
|
||||
( Path,
|
||||
Path',
|
||||
Abs,
|
||||
Rel,
|
||||
Dir,
|
||||
File,
|
||||
File',
|
||||
System,
|
||||
Windows,
|
||||
Posix,
|
||||
parseRelDir,
|
||||
parseRelFile,
|
||||
parseAbsDir,
|
||||
parseAbsFile,
|
||||
parseRelDirW,
|
||||
parseRelFileW,
|
||||
parseAbsDirW,
|
||||
parseAbsFileW,
|
||||
parseRelDirP,
|
||||
parseRelFileP,
|
||||
parseAbsDirP,
|
||||
parseAbsFileP,
|
||||
fromPathRelDir,
|
||||
fromPathRelFile,
|
||||
fromPathAbsDir,
|
||||
fromPathAbsFile,
|
||||
fromPathRelDirW,
|
||||
fromPathRelFileW,
|
||||
fromPathAbsDirW,
|
||||
fromPathAbsFileW,
|
||||
fromPathRelDirP,
|
||||
fromPathRelFileP,
|
||||
fromPathAbsDirP,
|
||||
fromPathAbsFileP,
|
||||
toPathRelDir,
|
||||
toPathRelFile,
|
||||
toPathAbsDir,
|
||||
toPathAbsFile,
|
||||
toPathRelDirW,
|
||||
toPathRelFileW,
|
||||
toPathAbsDirW,
|
||||
toPathAbsFileW,
|
||||
toPathRelDirP,
|
||||
toPathRelFileP,
|
||||
toPathAbsDirP,
|
||||
toPathAbsFileP,
|
||||
fromRelDir,
|
||||
fromRelFile,
|
||||
fromAbsDir,
|
||||
fromAbsFile,
|
||||
fromRelDirP,
|
||||
fromRelFileP,
|
||||
fromAbsDirP,
|
||||
fromAbsFileP,
|
||||
fromRelDirW,
|
||||
fromRelFileW,
|
||||
fromAbsDirW,
|
||||
fromAbsFileW,
|
||||
toFilePath,
|
||||
(</>),
|
||||
castRel,
|
||||
castDir,
|
||||
parent,
|
||||
relDirToPosix,
|
||||
relFileToPosix,
|
||||
relDirToPosix',
|
||||
relFileToPosix',
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Data.List (intercalate)
|
||||
@ -37,13 +77,11 @@ import Data.Maybe (fromJust)
|
||||
import qualified Path as P
|
||||
import qualified Path.Posix as PP
|
||||
import qualified Path.Windows as PW
|
||||
import StrongPath.Internal
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import qualified System.FilePath.Windows as FPW
|
||||
|
||||
import StrongPath.Internal
|
||||
|
||||
|
||||
-- TODO: We still depend on Path for creating hardcoded paths via generics. Any way to go around that?
|
||||
-- Maybe implement our own mechanism for that, so that people don't have to know about / use Path?
|
||||
-- This means we would implement our own [reldir|foobar|] stuff.
|
||||
@ -92,18 +130,29 @@ fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path' Posix Abs (Dir a)
|
||||
fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path' Posix Abs (File' f)
|
||||
---- System
|
||||
fromPathRelDir p = RelDir p NoPrefix
|
||||
|
||||
fromPathRelFile p = RelFile p NoPrefix
|
||||
|
||||
fromPathAbsDir = AbsDir
|
||||
|
||||
fromPathAbsFile = AbsFile
|
||||
|
||||
---- Windows
|
||||
fromPathRelDirW p = RelDirW p NoPrefix
|
||||
|
||||
fromPathRelFileW p = RelFileW p NoPrefix
|
||||
|
||||
fromPathAbsDirW = AbsDirW
|
||||
|
||||
fromPathAbsFileW = AbsFileW
|
||||
|
||||
---- Posix
|
||||
fromPathRelDirP p = RelDirP p NoPrefix
|
||||
|
||||
fromPathRelFileP p = RelFileP p NoPrefix
|
||||
|
||||
fromPathAbsDirP = AbsDirP
|
||||
|
||||
fromPathAbsFileP = AbsFileP
|
||||
|
||||
-- TODO: Should I go with MonadThrow here instead of just throwing error? Probably!
|
||||
@ -126,33 +175,44 @@ toPathAbsFileP :: Path' Posix Abs (File' f) -> PP.Path PP.Abs PP.File
|
||||
toPathRelDir (RelDir p NoPrefix) = p
|
||||
toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDir _ = impossible
|
||||
|
||||
toPathRelFile (RelFile p NoPrefix) = p
|
||||
toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFile _ = impossible
|
||||
|
||||
toPathAbsDir (AbsDir p) = p
|
||||
toPathAbsDir _ = impossible
|
||||
|
||||
toPathAbsFile (AbsFile p) = p
|
||||
toPathAbsFile _ = impossible
|
||||
|
||||
---- Windows
|
||||
toPathRelDirW (RelDirW p NoPrefix) = p
|
||||
toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirW _ = impossible
|
||||
|
||||
toPathRelFileW (RelFileW p NoPrefix) = p
|
||||
toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileW _ = impossible
|
||||
|
||||
toPathAbsDirW (AbsDirW p) = p
|
||||
toPathAbsDirW _ = impossible
|
||||
|
||||
toPathAbsFileW (AbsFileW p) = p
|
||||
toPathAbsFileW _ = impossible
|
||||
|
||||
---- Posix
|
||||
toPathRelDirP (RelDirP p NoPrefix) = p
|
||||
toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelDirP _ = impossible
|
||||
|
||||
toPathRelFileP (RelFileP p NoPrefix) = p
|
||||
toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError
|
||||
toPathRelFileP _ = impossible
|
||||
|
||||
toPathAbsDirP (AbsDirP p) = p
|
||||
toPathAbsDirP _ = impossible
|
||||
|
||||
toPathAbsFileP (AbsFileP p) = p
|
||||
toPathAbsFileP _ = impossible
|
||||
|
||||
@ -187,20 +247,30 @@ parseAbsDirP :: MonadThrow m => FilePath -> m (Path' Posix Abs (Dir d))
|
||||
parseAbsFileP :: MonadThrow m => FilePath -> m (Path' Posix Abs (File' f))
|
||||
---- System
|
||||
parseRelDir = parseRelFP RelDir [FP.pathSeparator, FPP.pathSeparator] P.parseRelDir
|
||||
|
||||
parseRelFile = parseRelFP RelFile [FP.pathSeparator, FPP.pathSeparator] P.parseRelFile
|
||||
|
||||
parseAbsDir fp = fromPathAbsDir <$> P.parseAbsDir fp
|
||||
|
||||
parseAbsFile fp = fromPathAbsFile <$> P.parseAbsFile fp
|
||||
|
||||
---- Windows
|
||||
parseRelDirW = parseRelFP RelDirW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelDir
|
||||
|
||||
parseRelFileW = parseRelFP RelFileW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelFile
|
||||
|
||||
parseAbsDirW fp = fromPathAbsDirW <$> PW.parseAbsDir fp
|
||||
|
||||
parseAbsFileW fp = fromPathAbsFileW <$> PW.parseAbsFile fp
|
||||
|
||||
---- Posix
|
||||
parseRelDirP = parseRelFP RelDirP [FPP.pathSeparator] PP.parseRelDir
|
||||
parseRelFileP = parseRelFP RelFileP [FPP.pathSeparator] PP.parseRelFile
|
||||
parseAbsDirP fp = fromPathAbsDirP <$> PP.parseAbsDir fp
|
||||
parseAbsFileP fp = fromPathAbsFileP <$> PP.parseAbsFile fp
|
||||
|
||||
parseRelFileP = parseRelFP RelFileP [FPP.pathSeparator] PP.parseRelFile
|
||||
|
||||
parseAbsDirP fp = fromPathAbsDirP <$> PP.parseAbsDir fp
|
||||
|
||||
parseAbsFileP fp = fromPathAbsFileP <$> PP.parseAbsFile fp
|
||||
|
||||
toFilePath :: Path' s b t -> FilePath
|
||||
toFilePath sp = case sp of
|
||||
@ -242,26 +312,37 @@ toFilePath sp = case sp of
|
||||
-- that you want to convert into FilePath.
|
||||
fromRelDir :: Path' System (Rel r) (Dir d) -> FilePath
|
||||
fromRelDir = toFilePath
|
||||
|
||||
fromRelFile :: Path' System (Rel r) (File' f) -> FilePath
|
||||
fromRelFile = toFilePath
|
||||
|
||||
fromAbsDir :: Path' System Abs (Dir d) -> FilePath
|
||||
fromAbsDir = toFilePath
|
||||
|
||||
fromAbsFile :: Path' System Abs (File' f) -> FilePath
|
||||
fromAbsFile = toFilePath
|
||||
|
||||
fromRelDirP :: Path' Posix (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirP = toFilePath
|
||||
|
||||
fromRelFileP :: Path' Posix (Rel r) (File' f) -> FilePath
|
||||
fromRelFileP = toFilePath
|
||||
|
||||
fromAbsDirP :: Path' Posix Abs (Dir d) -> FilePath
|
||||
fromAbsDirP = toFilePath
|
||||
|
||||
fromAbsFileP :: Path' Posix Abs (File' f) -> FilePath
|
||||
fromAbsFileP = toFilePath
|
||||
|
||||
fromRelDirW :: Path' Windows (Rel r) (Dir d) -> FilePath
|
||||
fromRelDirW = toFilePath
|
||||
|
||||
fromRelFileW :: Path' Windows (Rel r) (File' f) -> FilePath
|
||||
fromRelFileW = toFilePath
|
||||
|
||||
fromAbsDirW :: Path' Windows Abs (Dir d) -> FilePath
|
||||
fromAbsDirW = toFilePath
|
||||
|
||||
fromAbsFileW :: Path' Windows Abs (File' f) -> FilePath
|
||||
fromAbsFileW = toFilePath
|
||||
|
||||
@ -292,14 +373,15 @@ parent path = case path of
|
||||
-- get a parent, as per current Path implementation.
|
||||
relDirPathParent constructor pathParent p prefix =
|
||||
if pathParent p == p
|
||||
then let prefix' = case prefix of
|
||||
then
|
||||
let prefix' = case prefix of
|
||||
ParentDir n -> ParentDir (n + 1)
|
||||
NoPrefix -> ParentDir 1
|
||||
in constructor p prefix'
|
||||
else let p' = pathParent p
|
||||
else
|
||||
let p' = pathParent p
|
||||
in constructor p' prefix
|
||||
|
||||
|
||||
-- | How "../"s are resolved:
|
||||
-- For each "../" at the start of the right hand path, one most right entry is removed
|
||||
-- from the left hand path.
|
||||
@ -352,7 +434,6 @@ lsp@(AbsDirP _) </> (RelDirP rp rprefix) =
|
||||
in AbsDirP (lp' `pathPosixCombineAbsDirAndRelDir` rp)
|
||||
_ </> _ = impossible
|
||||
|
||||
|
||||
castRel :: Path' s (Rel d1) a -> Path' s (Rel d2) a
|
||||
---- System
|
||||
castRel (RelDir p pr) = RelDir p pr
|
||||
@ -381,6 +462,7 @@ castDir _ = impossible
|
||||
-- because Haskell did not believe me that I would be returning same "t" (Dir/File) in Path
|
||||
-- as was in first argument. I wonder if there is easy way to go around that or if
|
||||
-- we have to redo significant part of the StrongPath to be able to do smth like this.
|
||||
|
||||
-- | Converts relative path to posix by replacing current path separators with posix path separators.
|
||||
-- Works well for "normal" relative paths like "a\b\c" (Win) or "a/b/c" (Posix).
|
||||
-- If path is weird but still considered relative, like just "C:" on Win,
|
||||
@ -391,14 +473,17 @@ relDirToPosix sp@(RelDir _ _) = parseRelDirP $ FPP.joinPath $ FP.splitDirectori
|
||||
relDirToPosix sp@(RelDirW _ _) = parseRelDirP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||
relDirToPosix (RelDirP p pr) = return $ RelDirP p pr
|
||||
relDirToPosix _ = impossible
|
||||
|
||||
relFileToPosix :: MonadThrow m => Path' s (Rel d1) (File' f) -> m (Path' Posix (Rel d1) (File' f))
|
||||
relFileToPosix sp@(RelFile _ _) = parseRelFileP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp
|
||||
relFileToPosix sp@(RelFileW _ _) = parseRelFileP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp
|
||||
relFileToPosix (RelFileP p pr) = return $ RelFileP p pr
|
||||
relFileToPosix _ = impossible
|
||||
|
||||
-- TODO: Should I name these unsafe versions differently? Maybe relDirToPosixU?
|
||||
-- Unsafe versions:
|
||||
relDirToPosix' :: Path' s (Rel d1) (Dir d2) -> Path' Posix (Rel d1) (Dir d2)
|
||||
relDirToPosix' = fromJust . relDirToPosix
|
||||
|
||||
relFileToPosix' :: Path' s (Rel d1) (File' f) -> Path' Posix (Rel d1) (File' f)
|
||||
relFileToPosix' = fromJust . relFileToPosix
|
||||
|
@ -7,27 +7,28 @@ import qualified Path.Windows as PW
|
||||
import qualified System.FilePath.Posix as FPP
|
||||
import qualified System.FilePath.Windows as FPW
|
||||
|
||||
|
||||
-- | s -> standard, b -> base, t -> type
|
||||
data Path' s b t
|
||||
-- System
|
||||
= RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
||||
= -- System
|
||||
RelDir (P.Path P.Rel P.Dir) RelPathPrefix
|
||||
| RelFile (P.Path P.Rel P.File) RelPathPrefix
|
||||
| AbsDir (P.Path P.Abs P.Dir)
|
||||
| AbsFile (P.Path P.Abs P.File)
|
||||
-- Windows
|
||||
| RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
||||
| -- Windows
|
||||
RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix
|
||||
| RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix
|
||||
| AbsDirW (PW.Path PW.Abs PW.Dir)
|
||||
| AbsFileW (PW.Path PW.Abs PW.File)
|
||||
-- Posix
|
||||
| RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
||||
| -- Posix
|
||||
RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix
|
||||
| RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix
|
||||
| AbsDirP (PP.Path PP.Abs PP.Dir)
|
||||
| AbsFileP (PP.Path PP.Abs PP.File)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data RelPathPrefix = ParentDir Int -- ^ ../, Int saying how many times it repeats.
|
||||
data RelPathPrefix
|
||||
= -- | ../, Int saying how many times it repeats.
|
||||
ParentDir Int
|
||||
| NoPrefix
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -35,26 +36,30 @@ type Path = Path' System
|
||||
|
||||
-- | base
|
||||
data Abs
|
||||
|
||||
data Rel dir
|
||||
|
||||
-- | type
|
||||
data Dir dir
|
||||
|
||||
data File' file
|
||||
|
||||
type File = File' ()
|
||||
|
||||
-- | standard
|
||||
data System -- Depends on the platform, it is either Posix or Windows.
|
||||
|
||||
data Windows
|
||||
|
||||
data Posix
|
||||
|
||||
|
||||
parseRelFP :: MonadThrow m
|
||||
=> (P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t)
|
||||
-> [Char]
|
||||
-> (FilePath -> m (P.Path pb pt))
|
||||
-> FilePath
|
||||
-> m (Path' s (Rel d) t)
|
||||
parseRelFP ::
|
||||
MonadThrow m =>
|
||||
(P.Path pb pt -> RelPathPrefix -> Path' s (Rel d) t) ->
|
||||
[Char] ->
|
||||
(FilePath -> m (P.Path pb pt)) ->
|
||||
FilePath ->
|
||||
m (Path' s (Rel d) t)
|
||||
parseRelFP constructor validSeparators pathParser fp =
|
||||
let (prefix, fp') = extractRelPathPrefix validSeparators fp
|
||||
fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "".
|
||||
@ -76,7 +81,8 @@ extractRelPathPrefix validSeparators path =
|
||||
|
||||
dropParentDirs :: FilePath -> (Int, FilePath)
|
||||
dropParentDirs p
|
||||
| pathStartsWithParentDir p = let (n, p') = dropParentDirs (drop 3 p)
|
||||
| pathStartsWithParentDir p =
|
||||
let (n, p') = dropParentDirs (drop 3 p)
|
||||
in (1 + n, p')
|
||||
| p == ".." = (1, "")
|
||||
| otherwise = (0, p)
|
||||
@ -104,11 +110,13 @@ pathWinCombineRelDirAndRelFile :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Fil
|
||||
pathWinCombineRelDirAndRelFile lp rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| otherwise = lp PW.</> rp
|
||||
|
||||
pathWinCombineRelDirAndRelDir :: PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Rel PW.Dir
|
||||
pathWinCombineRelDirAndRelDir lp rp
|
||||
| PW.toFilePath lp == ['.', FPW.pathSeparator] = rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
| otherwise = lp PW.</> rp
|
||||
|
||||
pathWinCombineAbsDirAndRelDir :: PW.Path PW.Abs PW.Dir -> PW.Path PW.Rel PW.Dir -> PW.Path PW.Abs PW.Dir
|
||||
pathWinCombineAbsDirAndRelDir lp rp
|
||||
| PW.toFilePath rp == ['.', FPW.pathSeparator] = lp
|
||||
@ -119,11 +127,13 @@ pathPosixCombineRelDirAndRelFile :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.F
|
||||
pathPosixCombineRelDirAndRelFile lp rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| otherwise = lp PP.</> rp
|
||||
|
||||
pathPosixCombineRelDirAndRelDir :: PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Rel PP.Dir
|
||||
pathPosixCombineRelDirAndRelDir lp rp
|
||||
| PP.toFilePath lp == ['.', FPP.pathSeparator] = rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
| otherwise = lp PP.</> rp
|
||||
|
||||
pathPosixCombineAbsDirAndRelDir :: PP.Path PP.Abs PP.Dir -> PP.Path PP.Rel PP.Dir -> PP.Path PP.Abs PP.Dir
|
||||
pathPosixCombineAbsDirAndRelDir lp rp
|
||||
| PP.toFilePath rp == ['.', FPP.pathSeparator] = lp
|
||||
|
@ -1,24 +1,26 @@
|
||||
module Util
|
||||
( camelToKebabCase
|
||||
, onFirst
|
||||
, toLowerFirst
|
||||
, toUpperFirst
|
||||
, headSafe
|
||||
, jsonSet
|
||||
) where
|
||||
( camelToKebabCase,
|
||||
onFirst,
|
||||
toLowerFirst,
|
||||
toUpperFirst,
|
||||
headSafe,
|
||||
jsonSet,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char (isUpper, toLower, toUpper)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Text as Text
|
||||
import Data.Char (isUpper, toLower, toUpper)
|
||||
import qualified Data.HashMap.Strict as M
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
camelToKebabCase :: String -> String
|
||||
camelToKebabCase "" = ""
|
||||
camelToKebabCase camel@(camelHead : camelTail) = kebabHead : kebabTail
|
||||
where
|
||||
kebabHead = toLower camelHead
|
||||
kebabTail = concat $ map
|
||||
kebabTail =
|
||||
concat $
|
||||
map
|
||||
(\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b])
|
||||
(zip camel camelTail)
|
||||
isCamelHump (a, b) = (not . isUpper) a && isUpper b
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Util.Fib (
|
||||
fibonacci
|
||||
) where
|
||||
module Util.Fib
|
||||
( fibonacci,
|
||||
)
|
||||
where
|
||||
|
||||
fibonacci :: Int -> Int
|
||||
fibonacci 0 = 0
|
||||
|
@ -1,17 +1,18 @@
|
||||
module Util.IO
|
||||
( listDirectoryDeep
|
||||
, listDirectory
|
||||
) where
|
||||
( listDirectoryDeep,
|
||||
listDirectory,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (filterM)
|
||||
import qualified Path as P
|
||||
import qualified System.Directory as Dir
|
||||
import qualified System.FilePath as FilePath
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import UnliftIO.Exception (catch, throwIO)
|
||||
import Control.Monad (filterM)
|
||||
import qualified Path as P
|
||||
|
||||
|
||||
-- TODO: write tests.
|
||||
|
||||
-- | Lists all files in the directory recursively.
|
||||
-- All paths are relative to the directory we are listing.
|
||||
-- If directory does not exist, returns empty list.
|
||||
@ -23,19 +24,19 @@ import qualified Path as P
|
||||
-- >>> ["test.txt", "bar/text2.txt"]
|
||||
listDirectoryDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||
listDirectoryDeep absDirPath = do
|
||||
(relFilePaths, relSubDirPaths) <- listDirectory absDirPath
|
||||
(relFilePaths, relSubDirPaths) <-
|
||||
listDirectory absDirPath
|
||||
`catch` \e -> if isDoesNotExistError e then return ([], []) else throwIO e
|
||||
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath P.</>)) relSubDirPaths
|
||||
return $ relFilePaths ++ concat relSubDirFilesPaths
|
||||
where
|
||||
-- | NOTE: Here, returned paths are relative to the main dir whose sub dir we are listing,
|
||||
-- which is one level above what you might intuitively expect.
|
||||
listSubDirDeep :: P.Path P.Abs P.Dir -> IO [P.Path P.Rel P.File]
|
||||
listSubDirDeep subDirPath = do
|
||||
files <- listDirectoryDeep subDirPath
|
||||
return $ map (P.dirname subDirPath P.</>) files
|
||||
|
||||
-- TODO: write tests.
|
||||
|
||||
-- | Lists files and directories at top lvl of the directory.
|
||||
listDirectory :: P.Path P.Abs P.Dir -> IO ([P.Path P.Rel P.File], [P.Path P.Rel P.Dir])
|
||||
listDirectory absDirPath = do
|
||||
@ -48,9 +49,11 @@ listDirectory absDirPath = do
|
||||
fpAbsDirPath = P.toFilePath absDirPath
|
||||
|
||||
filterFiles :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.File]
|
||||
filterFiles absDir relItems = filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
||||
filterFiles absDir relItems =
|
||||
filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelFile
|
||||
|
||||
filterDirs :: FilePath -> [FilePath] -> IO [P.Path P.Rel P.Dir]
|
||||
filterDirs absDir relItems = filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
||||
filterDirs absDir relItems =
|
||||
filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
|
||||
>>= mapM P.parseRelDir
|
||||
|
@ -1,9 +1,11 @@
|
||||
module Util.Terminal
|
||||
( Style(..)
|
||||
, applyStyles
|
||||
) where
|
||||
( Style (..),
|
||||
applyStyles,
|
||||
)
|
||||
where
|
||||
|
||||
data Style = Black
|
||||
data Style
|
||||
= Black
|
||||
| Red
|
||||
| Green
|
||||
| Yellow
|
||||
@ -20,7 +22,8 @@ applyStyles :: [Style] -> String -> String
|
||||
applyStyles [] str = str
|
||||
applyStyles _ "" = ""
|
||||
applyStyles styles str = foldl applyStyle str styles ++ escapeCode ++ resetCode
|
||||
where applyStyle s style = escapeCode ++ styleCode style ++ s
|
||||
where
|
||||
applyStyle s style = escapeCode ++ styleCode style ++ s
|
||||
|
||||
styleCode :: Style -> String
|
||||
styleCode Black = "[30m"
|
||||
|
@ -1,52 +1,41 @@
|
||||
module Wasp
|
||||
( Wasp
|
||||
, WaspElement (..)
|
||||
, fromWaspElems
|
||||
|
||||
, module Wasp.JsImport
|
||||
, getJsImports
|
||||
, setJsImports
|
||||
|
||||
, module Wasp.App
|
||||
, fromApp
|
||||
, getApp
|
||||
, setApp
|
||||
|
||||
, getAuth
|
||||
, getPSLEntities
|
||||
|
||||
, getDb
|
||||
|
||||
, module Wasp.Page
|
||||
, getPages
|
||||
, addPage
|
||||
, getRoutes
|
||||
|
||||
, getQueries
|
||||
, addQuery
|
||||
, getQueryByName
|
||||
|
||||
, getActions
|
||||
, addAction
|
||||
, getActionByName
|
||||
|
||||
, setExternalCodeFiles
|
||||
, getExternalCodeFiles
|
||||
|
||||
, setDotEnvFile
|
||||
, getDotEnvFile
|
||||
|
||||
, setIsBuild
|
||||
, getIsBuild
|
||||
|
||||
, setNpmDependencies
|
||||
, getNpmDependencies
|
||||
) where
|
||||
( Wasp,
|
||||
WaspElement (..),
|
||||
fromWaspElems,
|
||||
module Wasp.JsImport,
|
||||
getJsImports,
|
||||
setJsImports,
|
||||
module Wasp.App,
|
||||
fromApp,
|
||||
getApp,
|
||||
setApp,
|
||||
getAuth,
|
||||
getPSLEntities,
|
||||
getDb,
|
||||
module Wasp.Page,
|
||||
getPages,
|
||||
addPage,
|
||||
getRoutes,
|
||||
getQueries,
|
||||
addQuery,
|
||||
getQueryByName,
|
||||
getActions,
|
||||
addAction,
|
||||
getActionByName,
|
||||
setExternalCodeFiles,
|
||||
getExternalCodeFiles,
|
||||
setDotEnvFile,
|
||||
getDotEnvFile,
|
||||
setIsBuild,
|
||||
getIsBuild,
|
||||
setNpmDependencies,
|
||||
getNpmDependencies,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import StrongPath (Path, Abs, File)
|
||||
|
||||
import qualified ExternalCode
|
||||
import StrongPath (Abs, File, Path)
|
||||
import qualified Util as U
|
||||
import qualified Wasp.Action
|
||||
import Wasp.App
|
||||
@ -60,16 +49,16 @@ import Wasp.Page
|
||||
import qualified Wasp.Query
|
||||
import Wasp.Route
|
||||
|
||||
|
||||
-- * Wasp
|
||||
|
||||
data Wasp = Wasp
|
||||
{ waspElements :: [WaspElement]
|
||||
, waspJsImports :: [JsImport]
|
||||
, externalCodeFiles :: [ExternalCode.File]
|
||||
, dotEnvFile :: Maybe (Path Abs File)
|
||||
, isBuild :: Bool
|
||||
} deriving (Show, Eq)
|
||||
{ waspElements :: [WaspElement],
|
||||
waspJsImports :: [JsImport],
|
||||
externalCodeFiles :: [ExternalCode.File],
|
||||
dotEnvFile :: Maybe (Path Abs File),
|
||||
isBuild :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data WaspElement
|
||||
= WaspElementApp !App
|
||||
@ -84,12 +73,13 @@ data WaspElement
|
||||
deriving (Show, Eq)
|
||||
|
||||
fromWaspElems :: [WaspElement] -> Wasp
|
||||
fromWaspElems elems = Wasp
|
||||
{ waspElements = elems
|
||||
, waspJsImports = []
|
||||
, externalCodeFiles = []
|
||||
, dotEnvFile = Nothing
|
||||
, isBuild = False
|
||||
fromWaspElems elems =
|
||||
Wasp
|
||||
{ waspElements = elems,
|
||||
waspJsImports = [],
|
||||
externalCodeFiles = [],
|
||||
dotEnvFile = Nothing,
|
||||
isBuild = False
|
||||
}
|
||||
|
||||
-- * Build
|
||||
@ -127,8 +117,9 @@ setJsImports wasp jsImports = wasp { waspJsImports = jsImports }
|
||||
-- * App
|
||||
|
||||
getApp :: Wasp -> App
|
||||
getApp wasp = let apps = getApps wasp in
|
||||
if (length apps /= 1)
|
||||
getApp wasp =
|
||||
let apps = getApps wasp
|
||||
in if (length apps /= 1)
|
||||
then error "Wasp has to contain exactly one WaspElementApp element!"
|
||||
else head apps
|
||||
|
||||
@ -148,8 +139,9 @@ fromApp app = fromWaspElems [WaspElementApp app]
|
||||
-- * Auth
|
||||
|
||||
getAuth :: Wasp -> Maybe Wasp.Auth.Auth
|
||||
getAuth wasp = let auths = [a | WaspElementAuth a <- waspElements wasp] in
|
||||
case auths of
|
||||
getAuth wasp =
|
||||
let auths = [a | WaspElementAuth a <- waspElements wasp]
|
||||
in case auths of
|
||||
[] -> Nothing
|
||||
[a] -> Just a
|
||||
_ -> error "Wasp can't contain more than one WaspElementAuth element!"
|
||||
@ -157,8 +149,9 @@ getAuth wasp = let auths = [a | WaspElementAuth a <- waspElements wasp] in
|
||||
-- * Db
|
||||
|
||||
getDb :: Wasp -> Maybe Wasp.Db.Db
|
||||
getDb wasp = let dbs = [db | WaspElementDb db <- waspElements wasp] in
|
||||
case dbs of
|
||||
getDb wasp =
|
||||
let dbs = [db | WaspElementDb db <- waspElements wasp]
|
||||
in case dbs of
|
||||
[] -> Nothing
|
||||
[db] -> Just db
|
||||
_ -> error "Wasp can't contain more than one Db element!"
|
||||
@ -166,8 +159,8 @@ getDb wasp = let dbs = [db | WaspElementDb db <- waspElements wasp] in
|
||||
-- * NpmDependencies
|
||||
|
||||
getNpmDependencies :: Wasp -> NpmDependencies
|
||||
getNpmDependencies wasp
|
||||
= let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
||||
getNpmDependencies wasp =
|
||||
let depses = [d | (WaspElementNpmDependencies d) <- waspElements wasp]
|
||||
in case depses of
|
||||
[] -> Wasp.NpmDependencies.empty
|
||||
[deps] -> deps
|
||||
@ -178,7 +171,8 @@ isNpmDependenciesElem WaspElementNpmDependencies{} = True
|
||||
isNpmDependenciesElem _ = False
|
||||
|
||||
setNpmDependencies :: Wasp -> NpmDependencies -> Wasp
|
||||
setNpmDependencies wasp deps = wasp
|
||||
setNpmDependencies wasp deps =
|
||||
wasp
|
||||
{ waspElements = WaspElementNpmDependencies deps : filter (not . isNpmDependenciesElem) (waspElements wasp)
|
||||
}
|
||||
|
||||
@ -226,13 +220,13 @@ getActionByName wasp name = U.headSafe $ filter (\a -> Wasp.Action._name a == na
|
||||
getPSLEntities :: Wasp -> [Wasp.Entity.Entity]
|
||||
getPSLEntities wasp = [entity | (WaspElementEntity entity) <- (waspElements wasp)]
|
||||
|
||||
|
||||
-- * ToJSON instances.
|
||||
|
||||
instance ToJSON Wasp where
|
||||
toJSON wasp = object
|
||||
[ "app" .= getApp wasp
|
||||
, "pages" .= getPages wasp
|
||||
, "routes" .= getRoutes wasp
|
||||
, "jsImports" .= getJsImports wasp
|
||||
toJSON wasp =
|
||||
object
|
||||
[ "app" .= getApp wasp,
|
||||
"pages" .= getPages wasp,
|
||||
"routes" .= getRoutes wasp,
|
||||
"jsImports" .= getJsImports wasp
|
||||
]
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Wasp.Action
|
||||
( Action(..)
|
||||
) where
|
||||
( Action (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Wasp.JsImport (JsImport)
|
||||
@ -8,14 +9,16 @@ import Wasp.JsImport (JsImport)
|
||||
-- TODO: Very similar to Wasp.Query, consider extracting duplication.
|
||||
|
||||
data Action = Action
|
||||
{ _name :: !String
|
||||
, _jsFunction :: !JsImport
|
||||
, _entities :: !(Maybe [String])
|
||||
} deriving (Show, Eq)
|
||||
{ _name :: !String,
|
||||
_jsFunction :: !JsImport,
|
||||
_entities :: !(Maybe [String])
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Action where
|
||||
toJSON action = object
|
||||
[ "name" .= _name action
|
||||
, "jsFunction" .= _jsFunction action
|
||||
, "entities" .= _entities action
|
||||
toJSON action =
|
||||
object
|
||||
[ "name" .= _name action,
|
||||
"jsFunction" .= _jsFunction action,
|
||||
"entities" .= _entities action
|
||||
]
|
||||
|
@ -1,18 +1,20 @@
|
||||
module Wasp.App
|
||||
( App(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson ((.=), object, ToJSON(..))
|
||||
( App (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
data App = App
|
||||
{ appName :: !String -- Identifier
|
||||
, appTitle :: !String
|
||||
, appHead :: !(Maybe [String])
|
||||
} deriving (Show, Eq)
|
||||
{ appName :: !String, -- Identifier
|
||||
appTitle :: !String,
|
||||
appHead :: !(Maybe [String])
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON App where
|
||||
toJSON app = object
|
||||
[ "name" .= appName app
|
||||
, "title" .= appTitle app
|
||||
toJSON app =
|
||||
object
|
||||
[ "name" .= appName app,
|
||||
"title" .= appTitle app
|
||||
]
|
||||
|
@ -1,13 +1,15 @@
|
||||
module Wasp.Auth
|
||||
( Auth (..)
|
||||
, AuthMethod (..)
|
||||
) where
|
||||
( Auth (..),
|
||||
AuthMethod (..),
|
||||
)
|
||||
where
|
||||
|
||||
data Auth = Auth
|
||||
{ _userEntity :: !String
|
||||
, _methods :: [AuthMethod]
|
||||
, _onAuthFailedRedirectTo :: !String
|
||||
} deriving (Show, Eq)
|
||||
{ _userEntity :: !String,
|
||||
_methods :: [AuthMethod],
|
||||
_onAuthFailedRedirectTo :: !String
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AuthMethod
|
||||
= EmailAndPassword
|
||||
|
@ -1,11 +1,13 @@
|
||||
module Wasp.Db
|
||||
( Db (..)
|
||||
, DbSystem (..)
|
||||
) where
|
||||
( Db (..),
|
||||
DbSystem (..),
|
||||
)
|
||||
where
|
||||
|
||||
data Db = Db
|
||||
{ _system :: !DbSystem
|
||||
} deriving (Show, Eq)
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data DbSystem
|
||||
= PostgreSQL
|
||||
|
@ -1,26 +1,25 @@
|
||||
module Wasp.Entity
|
||||
( Entity (..)
|
||||
, Field (..)
|
||||
, FieldType (..)
|
||||
, Scalar (..)
|
||||
, Composite (..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON(..), (.=), object)
|
||||
( Entity (..),
|
||||
Field (..),
|
||||
FieldType (..),
|
||||
Scalar (..),
|
||||
Composite (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import qualified Psl.Ast.Model
|
||||
|
||||
|
||||
data Entity = Entity
|
||||
{ _name :: !String
|
||||
, _fields :: ![Field]
|
||||
, _pslModelBody :: !Psl.Ast.Model.Body
|
||||
{ _name :: !String,
|
||||
_fields :: ![Field],
|
||||
_pslModelBody :: !Psl.Ast.Model.Body
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Field = Field
|
||||
{ _fieldName :: !String
|
||||
, _fieldType :: !FieldType
|
||||
{ _fieldName :: !String,
|
||||
_fieldType :: !FieldType
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -40,16 +39,17 @@ data Scalar
|
||||
| DateTime
|
||||
| Json
|
||||
| Bytes
|
||||
-- | Name of the user-defined type.
|
||||
| -- | Name of the user-defined type.
|
||||
-- This could be another entity, or maybe an enum,
|
||||
-- we don't know here yet.
|
||||
| UserType String
|
||||
UserType String
|
||||
| Unsupported String
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Entity where
|
||||
toJSON entity = object
|
||||
[ "name" .= _name entity
|
||||
, "fields" .= show (_fields entity)
|
||||
, "pslModelBody" .= show (_pslModelBody entity)
|
||||
toJSON entity =
|
||||
object
|
||||
[ "name" .= _name entity,
|
||||
"fields" .= show (_fields entity),
|
||||
"pslModelBody" .= show (_pslModelBody entity)
|
||||
]
|
||||
|
@ -1,6 +1,7 @@
|
||||
module Wasp.JsCode
|
||||
( JsCode(..)
|
||||
) where
|
||||
( JsCode (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..))
|
||||
import Data.Text (Text)
|
||||
|
@ -1,24 +1,25 @@
|
||||
module Wasp.JsImport
|
||||
( JsImport(..)
|
||||
) where
|
||||
( JsImport (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
|
||||
import ExternalCode (SourceExternalCodeDir)
|
||||
import StrongPath (File, Path', Posix, Rel)
|
||||
import qualified StrongPath as SP
|
||||
|
||||
|
||||
-- | Represents javascript import -> "import <what> from <from>".
|
||||
data JsImport = JsImport
|
||||
{ _defaultImport :: !(Maybe String)
|
||||
, _namedImports :: ![String]
|
||||
, _from :: Path' Posix (Rel SourceExternalCodeDir) File
|
||||
} deriving (Show, Eq)
|
||||
{ _defaultImport :: !(Maybe String),
|
||||
_namedImports :: ![String],
|
||||
_from :: Path' Posix (Rel SourceExternalCodeDir) File
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON JsImport where
|
||||
toJSON jsImport = object
|
||||
[ "defaultImport" .= _defaultImport jsImport
|
||||
, "namedImports" .= _namedImports jsImport
|
||||
, "from" .= SP.toFilePath (_from jsImport)
|
||||
toJSON jsImport =
|
||||
object
|
||||
[ "defaultImport" .= _defaultImport jsImport,
|
||||
"namedImports" .= _namedImports jsImport,
|
||||
"from" .= SP.toFilePath (_from jsImport)
|
||||
]
|
||||
|
@ -1,20 +1,22 @@
|
||||
module Wasp.NpmDependencies
|
||||
( NpmDependencies(..)
|
||||
, empty
|
||||
) where
|
||||
( NpmDependencies (..),
|
||||
empty,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import NpmDependency
|
||||
|
||||
|
||||
data NpmDependencies = NpmDependencies
|
||||
{ _dependencies :: ![NpmDependency]
|
||||
} deriving (Show, Eq)
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
empty :: NpmDependencies
|
||||
empty = NpmDependencies {_dependencies = []}
|
||||
|
||||
instance ToJSON NpmDependencies where
|
||||
toJSON deps = object
|
||||
toJSON deps =
|
||||
object
|
||||
[ "dependencies" .= _dependencies deps
|
||||
]
|
||||
|
@ -1,20 +1,22 @@
|
||||
module Wasp.Operation
|
||||
( Operation(..)
|
||||
, getName
|
||||
, getJsFn
|
||||
, getEntities
|
||||
) where
|
||||
( Operation (..),
|
||||
getName,
|
||||
getJsFn,
|
||||
getEntities,
|
||||
)
|
||||
where
|
||||
|
||||
-- TODO: Is this ok approach, should I instead use typeclass?
|
||||
-- So far, all usages in the codebase could be easily replaced with the Typeclass.
|
||||
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
import Wasp.JsImport (JsImport)
|
||||
import Wasp.Query (Query)
|
||||
import qualified Wasp.Query as Query
|
||||
import Wasp.Action (Action)
|
||||
import qualified Wasp.Action as Action
|
||||
|
||||
data Operation = QueryOp Query
|
||||
data Operation
|
||||
= QueryOp Query
|
||||
| ActionOp Action
|
||||
|
||||
getName :: Operation -> String
|
||||
|
@ -1,19 +1,21 @@
|
||||
module Wasp.Page
|
||||
( Page(..)
|
||||
) where
|
||||
( Page (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson ((.=), object, ToJSON(..))
|
||||
import Data.Aeson (ToJSON (..), object, (.=))
|
||||
import Wasp.JsImport (JsImport)
|
||||
|
||||
|
||||
data Page = Page
|
||||
{ _name :: !String
|
||||
, _component :: !JsImport
|
||||
, _authRequired :: Maybe Bool
|
||||
} deriving (Show, Eq)
|
||||
{ _name :: !String,
|
||||
_component :: !JsImport,
|
||||
_authRequired :: Maybe Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON Page where
|
||||
toJSON page = object
|
||||
[ "name" .= _name page
|
||||
, "component" .= _component page
|
||||
toJSON page =
|
||||
object
|
||||
[ "name" .= _name page,
|
||||
"component" .= _component page
|
||||
]
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user