Renamed WriteableToFile into Writeable, and FileDraftIO into WriteableMonad.

This commit is contained in:
Martin Sosic 2020-01-15 13:08:13 +01:00 committed by Martin Šošić
parent cf8ad33d0c
commit b408d73cd0
13 changed files with 88 additions and 88 deletions

View File

@ -5,7 +5,7 @@ module Generator
import CompileOptions (CompileOptions)
import Wasp
import Generator.Generators (generateWebApp)
import Generator.FileDraft (FileDraft, writeToFile)
import Generator.FileDraft (FileDraft, write)
-- | Generates web app code from given Wasp and writes it to given destination directory.
@ -20,4 +20,4 @@ writeWebAppCode wasp dstDir compileOptions = writeFileDrafts dstDir (generateWeb
-- TODO(martin): We could/should parallelize this.
-- We could also skip writing files that are already on the disk with same checksum.
writeFileDrafts :: FilePath -> [FileDraft] -> IO ()
writeFileDrafts dstDir fileDrafts = sequence_ $ map (writeToFile dstDir) fileDrafts
writeFileDrafts dstDir fileDrafts = sequence_ $ map (write dstDir) fileDrafts

View File

@ -1,6 +1,6 @@
module Generator.FileDraft
( FileDraft(..)
, WriteableToFile(..)
, Writeable(..)
, createTemplateFileDraft
, createCopyFileDraft
, createTextFileDraft
@ -10,7 +10,7 @@ module Generator.FileDraft
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import Generator.FileDraft.WriteableToFile
import Generator.FileDraft.Writeable
import Generator.FileDraft.TemplateFileDraft (TemplateFileDraft)
import qualified Generator.FileDraft.TemplateFileDraft as TemplateFD
@ -35,11 +35,11 @@ data FileDraft
| FileDraftCopyDirDraft CopyDirDraft
deriving (Show, Eq)
instance WriteableToFile FileDraft where
writeToFile dstDir (FileDraftTemplateFd draft) = writeToFile dstDir draft
writeToFile dstDir (FileDraftCopyFd draft) = writeToFile dstDir draft
writeToFile dstDir (FileDraftTextFd draft) = writeToFile dstDir draft
writeToFile dstDir (FileDraftCopyDirDraft draft) = writeToFile dstDir draft
instance Writeable FileDraft where
write dstDir (FileDraftTemplateFd draft) = write dstDir draft
write dstDir (FileDraftCopyFd draft) = write dstDir draft
write dstDir (FileDraftTextFd draft) = write dstDir draft
write dstDir (FileDraftCopyDirDraft draft) = write dstDir draft
createTemplateFileDraft :: FilePath -> FilePath -> Aeson.Value -> FileDraft

View File

@ -4,8 +4,8 @@ module Generator.FileDraft.CopyDirDraft
import System.FilePath (FilePath, (</>))
import Generator.FileDraft.WriteableToFile
import Generator.FileDraft.FileDraftIO
import Generator.FileDraft.Writeable
import Generator.FileDraft.WriteableMonad
-- | File draft based purely on another dir, that is just copied recursively with all the files in it.
data CopyDirDraft = CopyDirDraft
@ -16,7 +16,7 @@ data CopyDirDraft = CopyDirDraft
}
deriving (Show, Eq)
instance WriteableToFile CopyDirDraft where
writeToFile dstDir draft = do
instance Writeable CopyDirDraft where
write dstDir draft = do
let dstAbsPath = dstDir </> (dstPath draft)
copyDirectory (srcPath draft) dstAbsPath

View File

@ -4,8 +4,8 @@ module Generator.FileDraft.CopyFileDraft
import System.FilePath (FilePath, (</>), takeDirectory)
import Generator.FileDraft.WriteableToFile
import Generator.FileDraft.FileDraftIO
import Generator.FileDraft.Writeable
import Generator.FileDraft.WriteableMonad
-- | File draft based purely on another file, that is just copied.
data CopyFileDraft = CopyFileDraft
@ -17,8 +17,8 @@ data CopyFileDraft = CopyFileDraft
}
deriving (Show, Eq)
instance WriteableToFile CopyFileDraft where
writeToFile dstDir (CopyFileDraft dstFilepath srcFilepath) = do
instance Writeable CopyFileDraft where
write dstDir (CopyFileDraft dstFilepath srcFilepath) = do
let dstAbsFilepath = dstDir </> dstFilepath
srcAbsFilepath <- getTemplateFileAbsPath srcFilepath
createDirectoryIfMissing True (takeDirectory dstAbsFilepath)

View File

