dynamic: add read-file

This commit is contained in:
hellerve 2019-05-14 13:51:27 -04:00
parent 0edbddd32a
commit a7cb1fb46f
6 changed files with 41 additions and 1 deletions

View File

@ -1430,6 +1430,25 @@
</p> </p>
</div> </div>
<div class="binder">
<a class="anchor" href="#read-file">
<h3 id="read-file">
read-file
</h3>
</a>
<div class="description">
command
</div>
<p class="sig">
Dynamic
</p>
<span>
</span>
<p class="doc">
</p>
</div>
<div class="binder"> <div class="binder">
<a class="anchor" href="#reload"> <a class="anchor" href="#reload">
<h3 id="reload"> <h3 id="reload">

View File

@ -8,9 +8,10 @@ import Data.Maybe (fromMaybe)
import Data.List (elemIndex) import Data.List (elemIndex)
import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..)) import System.Exit (exitSuccess, exitFailure, exitWith, ExitCode(..))
import System.FilePath (takeDirectory) import System.FilePath (takeDirectory)
import qualified Data.Map as Map import System.IO
import System.Process (callCommand, spawnCommand, waitForProcess) import System.Process (callCommand, spawnCommand, waitForProcess)
import Control.Exception import Control.Exception
import qualified Data.Map as Map
import Parsing import Parsing
import Emit import Emit
@ -786,6 +787,19 @@ commandNot [x] =
_ -> _ ->
return (Left (EvalError ("Can't perform logical operation (not) on " ++ pretty x) (info x))) return (Left (EvalError ("Can't perform logical operation (not) on " ++ pretty x) (info x)))
commandReadFile :: CommandCallback
commandReadFile [filename] =
case filename of
XObj (Str fname) _ _ -> do
exceptional <- liftIO $ ((try $ readFile fname) :: (IO (Either IOException String)))
case exceptional of
Right contents ->
return (Right (XObj (Str contents) (Just dummyInfo) (Just StringTy)))
Left _ ->
return (Left (EvalError ("The argument to `read-file` `" ++ fname ++ "` does not exist") (info filename)))
_ ->
return (Left (EvalError ("The argument to `read-file` must be a string, I got `" ++ pretty filename ++ "`") (info filename)))
commandSaveDocsInternal :: CommandCallback commandSaveDocsInternal :: CommandCallback
commandSaveDocsInternal [modulePath] = do commandSaveDocsInternal [modulePath] = do
ctx <- get ctx <- get

View File

@ -153,6 +153,7 @@ toC toCMode root = emitterSrc (execState (visit startingIndent root) (EmitterSta
visitString indent (XObj (Pattern str) (Just i) _) = visitStr' indent str i visitString indent (XObj (Pattern str) (Just i) _) = visitStr' indent str i
visitString _ _ = error "Not a string." visitString _ _ = error "Not a string."
escaper '\"' acc = "\\\"" ++ acc escaper '\"' acc = "\\\"" ++ acc
escaper '\n' acc = "\\n" ++ acc
escaper x acc = x : acc escaper x acc = x : acc
escapeString = foldr escaper "" escapeString = foldr escaper ""

View File

@ -236,6 +236,7 @@ dynamicModule = Env { envBindings = bindings
, addCommand "system-include" 1 commandAddSystemInclude , addCommand "system-include" 1 commandAddSystemInclude
, addCommand "local-include" 1 commandAddLocalInclude , addCommand "local-include" 1 commandAddLocalInclude
, addCommand "save-docs-internal" 1 commandSaveDocsInternal , addCommand "save-docs-internal" 1 commandSaveDocsInternal
, addCommand "read-file" 1 commandReadFile
] ]
++ [("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing)) ++ [("String", Binder emptyMeta (XObj (Mod dynamicStringModule) Nothing Nothing))
,("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing)) ,("Symbol", Binder emptyMeta (XObj (Mod dynamicSymModule) Nothing Nothing))

1
test/fixture_file.txt Normal file
View File

@ -0,0 +1 @@
test file contents

View File

@ -196,4 +196,8 @@
1 1
(test-join) (test-join)
"Symbol.join works as expected") "Symbol.join works as expected")
(assert-equal test
"test file contents\n"
(Dynamic.read-file "test/fixture_file.txt")
"Dynamic.read-file works as expected")
) )