Refactored copying of external code to use file-by-file approach instead of whole dir.

This commit is contained in:
Martin Sosic 2020-01-13 23:25:36 +01:00
parent b408d73cd0
commit bc09d894df
14 changed files with 117 additions and 89 deletions

7
src/Generator/Common.hs Normal file
View File

@ -0,0 +1,7 @@
module Generator.Common
( srcDirPath
) where
-- | Path to src directory, relative to the root directory of generated code.
srcDirPath :: FilePath
srcDirPath = "src"

View File

@ -26,6 +26,7 @@ import System.FilePath (FilePath, (</>), (<.>))
import qualified Util
import Wasp
import Generator.FileDraft
import qualified Generator.Common as Common
generateEntities :: Wasp -> [FileDraft]
@ -95,7 +96,7 @@ generateEntityCreateForm wasp entityForm =
(getEntityByName wasp (efEntityName entityForm))
templateSrcPath = entityTemplatesDirPath </> "components" </> "CreateForm.js"
dstPath = "src" </> (entityCreateFormPathInSrc entity entityForm)
dstPath = Common.srcDirPath </> (entityCreateFormPathInSrc entity entityForm)
entityTemplateJson = entityTemplateData wasp entity
templateData = Util.jsonSet "entityForm" (toJSON entityForm) entityTemplateJson
@ -121,7 +122,7 @@ createSimpleEntityFileDraft wasp entity dstPathInSrc srcPathInEntityTemplatesDir
= createTemplateFileDraft dstPath srcPath templateData
where
srcPath = entityTemplatesDirPath </> srcPathInEntityTemplatesDir
dstPath = "src" </> dstPathInSrc
dstPath = Common.srcDirPath </> dstPathInSrc
templateData = entityTemplateData wasp entity
{- | Converts entity field to a JSON where field type is a key to the object holding

View File

@ -3,19 +3,26 @@ module Generator.ExternalCodeDirGenerator
, externalCodeDirPathInSrc
) where
import System.FilePath ((</>))
import Data.Text (Text)
import CompileOptions (CompileOptions)
import qualified CompileOptions
import Wasp
import Generator.FileDraft
import Wasp (Wasp)
import qualified Wasp
import qualified Generator.FileDraft as FD
import qualified Generator.Common as Common
generateExternalCodeDir :: CompileOptions -> Wasp -> [FileDraft]
generateExternalCodeDir options _ = [createCopyDirDraft dstPath srcPath]
where
srcPath = CompileOptions.externalCodeDirPath options
dstPath = "src" </> externalCodeDirPathInSrc
externalCodeDirPathInSrc :: FilePath
externalCodeDirPathInSrc = "ext-src"
generateExternalCodeDir :: CompileOptions -> Wasp -> [FD.FileDraft]
generateExternalCodeDir _ wasp = map generateExternalCodeFile (Wasp.getExternalCodeFiles wasp)
generateExternalCodeFile :: (FilePath, Text) -> FD.FileDraft
generateExternalCodeFile (pathInExtCodeDir, content) = FD.createTextFileDraft dstPath content
where
dstPath = Common.srcDirPath </> externalCodeDirPathInSrc </> pathInExtCodeDir

View File

@ -4,7 +4,6 @@ module Generator.FileDraft
, createTemplateFileDraft
, createCopyFileDraft
, createTextFileDraft
, createCopyDirDraft
) where
import qualified Data.Aeson as Aeson
@ -21,9 +20,6 @@ import qualified Generator.FileDraft.CopyFileDraft as CopyFD
import Generator.FileDraft.TextFileDraft (TextFileDraft)
import qualified Generator.FileDraft.TextFileDraft as TextFD
import Generator.FileDraft.CopyDirDraft (CopyDirDraft)
import qualified Generator.FileDraft.CopyDirDraft as CopyDirFD
-- | 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
@ -32,14 +28,12 @@ data FileDraft
= FileDraftTemplateFd TemplateFileDraft
| FileDraftCopyFd CopyFileDraft
| FileDraftTextFd TextFileDraft
| FileDraftCopyDirDraft CopyDirDraft
deriving (Show, Eq)
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
@ -53,7 +47,3 @@ createCopyFileDraft dstPath srcPath =
createTextFileDraft :: FilePath -> Text -> FileDraft
createTextFileDraft dstPath content =
FileDraftTextFd $ TextFD.TextFileDraft dstPath content
createCopyDirDraft :: FilePath -> FilePath -> FileDraft
createCopyDirDraft dstPath srcPath =
FileDraftCopyDirDraft $ CopyDirFD.CopyDirDraft dstPath srcPath

