diff --git a/waspc/.gitignore b/waspc/.gitignore index bc637019de..f5ca4776d0 100644 --- a/waspc/.gitignore +++ b/waspc/.gitignore @@ -12,3 +12,5 @@ waspc.cabal .hie/ .bin/ stan.html + +*.orig \ No newline at end of file diff --git a/waspc/.hlint.yaml b/waspc/.hlint.yaml index 1f8a2b3044..fb3b35f943 100644 --- a/waspc/.hlint.yaml +++ b/waspc/.hlint.yaml @@ -1,14 +1,3 @@ -# HLint configuration file -# https://github.com/ndmitchell/hlint -########################## - -# This file contains a template configuration file, which is typically -# placed as .hlint.yaml in the root of your project - - -# Specify additional command line arguments -# -# - arguments: [--color, --cpp-simple, -XQuasiQuotes] - arguments: # NOTE: List of extensions below should reflect the list # of default extensions from package.yaml. @@ -17,46 +6,11 @@ - -XQuasiQuotes - -XScopedTypeVariables -# Control which extensions/flags/modules/functions can be used -# -# - extensions: -# - default: false # all extension are banned by default -# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used -# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module -# -# - flags: -# - {name: -w, within: []} # -w is allowed nowhere -# -# - modules: -# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' -# - {name: Control.Arrow, within: []} # Certain modules are banned entirely -# -# - functions: -# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules - - -# Add custom hints for this project -# -# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar" -# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x} - - -# Turn on hints that are off by default -# -# Ban "module X(module X) where", to require a real export list -# - warn: {name: Use explicit module export list} -# -# Replace a $ b $ c with a . b $ c -# - group: {name: dollar, enabled: true} -# -# Generalise map to fmap, ++ to <> -# - group: {name: generalise, enabled: true} - - -# Ignore some builtin hints -# - ignore: {name: Use let} -# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules - - -# Define some custom infix operators -# - fixity: infixr 3 ~^#^~ +# TODO: Review the remaining ignored hlint rules. +- ignore: {name: Use camelCase} +- ignore: {name: Eta reduce} +- ignore: {name: Use first} +- ignore: {name: Use second} +- ignore: {name: Use newtype instead of data} +- ignore: {name: Use $>} +- ignore: {name: Use list comprehension} \ No newline at end of file diff --git a/waspc/cli/Main.hs b/waspc/cli/Main.hs index ab1db0fa74..040fefc18c 100644 --- a/waspc/cli/Main.hs +++ b/waspc/cli/Main.hs @@ -55,9 +55,9 @@ main = do Command.Call.Telemetry -> runCommand Telemetry.telemetry Command.Call.Deps -> runCommand deps Command.Call.Info -> runCommand info - Command.Call.PrintBashCompletionInstruction -> runCommand $ printBashCompletionInstruction - Command.Call.GenerateBashCompletionScript -> runCommand $ generateBashCompletionScript - Command.Call.BashCompletionListCommands -> runCommand $ bashCompletion + Command.Call.PrintBashCompletionInstruction -> runCommand printBashCompletionInstruction + Command.Call.GenerateBashCompletionScript -> runCommand generateBashCompletionScript + Command.Call.BashCompletionListCommands -> runCommand bashCompletion Command.Call.Unknown _ -> printUsage -- If sending of telemetry data is still not done 1 second since commmand finished, abort it. diff --git a/waspc/cli/Wasp/Cli/Command/Common.hs b/waspc/cli/Wasp/Cli/Command/Common.hs index 21065a47d4..09fddcd3a4 100644 --- a/waspc/cli/Wasp/Cli/Command/Common.hs +++ b/waspc/cli/Wasp/Cli/Command/Common.hs @@ -55,6 +55,5 @@ waspSaysC = liftIO . waspSays alphaWarningMessage :: String alphaWarningMessage = - ( "NOTE: Wasp is still in Alpha, therefore not yet production ready " - ++ "and might change significantly in the future versions." - ) + "NOTE: Wasp is still in Alpha, therefore not yet production ready " + ++ "and might change significantly in the future versions." diff --git a/waspc/cli/Wasp/Cli/Command/Db/Migrate.hs b/waspc/cli/Wasp/Cli/Command/Db/Migrate.hs index 31f39df3e9..7d89ce70e2 100644 --- a/waspc/cli/Wasp/Cli/Command/Db/Migrate.hs +++ b/waspc/cli/Wasp/Cli/Command/Db/Migrate.hs @@ -97,12 +97,7 @@ copyDbMigrationsDir copyDirection waspProjectDir genProjectRootDir = do doesSrcDirExist <- PathIO.doesDirExist (SP.Path.toPathAbsDir src) if doesSrcDirExist then - ( ( PathIO.copyDirRecur - (SP.Path.toPathAbsDir src) - (SP.Path.toPathAbsDir target) - ) - >> return Nothing - ) + PathIO.copyDirRecur (SP.Path.toPathAbsDir src) (SP.Path.toPathAbsDir target) >> return Nothing `catch` (\e -> return $ Just $ show (e :: P.PathException)) `catch` (\e -> return $ Just $ show (e :: IOError)) else return Nothing diff --git a/waspc/cli/Wasp/Cli/Command/Watch.hs b/waspc/cli/Wasp/Cli/Command/Watch.hs index 45cbd763ba..df29d8e80a 100644 --- a/waspc/cli/Wasp/Cli/Command/Watch.hs +++ b/waspc/cli/Wasp/Cli/Command/Watch.hs @@ -66,8 +66,8 @@ watch waspProjectDir outDir = FSN.withManager $ \mgr -> do eventFilter event = let filename = FP.takeFileName $ FSN.eventPath event in not (null filename) - && not (take 2 filename == ".#") -- Ignore emacs lock files. + && take 2 filename /= ".#" -- Ignore emacs lock files. && not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files. - && not (last filename == '~') -- Ignore emacs and vim backup files. + && last filename /= '~' -- Ignore emacs and vim backup files. && not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files. && not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files. diff --git a/waspc/src/Wasp/Analyzer/Evaluator/TH/Decl.hs b/waspc/src/Wasp/Analyzer/Evaluator/TH/Decl.hs index 2abbba3a15..d1b8e97693 100644 --- a/waspc/src/Wasp/Analyzer/Evaluator/TH/Decl.hs +++ b/waspc/src/Wasp/Analyzer/Evaluator/TH/Decl.hs @@ -144,7 +144,7 @@ genDictEntryTypesAndEvaluationForRecord :: Name -> [(Name, Type)] -> Q (ExpQ, Ex genDictEntryTypesAndEvaluationForRecord dataConstructorName fields = go $ reverse fields -- Reversing enables us to apply evaluations in right order. where - go [] = pure (listE [], varE 'pure `appE` conE dataConstructorName) + go [] = pure (listE [], [|pure|] `appE` conE dataConstructorName) go ((fieldName, fieldType) : restOfFields) = do (restDictType, restEvaluation) <- go restOfFields let thisDictTypeE = diff --git a/waspc/src/Wasp/Analyzer/TypeChecker/Monad.hs b/waspc/src/Wasp/Analyzer/TypeChecker/Monad.hs index 07592a4770..3634dc239d 100644 --- a/waspc/src/Wasp/Analyzer/TypeChecker/Monad.hs +++ b/waspc/src/Wasp/Analyzer/TypeChecker/Monad.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TupleSections #-} - module Wasp.Analyzer.TypeChecker.Monad ( TypeChecker, lookupType, diff --git a/waspc/src/Wasp/Generator/DbGenerator.hs b/waspc/src/Wasp/Generator/DbGenerator.hs index 18ac862e40..da76e6342c 100644 --- a/waspc/src/Wasp/Generator/DbGenerator.hs +++ b/waspc/src/Wasp/Generator/DbGenerator.hs @@ -6,7 +6,6 @@ module Wasp.Generator.DbGenerator where import Data.Aeson (object, (.=)) -import Data.Maybe (fromMaybe) import StrongPath (Dir, File', Path', Rel, reldir, relfile, ()) import qualified StrongPath as SP import Wasp.CompileOptions (CompileOptions) @@ -64,7 +63,7 @@ genPrismaSchema wasp = createTemplateFileDraft dstPath tmplSrcPath (Just templat "datasourceUrl" .= (datasourceUrl :: String) ] - dbSystem = fromMaybe Wasp.Db.SQLite $ Wasp.Db._system <$> Wasp.getDb wasp + dbSystem = maybe 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`. diff --git a/waspc/src/Wasp/Generator/DockerGenerator.hs b/waspc/src/Wasp/Generator/DockerGenerator.hs index 11c9605de7..47b429b49d 100644 --- a/waspc/src/Wasp/Generator/DockerGenerator.hs +++ b/waspc/src/Wasp/Generator/DockerGenerator.hs @@ -13,11 +13,7 @@ import Wasp.Wasp (Wasp) import qualified Wasp.Wasp as Wasp genDockerFiles :: Wasp -> CompileOptions -> [FileDraft] -genDockerFiles wasp _ = - concat - [ [genDockerfile wasp], - [genDockerignore wasp] - ] +genDockerFiles wasp _ = genDockerfile wasp : [genDockerignore wasp] -- TODO: Inject paths to server and db files/dirs, right now they are hardcoded in the templates. genDockerfile :: Wasp -> FileDraft diff --git a/waspc/src/Wasp/Generator/ServerGenerator.hs b/waspc/src/Wasp/Generator/ServerGenerator.hs index ffdf42b8a3..da0cc870dc 100644 --- a/waspc/src/Wasp/Generator/ServerGenerator.hs +++ b/waspc/src/Wasp/Generator/ServerGenerator.hs @@ -7,7 +7,7 @@ module Wasp.Generator.ServerGenerator ) where -import Control.Monad (when) +import Control.Monad (unless) import Data.Aeson (object, (.=)) import Data.List (intercalate) import Data.Maybe @@ -72,7 +72,7 @@ preCleanup _ outDir _ = do -- If .env gets removed but there is old .env file in generated project from previous attempts, -- we need to make sure we remove it. removeFile dotEnvAbsFilePath - `catch` \e -> when (not $ isDoesNotExistError e) $ throwIO e + `catch` \e -> unless (isDoesNotExistError e) $ throwIO e where dotEnvAbsFilePath = SP.toFilePath $ outDir C.serverRootDirInProjectRootDir dotEnvInServerRootDir @@ -104,10 +104,11 @@ genPackageJson wasp waspDeps waspDevDeps = "devDepsChunk" .= npmDevDepsToPackageJsonEntry waspDevDeps, "nodeVersion" .= nodeVersionAsText, "startProductionScript" - .= concat - [ if not (null $ Wasp.getPSLEntities wasp) then "npm run db-migrate-prod && " else "", - "NODE_ENV=production node ./src/server.js" - ] + .= if not (null $ Wasp.getPSLEntities wasp) + then "npm run db-migrate-prod && " + else + "" + ++ "NODE_ENV=production node ./src/server.js" ] ) where diff --git a/waspc/src/Wasp/Generator/ServerGenerator/OperationsG.hs b/waspc/src/Wasp/Generator/ServerGenerator/OperationsG.hs index f5798f7edf..2e0057676b 100644 --- a/waspc/src/Wasp/Generator/ServerGenerator/OperationsG.hs +++ b/waspc/src/Wasp/Generator/ServerGenerator/OperationsG.hs @@ -9,7 +9,7 @@ where import Data.Aeson (object, (.=)) import qualified Data.Aeson as Aeson import Data.Char (toLower) -import Data.Maybe (fromJust, fromMaybe) +import Data.Maybe (fromJust) import StrongPath (Dir, Dir', File', Path, Path', Posix, Rel, reldir, reldirP, relfile, ()) import qualified StrongPath as SP import Wasp.Generator.ExternalCodeGenerator.Common (GeneratedExternalCodeDir) @@ -24,22 +24,16 @@ import qualified Wasp.Wasp.Query as Wasp.Query genOperations :: Wasp -> [FileDraft] genOperations wasp = - concat - [ genQueries wasp, - genActions wasp - ] + genQueries wasp + ++ genActions wasp genQueries :: Wasp -> [FileDraft] genQueries wasp = - concat - [ map (genQuery wasp) (Wasp.getQueries wasp) - ] + map (genQuery wasp) (Wasp.getQueries wasp) genActions :: Wasp -> [FileDraft] genActions wasp = - concat - [ map (genAction wasp) (Wasp.getActions wasp) - ] + map (genAction wasp) (Wasp.getActions wasp) -- | Here we generate JS file that basically imports JS query function provided by user, -- decorates it (mostly injects stuff into it) and exports. Idea is that the rest of the server, @@ -86,7 +80,7 @@ operationTmplData operation = object [ "jsFnImportStatement" .= importStmt, "jsFnIdentifier" .= importIdentifier, - "entities" .= map buildEntityData (fromMaybe [] $ Wasp.Operation.getEntities operation) + "entities" .= maybe [] (map buildEntityData) (Wasp.Operation.getEntities operation) ] where (importIdentifier, importStmt) = diff --git a/waspc/src/Wasp/Generator/WebAppGenerator.hs b/waspc/src/Wasp/Generator/WebAppGenerator.hs index 0d056a154c..2233fb98a2 100644 --- a/waspc/src/Wasp/Generator/WebAppGenerator.hs +++ b/waspc/src/Wasp/Generator/WebAppGenerator.hs @@ -116,8 +116,8 @@ generatePublicIndexHtml wasp = targetPath = [relfile|public/index.html|] templateData = object - [ "title" .= (Wasp.App.appTitle $ getApp wasp), - "head" .= (maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp)) + [ "title" .= Wasp.App.appTitle (getApp wasp), + "head" .= maybe "" (intercalate "\n") (Wasp.App.appHead $ getApp wasp) ] -- * Src dir diff --git a/waspc/src/Wasp/Generator/WebAppGenerator/AuthG.hs b/waspc/src/Wasp/Generator/WebAppGenerator/AuthG.hs index 9ff58faf96..c21a66370e 100644 --- a/waspc/src/Wasp/Generator/WebAppGenerator/AuthG.hs +++ b/waspc/src/Wasp/Generator/WebAppGenerator/AuthG.hs @@ -45,8 +45,8 @@ genCreateAuthRequiredPage auth = (Just templateData) where authReqPagePath = [relfile|auth/pages/createAuthRequiredPage.js|] - targetPath = C.webAppSrcDirInWebAppRootDir (asWebAppSrcFile authReqPagePath) - templateData = object ["onAuthFailedRedirectTo" .= (Wasp.Auth._onAuthFailedRedirectTo auth)] + targetPath = C.webAppSrcDirInWebAppRootDir asWebAppSrcFile authReqPagePath + templateData = object ["onAuthFailedRedirectTo" .= Wasp.Auth._onAuthFailedRedirectTo auth] -- | Generates React hook that Wasp developer can use in a component to get -- access to the currently logged in user (and check whether user is logged in diff --git a/waspc/src/Wasp/Generator/WebAppGenerator/OperationsGenerator.hs b/waspc/src/Wasp/Generator/WebAppGenerator/OperationsGenerator.hs index 69303aa04a..b36846a330 100644 --- a/waspc/src/Wasp/Generator/WebAppGenerator/OperationsGenerator.hs +++ b/waspc/src/Wasp/Generator/WebAppGenerator/OperationsGenerator.hs @@ -8,10 +8,7 @@ import Data.Aeson (.=), ) import Data.List (intercalate) -import Data.Maybe - ( fromJust, - fromMaybe, - ) +import Data.Maybe (fromJust) import StrongPath (File', Path', Rel', parseRelFile, reldir, relfile, ()) import Wasp.Generator.FileDraft (FileDraft) import qualified Wasp.Generator.ServerGenerator as ServerGenerator @@ -35,16 +32,12 @@ genOperations wasp = genQueries :: Wasp -> [FileDraft] genQueries wasp = - concat - [ map (genQuery wasp) (Wasp.getQueries wasp), - [C.makeSimpleTemplateFD (C.asTmplFile [relfile|src/queries/index.js|]) wasp] - ] + map (genQuery wasp) (Wasp.getQueries wasp) + ++ [C.makeSimpleTemplateFD (C.asTmplFile [relfile|src/queries/index.js|]) wasp] genActions :: Wasp -> [FileDraft] genActions wasp = - concat - [ map (genAction wasp) (Wasp.getActions wasp) - ] + map (genAction wasp) (Wasp.getActions wasp) genQuery :: Wasp -> Wasp.Query.Query -> FileDraft genQuery _ query = C.makeTemplateFD tmplFile dstFile (Just tmplData) @@ -87,7 +80,7 @@ genAction _ action = C.makeTemplateFD tmplFile dstFile (Just tmplData) makeJsArrayOfEntityNames :: Wasp.Operation.Operation -> String makeJsArrayOfEntityNames operation = "[" ++ intercalate ", " entityStrings ++ "]" where - entityStrings = map (\x -> "'" ++ x ++ "'") $ fromMaybe [] $ Wasp.Operation.getEntities operation + entityStrings = maybe [] (map (\x -> "'" ++ x ++ "'")) (Wasp.Operation.getEntities operation) getOperationDstFileName :: Wasp.Operation.Operation -> Maybe (Path' Rel' File') getOperationDstFileName operation = parseRelFile (Wasp.Operation.getName operation ++ ".js") diff --git a/waspc/src/Wasp/Parser/Auth.hs b/waspc/src/Wasp/Parser/Auth.hs index b04d185db7..e953465861 100644 --- a/waspc/src/Wasp/Parser/Auth.hs +++ b/waspc/src/Wasp/Parser/Auth.hs @@ -62,13 +62,13 @@ authProperty = authPropertyOnAuthFailedRedirectTo :: Parser AuthProperty authPropertyOnAuthFailedRedirectTo = - AuthPropertyOnAuthFailedRedirectTo <$> (P.waspPropertyStringLiteral "onAuthFailedRedirectTo") + AuthPropertyOnAuthFailedRedirectTo <$> P.waspPropertyStringLiteral "onAuthFailedRedirectTo" authPropertyUserEntity :: Parser AuthProperty -authPropertyUserEntity = AuthPropertyUserEntity <$> (P.waspProperty "userEntity" L.identifier) +authPropertyUserEntity = AuthPropertyUserEntity <$> P.waspProperty "userEntity" L.identifier authPropertyMethods :: Parser AuthProperty authPropertyMethods = AuthPropertyMethods <$> P.waspProperty "methods" (L.brackets $ L.commaSep1 authMethod) authMethod :: Parser Wasp.Auth.AuthMethod -authMethod = L.symbol "EmailAndPassword" *> (pure Wasp.Auth.EmailAndPassword) +authMethod = L.symbol "EmailAndPassword" *> pure Wasp.Auth.EmailAndPassword diff --git a/waspc/src/Wasp/Parser/Db.hs b/waspc/src/Wasp/Parser/Db.hs index 177e6ec683..2d2bf179bc 100644 --- a/waspc/src/Wasp/Parser/Db.hs +++ b/waspc/src/Wasp/Parser/Db.hs @@ -3,7 +3,7 @@ module Wasp.Parser.Db ) where -import Data.Maybe (fromMaybe, listToMaybe) +import Data.Maybe (listToMaybe) import Text.Parsec (try, (<|>)) import Text.Parsec.String (Parser) import qualified Wasp.Lexer as L @@ -16,9 +16,10 @@ db = do dbProperties <- P.waspClosure (L.commaSep1 dbProperty) system <- - fromMaybe (fail "'system' property is required!") $ + maybe + (fail "'system' property is required!") return - <$> listToMaybe [p | DbPropertySystem p <- dbProperties] + (listToMaybe [p | DbPropertySystem p <- dbProperties]) return Wasp.Db.Db @@ -33,7 +34,7 @@ dbProperty = dbPropertySystem dbPropertySystem :: Parser DbProperty -dbPropertySystem = DbPropertySystem <$> (P.waspProperty "system" dbPropertySystemValue) +dbPropertySystem = DbPropertySystem <$> P.waspProperty "system" dbPropertySystemValue where dbPropertySystemValue = try (L.symbol "PostgreSQL" >> return Wasp.Db.PostgreSQL) diff --git a/waspc/src/Wasp/Parser/JsCode.hs b/waspc/src/Wasp/Parser/JsCode.hs index 3c6e2a8f22..d18defa5ed 100644 --- a/waspc/src/Wasp/Parser/JsCode.hs +++ b/waspc/src/Wasp/Parser/JsCode.hs @@ -9,4 +9,4 @@ import qualified Wasp.Parser.Common as P import qualified Wasp.Wasp.JsCode as WJS jsCode :: Parser WJS.JsCode -jsCode = (WJS.JsCode . Text.pack) <$> P.waspNamedClosure "js" +jsCode = WJS.JsCode . Text.pack <$> P.waspNamedClosure "js" diff --git a/waspc/src/Wasp/Parser/Style.hs b/waspc/src/Wasp/Parser/Style.hs index 9cd6d813f6..5511c8adaa 100644 --- a/waspc/src/Wasp/Parser/Style.hs +++ b/waspc/src/Wasp/Parser/Style.hs @@ -17,4 +17,4 @@ cssFile :: Parser Wasp.Style.Style cssFile = Wasp.Style.ExtCodeCssFile <$> Wasp.Parser.ExternalCode.extCodeFilePathString cssCode :: Parser Wasp.Style.Style -cssCode = (Wasp.Style.CssCode . Text.pack) <$> Wasp.Parser.Common.waspNamedClosure "css" +cssCode = Wasp.Style.CssCode . Text.pack <$> Wasp.Parser.Common.waspNamedClosure "css" diff --git a/waspc/src/Wasp/Psl/Parser/Model.hs b/waspc/src/Wasp/Psl/Parser/Model.hs index d7e278bd1f..e77ff61fd0 100644 --- a/waspc/src/Wasp/Psl/Parser/Model.hs +++ b/waspc/src/Wasp/Psl/Parser/Model.hs @@ -69,8 +69,9 @@ field = do where fieldType :: Parser Model.FieldType fieldType = - ( foldl1 (<|>) $ - map + foldl1 + (<|>) + ( map (\(s, t) -> try (T.symbol lexer s) >> return t) [ ("String", Model.String), ("Boolean", Model.Boolean), @@ -82,8 +83,13 @@ field = do ("Json", Model.Json), ("Bytes", Model.Bytes) ] - ) - <|> (try $ Model.Unsupported <$> (T.symbol lexer "Unsupported" >> T.parens lexer (T.stringLiteral lexer))) + ) + <|> try + ( Model.Unsupported + <$> ( T.symbol lexer "Unsupported" + >> T.parens lexer (T.stringLiteral lexer) + ) + ) <|> Model.UserType <$> T.identifier lexer -- NOTE: As is Prisma currently implemented, there can be only one type modifier at one time: [] or ?. @@ -122,8 +128,7 @@ attribute = do -- Doesn't parse the delimiter. attrArgument :: Parser Model.AttributeArg attrArgument = do - arg <- try namedArg <|> try unnamedArg - return arg + try namedArg <|> try unnamedArg where namedArg :: Parser Model.AttributeArg namedArg = do @@ -161,7 +166,7 @@ attrArgument = do argValueFieldReferenceList :: Parser Model.AttrArgValue argValueFieldReferenceList = Model.AttrArgFieldRefList - <$> (T.brackets lexer $ T.commaSep1 lexer $ T.identifier lexer) + <$> 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 @@ -180,8 +185,7 @@ attrArgument = do argValueUnknown :: Parser Model.AttrArgValue argValueUnknown = - Model.AttrArgUnknown - <$> (many1 $ try $ noneOf argDelimiters) + Model.AttrArgUnknown <$> many1 (try $ noneOf argDelimiters) delimitedArgValue :: Parser Model.AttrArgValue -> Parser Model.AttrArgValue delimitedArgValue argValueP = do diff --git a/waspc/src/Wasp/Util.hs b/waspc/src/Wasp/Util.hs index 70c2eae9aa..14d85804aa 100644 --- a/waspc/src/Wasp/Util.hs +++ b/waspc/src/Wasp/Util.hs @@ -19,17 +19,16 @@ camelToKebabCase camel@(camelHead : camelTail) = kebabHead : kebabTail where kebabHead = toLower camelHead kebabTail = - concat $ - map - (\(a, b) -> (if (isCamelHump (a, b)) then ['-'] else []) ++ [toLower b]) - (zip camel camelTail) + concatMap + (\(a, b) -> (if isCamelHump (a, b) then ['-'] else []) ++ [toLower b]) + (zip camel camelTail) isCamelHump (a, b) = (not . isUpper) a && isUpper b -- | Applies given function to the first element of the list. -- If list is empty, returns empty list. onFirst :: (a -> a) -> [a] -> [a] onFirst _ [] = [] -onFirst f (x : xs) = (f x) : xs +onFirst f (x : xs) = f x : xs toLowerFirst :: String -> String toLowerFirst = onFirst toLower diff --git a/waspc/src/Wasp/Util/Fib.hs b/waspc/src/Wasp/Util/Fib.hs index c8cbb4c134..86d99ba486 100644 --- a/waspc/src/Wasp/Util/Fib.hs +++ b/waspc/src/Wasp/Util/Fib.hs @@ -6,5 +6,5 @@ where fibonacci :: Int -> Int fibonacci 0 = 0 fibonacci 1 = 1 -fibonacci n | n > 1 = (fibonacci (n - 1)) + (fibonacci (n - 2)) +fibonacci n | n > 1 = fibonacci (n - 1) + fibonacci (n - 2) fibonacci _ = undefined diff --git a/waspc/test/Generator/MockWriteableMonad.hs b/waspc/test/Generator/MockWriteableMonad.hs index 428ca8b91b..ed32ad9c45 100644 --- a/waspc/test/Generator/MockWriteableMonad.hs +++ b/waspc/test/Generator/MockWriteableMonad.hs @@ -83,7 +83,7 @@ data MockWriteableMonadLogs = MockWriteableMonadLogs getTemplatesDirAbsPath_calls :: [()], createDirectoryIfMissing_calls :: [(Bool, FilePath)], copyFile_calls :: [(FilePath, FilePath)], - getTemplateFileAbsPath_calls :: [(Path' (Rel TemplatesDir) File')], + getTemplateFileAbsPath_calls :: [Path' (Rel TemplatesDir) File'], compileAndRenderTemplate_calls :: [(Path' (Rel TemplatesDir) File', Aeson.Value)] } @@ -96,25 +96,25 @@ data MockWriteableMonadConfig = MockWriteableMonadConfig writeFileFromText_addCall :: FilePath -> Text -> MockWriteableMonadLogs -> MockWriteableMonadLogs writeFileFromText_addCall path text logs = - logs {writeFileFromText_calls = (path, text) : (writeFileFromText_calls logs)} + logs {writeFileFromText_calls = (path, text) : writeFileFromText_calls logs} getTemplatesDirAbsPath_addCall :: MockWriteableMonadLogs -> MockWriteableMonadLogs getTemplatesDirAbsPath_addCall logs = - logs {getTemplatesDirAbsPath_calls = () : (getTemplatesDirAbsPath_calls logs)} + logs {getTemplatesDirAbsPath_calls = () : getTemplatesDirAbsPath_calls logs} getTemplateFileAbsPath_addCall :: Path' (Rel TemplatesDir) File' -> MockWriteableMonadLogs -> MockWriteableMonadLogs getTemplateFileAbsPath_addCall path logs = - logs {getTemplateFileAbsPath_calls = (path) : (getTemplateFileAbsPath_calls logs)} + logs {getTemplateFileAbsPath_calls = path : getTemplateFileAbsPath_calls logs} copyFile_addCall :: FilePath -> FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs copyFile_addCall srcPath dstPath logs = - logs {copyFile_calls = (srcPath, dstPath) : (copyFile_calls logs)} + logs {copyFile_calls = (srcPath, dstPath) : copyFile_calls logs} createDirectoryIfMissing_addCall :: Bool -> FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs createDirectoryIfMissing_addCall createParents path logs = logs { createDirectoryIfMissing_calls = - (createParents, path) : (createDirectoryIfMissing_calls logs) + (createParents, path) : createDirectoryIfMissing_calls logs } compileAndRenderTemplate_addCall :: @@ -125,5 +125,5 @@ compileAndRenderTemplate_addCall :: compileAndRenderTemplate_addCall path json logs = logs { compileAndRenderTemplate_calls = - (path, json) : (compileAndRenderTemplate_calls logs) + (path, json) : compileAndRenderTemplate_calls logs } diff --git a/waspc/test/Generator/PackageJsonGeneratorTest.hs b/waspc/test/Generator/PackageJsonGeneratorTest.hs index 36acb1c289..584a8ddca5 100644 --- a/waspc/test/Generator/PackageJsonGeneratorTest.hs +++ b/waspc/test/Generator/PackageJsonGeneratorTest.hs @@ -33,4 +33,4 @@ spec_resolveNpmDeps = do ("foo", "bar") ] let Left conflicts = resolveNpmDeps (ND.fromList waspDeps) (ND.fromList userDeps) - (map fst conflicts) `shouldBe` ND.fromList [("axios", "^1.20.0")] + map fst conflicts `shouldBe` ND.fromList [("axios", "^1.20.0")] diff --git a/waspc/test/Generator/WebAppGeneratorTest.hs b/waspc/test/Generator/WebAppGeneratorTest.hs index 9ea1cc126b..2164b7962b 100644 --- a/waspc/test/Generator/WebAppGeneratorTest.hs +++ b/waspc/test/Generator/WebAppGeneratorTest.hs @@ -18,8 +18,8 @@ import Wasp.Wasp spec_WebAppGenerator :: Spec spec_WebAppGenerator = do - let testApp = (App "TestApp" "Test App" Nothing) - let testWasp = (fromApp testApp) + let testApp = App "TestApp" "Test App" Nothing + let testWasp = fromApp testApp let testCompileOptions = CompileOptions.CompileOptions { CompileOptions.externalCodeDirPath = systemSPRoot SP. [SP.reldir|test/src|], @@ -33,8 +33,8 @@ spec_WebAppGenerator = do it "Given a simple Wasp, creates file drafts at expected destinations" $ do let fileDrafts = generateWebApp testWasp testCompileOptions let expectedFileDraftDstPaths = - map ((SP.toFilePath Common.webAppRootDirInProjectRootDir) ) $ - concat $ + map (SP.toFilePath Common.webAppRootDirInProjectRootDir ) $ + concat [ [ "README.md", "package.json", ".gitignore" @@ -46,7 +46,7 @@ spec_WebAppGenerator = do "manifest.json" ], map - ((SP.toFilePath Common.webAppSrcDirInWebAppRootDir) ) + (SP.toFilePath Common.webAppSrcDirInWebAppRootDir ) [ "logo.png", "index.css", "index.js", diff --git a/waspc/test/Parser/ActionTest.hs b/waspc/test/Parser/ActionTest.hs index 216d645e74..1dfe2dd79c 100644 --- a/waspc/test/Parser/ActionTest.hs +++ b/waspc/test/Parser/ActionTest.hs @@ -23,7 +23,7 @@ spec_parseAction = parseAction (genActionCode auth) `shouldBe` Right (genActionAST auth) testWhenAuth (Just True) testWhenAuth (Just False) - testWhenAuth (Nothing) + testWhenAuth Nothing it "When given action wasp declaration without 'fn' property, should return Left" $ do isLeft (parseAction "action myAction { }") `shouldBe` True where @@ -42,13 +42,12 @@ spec_parseAction = } genActionCode :: Maybe Bool -> String genActionCode aApplyAuth = - ( "action " ++ testActionName ++ " {\n" - ++ " fn: import { " - ++ testActionJsFunctionName - ++ " } from \"@ext/some/path\"" - ++ authStr aApplyAuth - ++ "}" - ) + "action " ++ testActionName ++ " {\n" + ++ " fn: import { " + ++ testActionJsFunctionName + ++ " } from \"@ext/some/path\"" + ++ authStr aApplyAuth + ++ "}" authStr :: Maybe Bool -> String authStr (Just useAuth) = ",\n auth: " ++ map toLower (show useAuth) ++ "\n" diff --git a/waspc/test/Parser/CommonTest.hs b/waspc/test/Parser/CommonTest.hs index 1f9aa61db1..72fbc21345 100644 --- a/waspc/test/Parser/CommonTest.hs +++ b/waspc/test/Parser/CommonTest.hs @@ -36,7 +36,7 @@ spec_parseWaspCommon = do `shouldBe` Right ("someApp", 'a') it "When given wasp element declaration with invalid name, returns Left" $ do - (isLeft $ parseWaspElementNameAndClosureContent "app" whiteSpace "app 1someApp { }") + isLeft (parseWaspElementNameAndClosureContent "app" whiteSpace "app 1someApp { }") `shouldBe` True describe "Parsing wasp closure" $ do @@ -45,7 +45,7 @@ spec_parseWaspCommon = do `shouldBe` Right "content" it "Does not parse a closure with brackets []" $ do - (isLeft $ runWaspParser (waspClosure (symbol "content")) "[ content ]") + isLeft (runWaspParser (waspClosure (symbol "content")) "[ content ]") `shouldBe` True describe "Parsing wasp property with a closure as a value" $ do diff --git a/waspc/test/Parser/QueryTest.hs b/waspc/test/Parser/QueryTest.hs index 9ea0bd5619..6dedb85f67 100644 --- a/waspc/test/Parser/QueryTest.hs +++ b/waspc/test/Parser/QueryTest.hs @@ -18,20 +18,19 @@ spec_parseQuery = parseQuery (genQueryCode auth) `shouldBe` Right (genQueryAST auth) testWhenAuth (Just True) testWhenAuth (Just False) - testWhenAuth (Nothing) + testWhenAuth Nothing it "When given query wasp declaration without 'fn' property, should return Left" $ do isLeft (parseQuery "query myQuery { }") `shouldBe` True where genQueryCode :: Maybe Bool -> String genQueryCode qApplyAuth = - ( "query " ++ testQueryName ++ " {\n" - ++ " fn: import { " - ++ testQueryJsFunctionName - ++ " } from \"@ext/some/path\",\n" - ++ " entities: [Task, Project]" - ++ authStr qApplyAuth - ++ "}" - ) + "query " ++ testQueryName ++ " {\n" + ++ " fn: import { " + ++ testQueryJsFunctionName + ++ " } from \"@ext/some/path\",\n" + ++ " entities: [Task, Project]" + ++ authStr qApplyAuth + ++ "}" genQueryAST :: Maybe Bool -> Wasp.Query.Query genQueryAST qApplyAuth = Wasp.Query.Query diff --git a/waspc/test/Util/FibTest.hs b/waspc/test/Util/FibTest.hs index b7218e83d2..9293eccf40 100644 --- a/waspc/test/Util/FibTest.hs +++ b/waspc/test/Util/FibTest.hs @@ -5,7 +5,7 @@ import Test.Tasty.QuickCheck import Wasp.Util.Fib spec_fibonacci :: Spec -spec_fibonacci = do +spec_fibonacci = describe "Fibonacci" $ do it "fibonacci element #0 is 0" $ do fibonacci 0 `shouldBe` 0 @@ -19,7 +19,7 @@ spec_fibonacci = do -- NOTE: Most likely not the best way to write QuickCheck test, I just did this in order -- to get something working as an example. prop_fibonacci :: Property -prop_fibonacci = forAll (choose (0, 10)) $ testFibSequence +prop_fibonacci = forAll (choose (0, 10)) testFibSequence where testFibSequence :: Int -> Bool - testFibSequence x = (fibonacci x) + (fibonacci (x + 1)) == fibonacci (x + 2) + testFibSequence x = fibonacci x + fibonacci (x + 1) == fibonacci (x + 2) diff --git a/waspc/test/UtilTest.hs b/waspc/test/UtilTest.hs index 25b1418777..55322a06bb 100644 --- a/waspc/test/UtilTest.hs +++ b/waspc/test/UtilTest.hs @@ -21,7 +21,7 @@ spec_camelToKebabCase = do spec_onFirst :: Spec spec_onFirst = do it "Returns empty list for empty list" $ do - (onFirst id ([] :: [Char])) `shouldBe` [] + onFirst id ([] :: [Char]) `shouldBe` [] it "Applies given method on first element of list" $ do onFirst (+ 1) ([1, 2, 3] :: [Int]) `shouldBe` [2, 2, 3] @@ -52,7 +52,7 @@ spec_jsonSet = do [ "prop1" .= ("first" :: String), "newProp" .= (23 :: Int) ] - (jsonSet "newProp" (Aeson.Number 23) inputObj) `shouldBe` expectedObj + jsonSet "newProp" (Aeson.Number 23) inputObj `shouldBe` expectedObj it "When an existing property is set, it is overwritten in the result object." $ do let newStrValue = "newVal" :: String @@ -60,4 +60,4 @@ spec_jsonSet = do object [ "prop1" .= newStrValue ] - (jsonSet "prop1" (toJSON newStrValue) inputObj) `shouldBe` expectedObj + jsonSet "prop1" (toJSON newStrValue) inputObj `shouldBe` expectedObj