mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-09-11 15:26:19 +03:00
168 lines
6.8 KiB
Haskell
168 lines
6.8 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module Generator.MockWriteableMonad
|
|
( MockWriteableMonad,
|
|
MockWriteableMonadLogs (..),
|
|
MockWriteableMonadConfig (..),
|
|
getMockLogs,
|
|
defaultMockConfig,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.State
|
|
import qualified Data.Aeson as Aeson
|
|
import Data.Bifunctor (first)
|
|
import Data.Text (Text, pack)
|
|
import Fixtures (systemSPRoot)
|
|
import StrongPath (Abs, Dir, Dir', File', Path', Rel, castDir, reldir, (</>))
|
|
import StrongPath.Operations (castFile)
|
|
import StrongPath.Types (File)
|
|
import Wasp.Generator.FileDraft.WriteableMonad
|
|
import Wasp.Generator.Templates (TemplatesDir)
|
|
|
|
-- TODO: Instead of manually defining mock like this, consider using monad-mock package,
|
|
-- it should do most of this automatically, now there is a lot of boilerplate.
|
|
-- Or we ourselves can maybe use template haskell to reduce duplication.
|
|
|
|
defaultMockConfig :: MockWriteableMonadConfig
|
|
defaultMockConfig =
|
|
MockWriteableMonadConfig
|
|
{ getTemplatesDirAbsPath_impl = systemSPRoot </> [reldir|mock/templates/dir|],
|
|
getTemplateFileAbsPath_impl = \path -> systemSPRoot </> [reldir|mock/templates/dir|] </> path,
|
|
compileAndRenderTemplate_impl = \_ _ -> pack "Mock template content",
|
|
doesFileExist_impl = const True,
|
|
doesDirectoryExist_impl = const True,
|
|
readFileAsText_impl = \_ -> pack "Mock text file content"
|
|
}
|
|
|
|
getMockLogs :: MockWriteableMonad a -> MockWriteableMonadConfig -> MockWriteableMonadLogs
|
|
getMockLogs mock config = fst $ execState (unMockWriteableMonad mock) (emptyLogs, config)
|
|
where
|
|
emptyLogs = MockWriteableMonadLogs [] [] [] [] [] [] [] [] []
|
|
|
|
instance WriteableMonad MockWriteableMonad where
|
|
writeFileFromText dstPath text = MockWriteableMonad $ do
|
|
modifyLogs (writeFileFromText_addCall dstPath text)
|
|
|
|
readFileAsText srcPath = MockWriteableMonad $ do
|
|
modifyLogs (readFileAsText_addCall srcPath)
|
|
(_, config) <- get
|
|
return $ readFileAsText_impl config srcPath
|
|
|
|
getTemplatesDirAbsPath = MockWriteableMonad $ do
|
|
modifyLogs getTemplatesDirAbsPath_addCall
|
|
(_, config) <- get
|
|
return $ getTemplatesDirAbsPath_impl config
|
|
|
|
createDirectoryIfMissing createParents path = MockWriteableMonad $ do
|
|
modifyLogs (createDirectoryIfMissing_addCall createParents path)
|
|
|
|
copyFile srcPath dstPath = MockWriteableMonad $ do
|
|
modifyLogs (copyFile_addCall srcPath dstPath)
|
|
|
|
getTemplateFileAbsPath path = MockWriteableMonad $ do
|
|
modifyLogs (getTemplateFileAbsPath_addCall $ castFile path)
|
|
(_, config) <- get
|
|
return $ getTemplateFileAbsPath_impl config path
|
|
|
|
compileAndRenderTemplate path json = MockWriteableMonad $ do
|
|
modifyLogs (compileAndRenderTemplate_addCall (castFile path) json)
|
|
(_, config) <- get
|
|
return $ compileAndRenderTemplate_impl config path json
|
|
|
|
doesFileExist path = MockWriteableMonad $ do
|
|
(_, config) <- get
|
|
return $ doesFileExist_impl config path
|
|
|
|
doesDirectoryExist path = MockWriteableMonad $ do
|
|
(_, config) <- get
|
|
return $ doesDirectoryExist_impl config path
|
|
|
|
copyDirectoryRecursive srcPath dstPath = MockWriteableMonad $ do
|
|
modifyLogs (copyDirectoryRecursive_addCall (castDir srcPath) (castDir dstPath))
|
|
|
|
removeDirectoryRecursive dir = MockWriteableMonad $ do
|
|
modifyLogs (removeDirectoryRecursive_addCall (castDir dir))
|
|
|
|
throwIO = throwIO
|
|
|
|
instance MonadIO MockWriteableMonad where
|
|
liftIO = undefined
|
|
|
|
modifyLogs :: MonadState (a, b) m => (a -> a) -> m ()
|
|
modifyLogs f = modify (first f)
|
|
|
|
newtype MockWriteableMonad a = MockWriteableMonad
|
|
{ unMockWriteableMonad :: State (MockWriteableMonadLogs, MockWriteableMonadConfig) a
|
|
}
|
|
deriving (Monad, Applicative, Functor)
|
|
|
|
data MockWriteableMonadLogs = MockWriteableMonadLogs
|
|
{ writeFileFromText_calls :: [(FilePath, Text)],
|
|
readFileAsText_calls :: [FilePath],
|
|
getTemplatesDirAbsPath_calls :: [()],
|
|
createDirectoryIfMissing_calls :: [(Bool, FilePath)],
|
|
copyFile_calls :: [(FilePath, FilePath)],
|
|
getTemplateFileAbsPath_calls :: [Path' (Rel TemplatesDir) File'],
|
|
compileAndRenderTemplate_calls :: [(Path' (Rel TemplatesDir) File', Aeson.Value)],
|
|
copyDirectoryRecursive_calls :: [(Path' Abs Dir', Path' Abs Dir')],
|
|
removeDirectoryRecursive_calls :: [Path' Abs Dir']
|
|
}
|
|
|
|
data MockWriteableMonadConfig = MockWriteableMonadConfig
|
|
{ getTemplatesDirAbsPath_impl :: Path' Abs (Dir TemplatesDir),
|
|
getTemplateFileAbsPath_impl :: forall a. Path' (Rel TemplatesDir) (File a) -> Path' Abs (File a),
|
|
compileAndRenderTemplate_impl :: forall a. Path' (Rel TemplatesDir) (File a) -> Aeson.Value -> Text,
|
|
doesFileExist_impl :: FilePath -> Bool,
|
|
doesDirectoryExist_impl :: FilePath -> Bool,
|
|
readFileAsText_impl :: FilePath -> Text
|
|
}
|
|
|
|
writeFileFromText_addCall :: FilePath -> Text -> MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
writeFileFromText_addCall path text logs =
|
|
logs {writeFileFromText_calls = (path, text) : writeFileFromText_calls logs}
|
|
|
|
readFileAsText_addCall :: FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
readFileAsText_addCall path logs =
|
|
logs {readFileAsText_calls = path : readFileAsText_calls logs}
|
|
|
|
getTemplatesDirAbsPath_addCall :: MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
getTemplatesDirAbsPath_addCall 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}
|
|
|
|
copyFile_addCall :: FilePath -> FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
copyFile_addCall srcPath dstPath 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
|
|
}
|
|
|
|
copyDirectoryRecursive_addCall :: Path' Abs Dir' -> Path' Abs Dir' -> MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
copyDirectoryRecursive_addCall srcPath dstPath logs =
|
|
logs {copyDirectoryRecursive_calls = (srcPath, dstPath) : copyDirectoryRecursive_calls logs}
|
|
|
|
removeDirectoryRecursive_addCall :: Path' Abs Dir' -> MockWriteableMonadLogs -> MockWriteableMonadLogs
|
|
removeDirectoryRecursive_addCall dir logs =
|
|
logs {removeDirectoryRecursive_calls = dir : removeDirectoryRecursive_calls logs}
|
|
|
|
compileAndRenderTemplate_addCall ::
|
|
Path' (Rel TemplatesDir) File' ->
|
|
Aeson.Value ->
|
|
MockWriteableMonadLogs ->
|
|
MockWriteableMonadLogs
|
|
compileAndRenderTemplate_addCall path json logs =
|
|
logs
|
|
{ compileAndRenderTemplate_calls =
|
|
(path, json) : compileAndRenderTemplate_calls logs
|
|
}
|