@ -6,8 +6,8 @@ import System.FilePath (FilePath, (</>), takeDirectory)
import Data.Text (Text)
import qualified Data.Aeson as Aeson
import Generator.FileDraft.WriteableToFile
import Generator.FileDraft.FileDraftIO
import Generator.FileDraft.Writeable
import Generator.FileDraft.WriteableMonad
-- | File draft based on template file that gets combined with data.
@ -21,8 +21,8 @@ data TemplateFileDraft = TemplateFileDraft
}
deriving (Show, Eq)
instance WriteableToFile TemplateFileDraft where
writeToFile dstDir draft =
instance Writeable TemplateFileDraft where
write dstDir draft =
compileAndRenderTemplate templateRelFilepath templateData >>= writeContentToFile
where
templateRelFilepath :: FilePath
@ -31,7 +31,7 @@ instance WriteableToFile TemplateFileDraft where
templateData :: Aeson.Value
templateData = templateFileDraftTemplateData draft
writeContentToFile :: (FileDraftIO m) => Text -> m ()
writeContentToFile :: (WriteableMonad m) => Text -> m ()
writeContentToFile content = do
let absDstFilepath = dstDir </> (templateFileDraftDstFilepath draft)
createDirectoryIfMissing True (takeDirectory absDstFilepath)

View File

@ -4,8 +4,8 @@ module Generator.FileDraft.TextFileDraft
import System.FilePath (FilePath, (</>), takeDirectory)
import Generator.FileDraft.WriteableToFile
import Generator.FileDraft.FileDraftIO
import Generator.FileDraft.Writeable
import Generator.FileDraft.WriteableMonad
import Data.Text (Text)
@ -18,8 +18,8 @@ data TextFileDraft = TextFileDraft
}
deriving (Show, Eq)
instance WriteableToFile TextFileDraft where
writeToFile dstDir (TextFileDraft dstFilepath content) = do
instance Writeable TextFileDraft where
write dstDir (TextFileDraft dstFilepath content) = do
let dstAbsFilepath = dstDir </> dstFilepath
createDirectoryIfMissing True (takeDirectory dstAbsFilepath)
writeFileFromText dstAbsFilepath content

View File

@ -0,0 +1,12 @@
module Generator.FileDraft.Writeable
( Writeable(..)
) where
import Generator.FileDraft.WriteableMonad
class Writeable w where
-- | Write file somewhere in the provided dst directory.
write :: (WriteableMonad m)
=> FilePath -- ^ Absolute path of dst directory.
-> w
-> m ()

View File

