Introduced Path (Rel, Abs) package into part of our code. (#70)

This commit is contained in:
Martin Šošić 2020-01-20 11:51:13 +01:00 committed by GitHub
parent b94405a499
commit e2c200bc6c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 94 additions and 36 deletions

View File

@ -1,20 +1,34 @@
module Main where
import System.Environment
import System.FilePath ((</>), takeDirectory)
import System.Directory
import qualified System.FilePath as FilePath
import Path ((</>), reldir)
import qualified Path
import qualified Path.Aliases as Path
import CompileOptions (CompileOptions (..))
import Lib (compile)
main :: IO ()
main = do
absCwdPath <- getCurrentDirectory >>= Path.parseAbsDir
args <- getArgs
case args of
[waspFilePath, outDir] -> do
[waspFilePath, outDirPath] -> do
absWaspFilePath <- Path.parseAbsFile (ensurePathIsAbs absCwdPath waspFilePath)
absOutDirPath <- Path.parseAbsDir (ensurePathIsAbs absCwdPath outDirPath)
-- TODO(martin): Take compile options as arguments to the command, right now I hardcoded the value.
let options = CompileOptions
{ externalCodeDirPath = (takeDirectory waspFilePath) </> "src"
{ externalCodeDirPath = (Path.parent absWaspFilePath) </> [reldir|src|]
}
result <- compile waspFilePath outDir options
result <- compile absWaspFilePath absOutDirPath options
either putStrLn (\_ -> print ("Success!" :: String)) result
_ -> print ("Usage: ./stic <wasp_file_path> <out_dir>" :: String)
where
-- | If path is not absolute, it is prefixed with given absolute directory.
ensurePathIsAbs :: Path.AbsDir -> FilePath -> FilePath
ensurePathIsAbs absDirPath path = if FilePath.isAbsolute path
then path
else (Path.toFilePath absDirPath) FilePath.</> path

View File

@ -9,7 +9,11 @@ author: "Stic"
maintainer: "info@stic.dev"
copyright: "2019 Stic"
default-extensions: OverloadedStrings
default-extensions:
- OverloadedStrings
- TemplateHaskell
- QuasiQuotes
- ScopedTypeVariables
extra-source-files:
- README.md
@ -45,6 +49,7 @@ library:
- directory
- split
- unordered-containers
- path
executables:
stic-exe:
@ -57,6 +62,8 @@ executables:
dependencies:
- stic
- filepath
- path
- directory
benchmarks:
stic-benchmarks:
@ -91,3 +98,4 @@ tests:
- QuickCheck
- parsec
- deepseq
- path

View File

@ -2,9 +2,11 @@ module CompileOptions
( CompileOptions(..)
) where
import qualified Path.Aliases as 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 :: !FilePath
{ externalCodeDirPath :: !Path.AbsDir
}

View File

@ -5,16 +5,17 @@ module ExternalCode
, readFiles
) where
import System.FilePath ((</>))
import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.IO as TextL.IO
import Data.Text (Text)
import qualified Path
import qualified Path.Aliases as Path
import qualified Util.IO
data File = File
{ _pathInExtCodeDir :: !FilePath -- ^ Path relative to external code directory.
{ _pathInExtCodeDir :: !Path.RelFile -- ^ Path relative to external code directory.
, _text :: TextL.Text -- ^ File content. It will throw error when evaluated if file is not textual file.
}
@ -25,7 +26,7 @@ instance Eq File where
f1 == f2 = (_pathInExtCodeDir f1) == (_pathInExtCodeDir f2)
-- | Returns path relative to the external code directory.
getFilePathInExtCodeDir :: File -> FilePath
getFilePathInExtCodeDir :: File -> Path.RelFile
getFilePathInExtCodeDir = _pathInExtCodeDir
-- | Unsafe method: throws error if text could not be read (if file is not a textual file)!
@ -35,9 +36,10 @@ getFileText = TextL.toStrict . _text
-- | Returns all files contained in the specified external code dir, recursively.
-- File paths are relative to the specified external code dir path.
readFiles :: FilePath -> IO [File]
readFiles :: Path.AbsDir -> IO [File]
readFiles extCodeDirPath = do
filePaths <- Util.IO.listDirectoryDeep extCodeDirPath
relFilePaths <- Util.IO.listDirectoryDeep extCodeDirPath
let absFilePaths = map (extCodeDirPath Path.</>) 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.
-- Since we do lazy reading (Text.Lazy), this is not a problem as long as we don't try to use
@ -51,7 +53,7 @@ readFiles extCodeDirPath = do
-- or create new file draft that will support that.
-- In generator, when creating TextFileDraft, give it function/logic for text transformation,
-- and it will be taken care of when draft will be written to the disk.
fileTexts <- mapM (TextL.IO.readFile . (extCodeDirPath </>)) filePaths
let files = map (\(path, text) -> File path text) (zip filePaths fileTexts)
fileTexts <- mapM (TextL.IO.readFile . Path.toFilePath) absFilePaths
let files = map (\(path, text) -> File path text) (zip relFilePaths fileTexts)
return files

View File

@ -12,6 +12,7 @@ import qualified Wasp
import qualified Generator.FileDraft as FD
import qualified Generator.Common as Common
import qualified ExternalCode
import qualified Path
externalCodeDirPathInSrc :: FilePath
@ -22,11 +23,13 @@ generateExternalCodeDir compileOptions wasp =
map (generateFile compileOptions) (Wasp.getExternalCodeFiles wasp)
getFileDstPath :: ExternalCode.File -> FilePath
getFileDstPath file = Common.srcDirPath </> externalCodeDirPathInSrc </> (ExternalCode.getFilePathInExtCodeDir file)
getFileDstPath file = Common.srcDirPath </> externalCodeDirPathInSrc </>
(Path.toFilePath $ ExternalCode.getFilePathInExtCodeDir file)
getFileSrcPath :: CompileOptions -> ExternalCode.File -> FilePath
getFileSrcPath compileOptions file =
(CompileOptions.externalCodeDirPath compileOptions) </> (ExternalCode.getFilePathInExtCodeDir file)
Path.toFilePath (CompileOptions.externalCodeDirPath compileOptions Path.</>
ExternalCode.getFilePathInExtCodeDir file)
generateFile :: CompileOptions -> ExternalCode.File -> FD.FileDraft
generateFile compileOptions file

View File

@ -8,13 +8,15 @@ import qualified ExternalCode
import Parser
import Generator
import Wasp (setExternalCodeFiles)
import qualified Path
import qualified Path.Aliases as Path
type CompileError = String
compile :: FilePath -> FilePath -> CompileOptions -> IO (Either CompileError ())
compile :: Path.AbsFile -> Path.AbsDir -> CompileOptions -> IO (Either CompileError ())
compile waspFile outDir options = do
waspStr <- readFile waspFile
waspStr <- readFile (Path.toFilePath waspFile)
case parseWasp waspStr of
Left err -> return $ Left (show err)
@ -22,4 +24,4 @@ compile waspFile outDir options = do
externalCodeFiles <- ExternalCode.readFiles (CompileOptions.externalCodeDirPath options)
generateCode $ wasp `setExternalCodeFiles` externalCodeFiles
where
generateCode wasp = writeWebAppCode wasp outDir options >> return (Right ())
generateCode wasp = writeWebAppCode wasp (Path.toFilePath outDir) options >> return (Right ())

9
src/Path/Aliases.hs Normal file
View File

@ -0,0 +1,9 @@
module Path.Aliases where
import Path (Path, Abs, Rel, Dir, File)
type RelFile = Path Rel File
type AbsFile = Path Abs File
type RelDir = Path Rel Dir
type AbsDir = Path Abs Dir

View File

@ -3,10 +3,13 @@ module Util.IO
) where
import qualified System.Directory as Dir
import System.FilePath ((</>), splitDirectories)
import qualified System.FilePath as FilePath
import System.IO.Error (isDoesNotExistError)
import Control.Exception (catch, throw)
import Control.Monad (filterM, mapM)
import qualified Path
import qualified Path.Aliases as Path
-- TODO: write tests.
@ -19,22 +22,36 @@ import Control.Monad (filterM, mapM)
-- >>> 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)
listDirectoryDeep :: Path.AbsDir -> IO [Path.RelFile]
listDirectoryDeep absDirPath = do
(relFilePaths, relSubDirPaths) <- (listDirectory absDirPath)
`catch` \e -> if isDoesNotExistError e then return ([], []) else throw e
relSubDirFilesPaths <- mapM (listSubDirDeep . (absDirPath Path.</>)) relSubDirPaths
return $ relFilePaths ++ (concat relSubDirFilesPaths)
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]
-- | 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 :: Path.AbsDir -> IO [Path.RelFile]
listSubDirDeep subDirPath = do
paths <- listDirectoryDeep subDirPath
return $ map ((getDirName subDirPath) </>) paths
files <- listDirectoryDeep subDirPath
return $ map ((Path.dirname subDirPath) Path.</>) files
-- TODO: write tests.
-- | Lists files and directories at top lvl of the directory.
listDirectory :: Path.AbsDir -> IO ([Path.RelFile], [Path.RelDir])
listDirectory absDirPath = do
fpRelItemPaths <- Dir.listDirectory fpAbsDirPath
relFilePaths <- filterFiles fpAbsDirPath fpRelItemPaths
relDirPaths <- filterDirs fpAbsDirPath fpRelItemPaths
return (relFilePaths, relDirPaths)
where
fpAbsDirPath :: FilePath
fpAbsDirPath = Path.toFilePath absDirPath
filterFiles :: FilePath -> [FilePath] -> IO [Path.RelFile]
filterFiles absDir relItems = filterM (Dir.doesFileExist . (absDir FilePath.</>)) relItems
>>= mapM Path.parseRelFile
filterDirs :: FilePath -> [FilePath] -> IO [Path.RelDir]
filterDirs absDir relItems = filterM (Dir.doesDirectoryExist . (absDir FilePath.</>)) relItems
>>= mapM Path.parseRelDir

View File

@ -3,6 +3,7 @@ module Generator.GeneratorsTest where
import Test.Tasty.Hspec
import System.FilePath (FilePath, (</>), (<.>))
import Path (absdir)
import Util
import qualified CompileOptions
@ -24,7 +25,7 @@ spec_Generators = do
let testEntity = (Entity "TestEntity" [EntityField "testField" EftString])
let testWasp = (fromApp testApp) `addPage` testPage `addEntity` testEntity
let testCompileOptions = CompileOptions.CompileOptions
{ CompileOptions.externalCodeDirPath = "test/src"
{ CompileOptions.externalCodeDirPath = [absdir|/test/src|]
}
describe "generateWebApp" $ do