View File

@ -1,22 +0,0 @@
module Generator.FileDraft.CopyDirDraft
( CopyDirDraft(..)
) where
import System.FilePath (FilePath, (</>))
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
{ -- | Path where directory will be copied, relative to some root dir.
dstPath :: !FilePath
-- | Path of source directory.
, srcPath :: !FilePath
}
deriving (Show, Eq)
instance Writeable CopyDirDraft where
write dstDir draft = do
let dstAbsPath = dstDir </> (dstPath draft)
copyDirectory (srcPath draft) dstAbsPath

View File

@ -14,7 +14,7 @@ import Data.Text (Text)
data TextFileDraft = TextFileDraft
{ -- | Path of file to be written, relative to some root dir.
textFileDraftDstFilepath :: !FilePath
, textFileDraftContent :: !Text
, textFileDraftContent :: Text
}
deriving (Show, Eq)

View File

@ -8,13 +8,18 @@ import qualified Data.Text.IO
import Data.Aeson as Aeson
import Data.Text (Text)
import qualified Util.IO
import qualified Generator.Templates
-- TODO: Should we use DI via data instead of typeclasses?
-- https://news.ycombinator.com/item?id=10392044
-- TODO: Should we make constraint MonadIO instead of just Monad?
-- That would allow us to do liftIO. And that might allow us to perform any IO
-- we want (hm will it?), which could be useful for custom stuff (but does that defeat the whole purpose?).
-- But that means we can't test that part, which yes, defeats the purpose somewhat.
-- I feel like all together we should not do it :), but it is an option if needed.
-- | Describes effects needed by File Drafts.
class (Monad m) => WriteableMonad m where
createDirectoryIfMissing
@ -29,16 +34,6 @@ class (Monad m) => WriteableMonad m where
writeFileFromText :: FilePath -> Text -> m ()
-- | Copies all directory contents to the specified destination, recursively.
-- Directory and sub directories are created as needed.
-- Example: if we do `copyDirectory "/test" "/foo/bar"`, where /test contains files A.txt and B.txt,
-- result will be creation of files A.txt and B.txt in /foo/bar directory. /foo and /foo/bar are
-- also created if they did not exist before.
copyDirectory
:: FilePath -- ^ Path of directory to be copied.
-> FilePath -- ^ Path to a location where directory contents will be directly copied to.
-> m ()
getTemplateFileAbsPath
:: FilePath -- ^ Template file path, relative to templates root directory.
-> m FilePath
@ -58,4 +53,3 @@ instance WriteableMonad IO where
getTemplateFileAbsPath = Generator.Templates.getTemplateFileAbsPath
getTemplatesDirAbsPath = Generator.Templates.getTemplatesDirAbsPath
compileAndRenderTemplate = Generator.Templates.compileAndRenderTemplate
copyDirectory = Util.IO.copyDirectory

View File