@ -1,5 +1,5 @@
module Generator.FileDraft.FileDraftIO
( FileDraftIO(..)
module Generator.FileDraft.WriteableMonad
( WriteableMonad(..)
) where
@ -16,7 +16,7 @@ import qualified Generator.Templates
-- https://news.ycombinator.com/item?id=10392044
-- | Describes effects needed by File Drafts.
class (Monad m) => FileDraftIO m where
class (Monad m) => WriteableMonad m where
createDirectoryIfMissing
:: Bool -- ^ True if parents should also be created.
-> FilePath -- ^ Path to the directory to create.
@ -51,7 +51,7 @@ class (Monad m) => FileDraftIO m where
-> Aeson.Value -- ^ JSON to be provided as template data.
-> m Text
instance FileDraftIO IO where
instance WriteableMonad IO where
createDirectoryIfMissing = System.Directory.createDirectoryIfMissing
copyFile = System.Directory.copyFile
writeFileFromText = Data.Text.IO.writeFile

View File

@ -1,14 +0,0 @@
module Generator.FileDraft.WriteableToFile
( WriteableToFile(..)
) where
import Generator.FileDraft.FileDraftIO
class WriteableToFile w where
-- | Based on "WriteableToFile" instance, creates file somewhere in the provided dst
-- directory.
writeToFile
:: (FileDraftIO m)
=> FilePath -- ^ Absolute path of dst directory.
-> w -- ^ "WriteableToFile" instance to be written to file.
-> m ()

View File

@ -6,22 +6,22 @@ import System.FilePath ((</>), takeDirectory)
import Generator.FileDraft
import Generator.MockFileDraftIO
import qualified Generator.MockWriteableMonad as Mock
spec_CopyFileDraft :: Spec
spec_CopyFileDraft = do
describe "writeToFile" $ do
describe "write" $ do
it "Creates new file by copying existing file" $ do
let mock = writeToFile dstDir fileDraft
let mockLogs = getMockLogs mock defaultMockConfig
createDirectoryIfMissing_calls mockLogs
let mock = write dstDir fileDraft
let mockLogs = Mock.getMockLogs mock Mock.defaultMockConfig
Mock.createDirectoryIfMissing_calls mockLogs
`shouldBe` [(True, takeDirectory expectedDstPath)]
copyFile_calls mockLogs
Mock.copyFile_calls mockLogs
`shouldBe` [(expectedSrcPath, expectedDstPath)]
where
(dstDir, dstPath, srcPath) = ("a/b", "c/d/dst.txt", "e/src.txt")
fileDraft = createCopyFileDraft dstPath srcPath
expectedSrcPath = mockTemplatesDirAbsPath </> srcPath
expectedDstPath = dstDir </> dstPath
mockTemplatesDirAbsPath = getTemplatesDirAbsPath_impl defaultMockConfig
mockTemplatesDirAbsPath = Mock.getTemplatesDirAbsPath_impl Mock.defaultMockConfig

View File

@ -8,20 +8,20 @@ import Data.Text (Text)
import Generator.FileDraft
import Generator.MockFileDraftIO
import qualified Generator.MockWriteableMonad as Mock
spec_TemplateFileDraft :: Spec
spec_TemplateFileDraft = do
describe "writeToFile" $ do
describe "write" $ do
it "Creates new file from existing template file" $ do
let mock = writeToFile dstDir fileDraft
let mockLogs = getMockLogs mock mockConfig
compileAndRenderTemplate_calls mockLogs
let mock = write dstDir fileDraft
let mockLogs = Mock.getMockLogs mock mockConfig
Mock.compileAndRenderTemplate_calls mockLogs
`shouldBe` [(templatePath, templateData)]
createDirectoryIfMissing_calls mockLogs
Mock.createDirectoryIfMissing_calls mockLogs
`shouldBe` [(True, takeDirectory expectedDstPath)]
writeFileFromText_calls mockLogs
Mock.writeFileFromText_calls mockLogs
`shouldBe` [(expectedDstPath, mockTemplateContent)]
where
(dstDir, dstPath, templatePath) = ("a/b", "c/d/dst.txt", "e/tmpl.txt")
@ -30,7 +30,7 @@ spec_TemplateFileDraft = do
expectedDstPath = dstDir </> dstPath
mockTemplatesDirAbsPath = "mock/templates/dir"
mockTemplateContent = "Mock template content" :: Text
mockConfig = defaultMockConfig
{ getTemplatesDirAbsPath_impl = mockTemplatesDirAbsPath
, compileAndRenderTemplate_impl = \_ _ -> mockTemplateContent
mockConfig = Mock.defaultMockConfig
{ Mock.getTemplatesDirAbsPath_impl = mockTemplatesDirAbsPath
, Mock.compileAndRenderTemplate_impl = \_ _ -> mockTemplateContent
}

View File

@ -73,7 +73,7 @@ spec_Generators = do
existsFdWithDst :: [FileDraft] -> FilePath -> Bool
existsFdWithDst fds dstPath = any ((== dstPath) . getFileDraftDstPath) fds
-- TODO(martin): This should really become part of the WriteableToFile typeclass,
-- TODO(martin): This should really become part of the Writeable typeclass,
-- since it is smth we want to do for all file drafts.
getFileDraftDstPath :: FileDraft -> FilePath
getFileDraftDstPath (FileDraftTemplateFd fd) = templateFileDraftDstFilepath fd

View File

@ -1,9 +1,9 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Generator.MockFileDraftIO
( MockFdIO
, MockFdIOLogs(..)
, MockFdIOConfig(..)
module Generator.MockWriteableMonad
( MockWriteableMonad
, MockWriteableMonadLogs(..)
, MockWriteableMonadConfig(..)
, getMockLogs
, defaultMockConfig
) where
@ -13,46 +13,46 @@ import Data.Text (Text, pack)
import Control.Monad.State
import qualified Data.Aeson as Aeson
import Generator.FileDraft.FileDraftIO
import Generator.FileDraft.WriteableMonad
-- 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 :: MockFdIOConfig
defaultMockConfig = MockFdIOConfig
defaultMockConfig :: MockWriteableMonadConfig
defaultMockConfig = MockWriteableMonadConfig
{ getTemplatesDirAbsPath_impl = "mock/templates/dir"
, getTemplateFileAbsPath_impl = \path -> "mock/templates/dir" </> path
, compileAndRenderTemplate_impl = \_ _ -> (pack "Mock template content")
}
getMockLogs :: MockFdIO a -> MockFdIOConfig -> MockFdIOLogs
getMockLogs mock config = fst $ execState (unMockFdIO mock) (emptyLogs, config)
getMockLogs :: MockWriteableMonad a -> MockWriteableMonadConfig -> MockWriteableMonadLogs
getMockLogs mock config = fst $ execState (unMockWriteableMonad mock) (emptyLogs, config)
where
emptyLogs = MockFdIOLogs [] [] [] [] [] []
emptyLogs = MockWriteableMonadLogs [] [] [] [] [] []
instance FileDraftIO MockFdIO where
writeFileFromText dstPath text = MockFdIO $ do
instance WriteableMonad MockWriteableMonad where
writeFileFromText dstPath text = MockWriteableMonad $ do
modifyLogs (writeFileFromText_addCall dstPath text)
getTemplatesDirAbsPath = MockFdIO $ do
getTemplatesDirAbsPath = MockWriteableMonad $ do
modifyLogs getTemplatesDirAbsPath_addCall
(_, config) <- get
return $ getTemplatesDirAbsPath_impl config
createDirectoryIfMissing createParents path = MockFdIO $ do
createDirectoryIfMissing createParents path = MockWriteableMonad $ do
modifyLogs (createDirectoryIfMissing_addCall createParents path)
copyFile srcPath dstPath = MockFdIO $ do
copyFile srcPath dstPath = MockWriteableMonad $ do
modifyLogs (copyFile_addCall srcPath dstPath)
getTemplateFileAbsPath path = MockFdIO $ do
getTemplateFileAbsPath path = MockWriteableMonad $ do
modifyLogs (getTemplateFileAbsPath_addCall path)
(_, config) <- get
return $ (getTemplateFileAbsPath_impl config) path
compileAndRenderTemplate path json = MockFdIO $ do
compileAndRenderTemplate path json = MockWriteableMonad $ do
modifyLogs (compileAndRenderTemplate_addCall path json)
(_, config) <- get
return $ (compileAndRenderTemplate_impl config) path json
@ -60,10 +60,12 @@ instance FileDraftIO MockFdIO where
modifyLogs :: MonadState (a, b) m => (a -> a) -> m ()
modifyLogs f = modify (\(logs, config) -> (f logs, config))
newtype MockFdIO a = MockFdIO { unMockFdIO :: State (MockFdIOLogs, MockFdIOConfig) a }
newtype MockWriteableMonad a = MockWriteableMonad
{ unMockWriteableMonad :: State (MockWriteableMonadLogs, MockWriteableMonadConfig) a
}
deriving (Monad, Applicative, Functor)
data MockFdIOLogs = MockFdIOLogs
data MockWriteableMonadLogs = MockWriteableMonadLogs
{ writeFileFromText_calls :: [(FilePath, Text)]
, getTemplatesDirAbsPath_calls :: [()]
, createDirectoryIfMissing_calls :: [(Bool, FilePath)]
@ -72,34 +74,34 @@ data MockFdIOLogs = MockFdIOLogs
, compileAndRenderTemplate_calls :: [(FilePath, Aeson.Value)]
}
data MockFdIOConfig = MockFdIOConfig
data MockWriteableMonadConfig = MockWriteableMonadConfig
{ getTemplatesDirAbsPath_impl :: FilePath
, getTemplateFileAbsPath_impl :: FilePath -> FilePath
, compileAndRenderTemplate_impl :: FilePath -> Aeson.Value -> Text
}
writeFileFromText_addCall :: FilePath -> Text -> MockFdIOLogs -> MockFdIOLogs
writeFileFromText_addCall :: FilePath -> Text -> MockWriteableMonadLogs -> MockWriteableMonadLogs
writeFileFromText_addCall path text logs =
logs { writeFileFromText_calls = (path, text):(writeFileFromText_calls logs) }
getTemplatesDirAbsPath_addCall :: MockFdIOLogs -> MockFdIOLogs
getTemplatesDirAbsPath_addCall :: MockWriteableMonadLogs -> MockWriteableMonadLogs
getTemplatesDirAbsPath_addCall logs =
logs { getTemplatesDirAbsPath_calls = ():(getTemplatesDirAbsPath_calls logs) }
getTemplateFileAbsPath_addCall :: FilePath -> MockFdIOLogs -> MockFdIOLogs
getTemplateFileAbsPath_addCall :: FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs
getTemplateFileAbsPath_addCall path logs =
logs { getTemplateFileAbsPath_calls = (path):(getTemplateFileAbsPath_calls logs) }
copyFile_addCall :: FilePath -> FilePath -> MockFdIOLogs -> MockFdIOLogs
copyFile_addCall :: FilePath -> FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs
copyFile_addCall srcPath dstPath logs =
logs { copyFile_calls = (srcPath, dstPath):(copyFile_calls logs) }
createDirectoryIfMissing_addCall :: Bool -> FilePath -> MockFdIOLogs -> MockFdIOLogs
createDirectoryIfMissing_addCall :: Bool -> FilePath -> MockWriteableMonadLogs -> MockWriteableMonadLogs
createDirectoryIfMissing_addCall createParents path logs =
logs { createDirectoryIfMissing_calls =
(createParents, path):(createDirectoryIfMissing_calls logs) }
compileAndRenderTemplate_addCall :: FilePath -> Aeson.Value -> MockFdIOLogs -> MockFdIOLogs
compileAndRenderTemplate_addCall :: FilePath -> Aeson.Value -> MockWriteableMonadLogs -> MockWriteableMonadLogs
compileAndRenderTemplate_addCall path json logs =
logs { compileAndRenderTemplate_calls =
(path, json):(compileAndRenderTemplate_calls logs) }