mirror of
https://github.com/anoma/juvix.git
synced 2025-01-05 14:34:03 +03:00
Improve filepath equality (#170)
* improve filepath equality * replace makeAbsolute by canonicalizePath
This commit is contained in:
parent
b7a0a3668b
commit
117020215c
@ -45,7 +45,7 @@ commandFirstFile CommandGlobalOptions {_cliGlobalOptions = GlobalOptions {..}} =
|
|||||||
makeAbsPaths :: CLI -> IO CLI
|
makeAbsPaths :: CLI -> IO CLI
|
||||||
makeAbsPaths cli = case cli of
|
makeAbsPaths cli = case cli of
|
||||||
Command cmd -> do
|
Command cmd -> do
|
||||||
nOpts <- traverseOf globalInputFiles (mapM makeAbsolute) (cmd ^. cliGlobalOptions)
|
nOpts <- traverseOf globalInputFiles (mapM canonicalizePath) (cmd ^. cliGlobalOptions)
|
||||||
return (Command (set cliGlobalOptions nOpts cmd))
|
return (Command (set cliGlobalOptions nOpts cmd))
|
||||||
_ -> return cli
|
_ -> return cli
|
||||||
|
|
||||||
|
@ -13,9 +13,9 @@ runFilesIO :: Member (Embed IO) r => Sem (Files ': r) a -> Sem r a
|
|||||||
runFilesIO = interpret $ \case
|
runFilesIO = interpret $ \case
|
||||||
ReadFile' f -> embed (readFile f)
|
ReadFile' f -> embed (readFile f)
|
||||||
EqualPaths' f h -> embed $ do
|
EqualPaths' f h -> embed $ do
|
||||||
f' <- makeAbsolute f
|
f' <- canonicalizePath f
|
||||||
h' <- makeAbsolute h
|
h' <- canonicalizePath h
|
||||||
return (Just $ f' == h')
|
return (Just (equalFilePath f' h'))
|
||||||
|
|
||||||
runFilesEmpty :: Sem (Files ': r) a -> Sem r a
|
runFilesEmpty :: Sem (Files ': r) a -> Sem r a
|
||||||
runFilesEmpty = runFilesPure mempty
|
runFilesEmpty = runFilesPure mempty
|
||||||
|
@ -32,7 +32,7 @@ testDescr PosTest {..} =
|
|||||||
_testRoot = tRoot,
|
_testRoot = tRoot,
|
||||||
_testAssertion = Steps $ \step -> do
|
_testAssertion = Steps $ \step -> do
|
||||||
cwd <- getCurrentDirectory
|
cwd <- getCurrentDirectory
|
||||||
entryFile <- makeAbsolute _file
|
entryFile <- canonicalizePath _file
|
||||||
let entryPoint = EntryPoint cwd False (pure entryFile)
|
let entryPoint = EntryPoint cwd False (pure entryFile)
|
||||||
|
|
||||||
step "Parsing"
|
step "Parsing"
|
||||||
|
Loading…
Reference in New Issue
Block a user