@ -12,6 +12,7 @@ import Generator.FileDraft
import qualified Generator.EntityGenerator as EntityGenerator
import qualified Generator.PageGenerator as PageGenerator
import qualified Generator.ExternalCodeDirGenerator as ExternalCodeDirGenerator
import qualified Generator.Common as Common
generateWebApp :: Wasp -> CompileOptions -> [FileDraft]
@ -45,7 +46,7 @@ generatePublicDir wasp
generateSrcDir :: Wasp -> [FileDraft]
generateSrcDir wasp
= (createCopyFileDraft ("src" </> "logo.png") ("src" </> "logo.png"))
= (createCopyFileDraft (Common.srcDirPath </> "logo.png") ("src" </> "logo.png"))
: map (\path -> simpleTemplateFileDraft ("src/" </> path) wasp)
[ "index.js"
, "index.css"
@ -62,7 +63,7 @@ generateReducersJs :: Wasp -> FileDraft
generateReducersJs wasp = createTemplateFileDraft dstPath srcPath templateData
where
srcPath = "src" </> "reducers.js"
dstPath = srcPath
dstPath = Common.srcDirPath </> "reducers.js"
templateData = object
[ "wasp" .= wasp
, "entities" .= map toEntityData (getEntities wasp)

View File

@ -17,6 +17,7 @@ import Wasp
import Generator.FileDraft
import qualified Generator.EntityGenerator as EntityGenerator
import Generator.ExternalCodeDirGenerator (externalCodeDirPathInSrc)
import qualified Generator.Common as Common
generatePages :: Wasp -> [FileDraft]
@ -32,7 +33,7 @@ generatePageComponent :: Wasp -> Page -> FileDraft
generatePageComponent wasp page = createTemplateFileDraft dstPath srcPath templateData
where
srcPath = "src" </> "_Page.js"
dstPath = FilePath.normalise $ "src" </> pageDirPathInSrc </> (pageName page) <.> "js"
dstPath = FilePath.normalise $ Common.srcDirPath </> pageDirPathInSrc </> (pageName page) <.> "js"
templateData = object $
[ "wasp" .= wasp
, "page" .= page
@ -89,7 +90,7 @@ generatePageStyle _ page = maybe
(\style -> [createTextFileDraft dstPath style])
(pageStyle page)
where
dstPath = "src" </> pageStylePathInSrcDir page
dstPath = Common.srcDirPath </> pageStylePathInSrcDir page
pageStylePathInSrcDir :: Page -> FilePath
pageStylePathInSrcDir page = (pageName page) <.> "css"

View File

@ -2,9 +2,16 @@ module Lib
( compile
) where
import qualified Data.Text.IO as TextIO
import Data.Text (Text)
import System.FilePath ((</>))
import qualified Util.IO
import CompileOptions (CompileOptions)
import qualified CompileOptions
import Parser
import Generator
import Wasp (setExternalCodeFiles)
type CompileError = String
@ -15,6 +22,16 @@ compile waspFile outDir options = do
case parseWasp waspStr of
Left err -> return $ Left (show err)
Right wasp -> generateCode wasp
Right wasp -> do
externalCodeFiles <- readExternalCodeFiles $ CompileOptions.externalCodeDirPath options
generateCode $ wasp `setExternalCodeFiles` externalCodeFiles
where
generateCode wasp = writeWebAppCode wasp outDir options >> return (Right ())
-- | Returns paths and contents of external code files.
-- Paths are relative to the given external code dir path.
readExternalCodeFiles :: FilePath -> IO [(FilePath, Text)]
readExternalCodeFiles externalCodeDirPath = do
externalCodeFilePaths <- Util.IO.listDirectoryDeep externalCodeDirPath
externalCodeFileContents <- mapM (TextIO.readFile . (externalCodeDirPath </>)) externalCodeFilePaths
return $ zip externalCodeFilePaths externalCodeFileContents

View File

@ -1,28 +1,40 @@
module Util.IO
( copyDirectory
( listDirectoryDeep
) where
import System.Directory (listDirectory, doesDirectoryExist, copyFile, createDirectoryIfMissing)
import System.FilePath ((</>))
import qualified System.Directory as Dir
import System.FilePath ((</>), splitDirectories)
import System.IO.Error (isDoesNotExistError)
import Control.Exception (catch, throw)
import Control.Monad (sequence)
import Control.Monad (filterM, mapM)
-- | Copies all directory contents to specified destination, recursively.
-- Directory and sub directories are created as needed.
-- If directory does not exist, does nothing (does not fail).
copyDirectory
:: FilePath -- ^ Path to directory to be copied.
-> FilePath -- ^ Path to location where directory contents will be copied to.
-> IO ()
copyDirectory dirSrcPath dirDstPath = do
names <- listDirectory dirSrcPath
`catch` \e -> if isDoesNotExistError e then return [] else throw e
if length names == 0 then return () else do
isDirFlags <- sequence $ map doesDirectoryExist names
let dirNames = map fst $ filter snd $ zip names isDirFlags
let fileNames = map fst $ filter (not . snd) $ zip names isDirFlags
createDirectoryIfMissing True dirDstPath
sequence_ $ map (\name -> copyFile (dirSrcPath </> name) (dirDstPath </> name)) fileNames
sequence_ $ map (\name -> copyDirectory (dirSrcPath </> name) (dirDstPath </> name)) dirNames
return ()
-- 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.
--
-- Example: Imagine we have directory foo that contains test.txt and bar/test2.txt.
-- If we call
-- >>> listDirectoryDeep "foo/"
-- we should get
-- >>> ["test.txt", "bar/text2.txt"]
listDirectoryDeep :: FilePath -> IO [FilePath]
listDirectoryDeep dirPath = do
dirItems <- Dir.listDirectory dirPath
`catch` \e -> if isDoesNotExistError e then return [] else throw e
files <- filterM (Dir.doesFileExist . (dirPath </>)) dirItems
subDirs <- filterM (Dir.doesDirectoryExist . (dirPath </>)) dirItems
subDirsFiles <- mapM (listSubDirDeep . (dirPath </>)) subDirs
return $ files ++ (concat subDirsFiles)
where
getDirName :: FilePath -> FilePath
getDirName path = last $ splitDirectories path
-- | Returned paths are relative to the main dir whose sub dir we are listing.
listSubDirDeep :: FilePath -> IO [FilePath]
listSubDirDeep subDirPath = do
paths <- listDirectoryDeep subDirPath
return $ map ((getDirName subDirPath) </>) paths

View File

@ -23,8 +23,12 @@ module Wasp
, module Wasp.Page
, getPages
, addPage
, setExternalCodeFiles
, getExternalCodeFiles
) where
import Data.Text (Text)
import Data.Aeson ((.=), object, ToJSON(..))
import Wasp.App
@ -40,6 +44,10 @@ import qualified Util as U
data Wasp = Wasp
{ waspElements :: [WaspElement]
, waspJsImports :: [JsImport]
, externalCodeFiles ::
[( FilePath -- ^ Path relative to external code directory.
, Text -- ^ Text of that file.
)]
} deriving (Show, Eq)
data WaspElement
@ -50,12 +58,24 @@ data WaspElement
deriving (Show, Eq)
fromWaspElems :: [WaspElement] -> Wasp
fromWaspElems elems = Wasp { waspElements = elems, waspJsImports = [] }
fromWaspElems elems = Wasp
{ waspElements = elems
, waspJsImports = []
, externalCodeFiles = []
}
-- * External code files
getExternalCodeFiles :: Wasp -> [(FilePath, Text)]
getExternalCodeFiles = externalCodeFiles
setExternalCodeFiles :: Wasp -> [(FilePath, Text)] -> Wasp
setExternalCodeFiles wasp files = wasp { externalCodeFiles = files }
-- * Js imports
getJsImports :: Wasp -> [JsImport]
getJsImports wasp = waspJsImports wasp
getJsImports = waspJsImports
setJsImports :: Wasp -> [JsImport] -> Wasp
setJsImports wasp jsImports = wasp { waspJsImports = jsImports }

View File

@ -8,6 +8,7 @@ import Wasp
import Generator.FileDraft
import Generator.FileDraft.TemplateFileDraft
import Generator.EntityGenerator
import qualified Generator.Common as Common
import qualified Fixtures as F
@ -67,6 +68,6 @@ spec_generateEntityCreateForm = do
let (FileDraftTemplateFd templateFileDraft) =
generateEntityCreateForm waspWithTask F.taskCreateForm
let expectedDstPath = "src" </> (entityCreateFormPathInSrc F.taskEntity F.taskCreateForm)
let expectedDstPath = Common.srcDirPath </> (entityCreateFormPathInSrc F.taskEntity F.taskCreateForm)
templateFileDraftDstFilepath templateFileDraft `shouldBe` expectedDstPath

View File

@ -11,7 +11,7 @@ import Generator.FileDraft
import Generator.FileDraft.TemplateFileDraft
import Generator.FileDraft.CopyFileDraft
import Generator.FileDraft.TextFileDraft
import qualified Generator.FileDraft.CopyDirDraft as CopyDirDraft
import qualified Generator.Common as Common
import Wasp
-- TODO(martin): We could define Arbitrary instance for Wasp, define properties over
@ -45,7 +45,7 @@ spec_Generators = do
, "index.html"
, "manifest.json"
]
, map ("src" </>)
, map (Common.srcDirPath </>)
[ "logo.png"
, "index.css"
, "index.js"
@ -79,4 +79,3 @@ getFileDraftDstPath :: FileDraft -> FilePath
getFileDraftDstPath (FileDraftTemplateFd fd) = templateFileDraftDstFilepath fd
getFileDraftDstPath (FileDraftCopyFd fd) = copyFileDraftDstFilepath fd
getFileDraftDstPath (FileDraftTextFd fd) = textFileDraftDstFilepath fd
getFileDraftDstPath (FileDraftCopyDirDraft draft) = CopyDirDraft.dstPath draft