diff --git a/src/IRTS/CodegenC.hs b/src/IRTS/CodegenC.hs index b90ce67810..b25953a67a 100644 --- a/src/IRTS/CodegenC.hs +++ b/src/IRTS/CodegenC.hs @@ -17,6 +17,7 @@ import System.Exit import System.IO import System.Directory import System.FilePath ((), (<.>)) +import qualified System.IO.UTF8 as UTF8 import Control.Monad codegenC :: CodeGenerator @@ -50,12 +51,12 @@ codegenC' defs out exec incs objs libs flags dbg let h = concatMap toDecl (map fst bc) let cc = concatMap (uncurry toC) bc d <- getDataDir - mprog <- readFile (d "rts" "idris_main" <.> "c") + mprog <- UTF8.readFile (d "rts" "idris_main" <.> "c") let cout = headers incs ++ debug dbg ++ h ++ cc ++ (if (exec == Executable) then mprog else "") case exec of MavenProject -> putStrLn ("FAILURE: output type not supported") - Raw -> writeFile out cout + Raw -> UTF8.writeFile out cout _ -> do (tmpn, tmph) <- tempfile hPutStr tmph cout diff --git a/src/IRTS/CodegenJava.hs b/src/IRTS/CodegenJava.hs index 6178a3ab3b..1ca27d9007 100644 --- a/src/IRTS/CodegenJava.hs +++ b/src/IRTS/CodegenJava.hs @@ -30,6 +30,7 @@ import System.Directory import System.Exit import System.FilePath import System.IO +import qualified System.IO.UTF8 as UTF8 import System.Process ----------------------------------------------------------------------- @@ -97,7 +98,7 @@ generateJavaFile globalInit defs hdrs srcDir out = do let code = either error (prettyPrint)-- flatIndent . prettyPrint) (evalStateT (mkCompilationUnit globalInit defs hdrs out) mkCodeGenEnv) - writeFile (javaFileName srcDir out) code + UTF8.writeFile (javaFileName srcDir out) code pomFileName :: FilePath -> FilePath pomFileName tgtDir = tgtDir "pom.xml" @@ -106,7 +107,7 @@ generatePom :: FilePath -> -- tgt dir FilePath -> -- output target [String] -> -- libs IO () -generatePom tgtDir out libs = writeFile (pomFileName tgtDir) execPom +generatePom tgtDir out libs = UTF8.writeFile (pomFileName tgtDir) execPom where (Ident clsName) = either error id (mkClassName out) execPom = pomString clsName (takeBaseName out) libs diff --git a/src/IRTS/CodegenJavaScript.hs b/src/IRTS/CodegenJavaScript.hs index 7b2e9106ab..a8f3ea47da 100644 --- a/src/IRTS/CodegenJavaScript.hs +++ b/src/IRTS/CodegenJavaScript.hs @@ -23,6 +23,7 @@ import Data.Word import Data.Traversable hiding (mapM) import System.IO import System.Directory +import qualified System.IO.UTF8 as UTF8 import qualified Data.Map.Strict as M @@ -394,10 +395,10 @@ codegenJS_all target definitions includes libs filename outputType = do included <- concat <$> getIncludes includes path <- (++) <$> getDataDir <*> (pure "/jsrts/") - idrRuntime <- readFile $ path ++ "Runtime-common.js" - tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"] + idrRuntime <- UTF8.readFile $ path ++ "Runtime-common.js" + tgtRuntime <- UTF8.readFile $ concat [path, "Runtime", rt, ".js"] jsbn <- if compileInfoNeedsBigInt info - then readFile $ path ++ "jsbn/jsbn.js" + then UTF8.readFile $ path ++ "jsbn/jsbn.js" else return "" let runtime = ( header ++ includeLibs libs @@ -406,7 +407,7 @@ codegenJS_all target definitions includes libs filename outputType = do ++ idrRuntime ++ tgtRuntime ) - writeFile filename ( runtime + UTF8.writeFile filename ( runtime ++ concatMap compileJS opt ++ concatMap compileJS cons ++ main @@ -476,7 +477,7 @@ codegenJS_all target definitions includes libs filename outputType = do concatMap (\lib -> "var " ++ lib ++ " = require(\"" ++ lib ++"\");\n") getIncludes :: [FilePath] -> IO [String] - getIncludes = mapM readFile + getIncludes = mapM UTF8.readFile main :: String main = diff --git a/src/IRTS/Compiler.hs b/src/IRTS/Compiler.hs index 83e4490728..3a3a14107e 100644 --- a/src/IRTS/Compiler.hs +++ b/src/IRTS/Compiler.hs @@ -46,6 +46,7 @@ import System.IO import System.Directory import System.Environment import System.FilePath ((), addTrailingPathSeparator) +import qualified System.IO.UTF8 as UTF8 compile :: Codegen -> FilePath -> Term -> Idris () compile codegen f tm @@ -78,10 +79,10 @@ compile codegen f tm dumpDefun <- getDumpDefun case dumpCases of Nothing -> return () - Just f -> runIO $ writeFile f (showCaseTrees defs) + Just f -> runIO $ UTF8.writeFile f (showCaseTrees defs) case dumpDefun of Nothing -> return () - Just f -> runIO $ writeFile f (dumpDefuns defuns) + Just f -> runIO $ UTF8.writeFile f (dumpDefuns defuns) triple <- Idris.AbsSyntax.targetTriple cpu <- Idris.AbsSyntax.targetCPU optimise <- optLevel diff --git a/src/IRTS/DumpBC.hs b/src/IRTS/DumpBC.hs index 19c82eaefb..10fe5c19b0 100644 --- a/src/IRTS/DumpBC.hs +++ b/src/IRTS/DumpBC.hs @@ -6,6 +6,7 @@ import Idris.Core.TT import IRTS.Bytecode import Data.List +import qualified System.IO.UTF8 as UTF8 interMap :: [a] -> [b] -> (a -> [b]) -> [b] interMap xs y f = concat (intersperse y (map f xs)) @@ -73,4 +74,4 @@ serialize decls = show name ++ ":\n" ++ interMap bcs "\n" (serializeBC 1) dumpBC :: [(Name, SDecl)] -> String -> IO () -dumpBC c output = writeFile output $ serialize $ map toBC c +dumpBC c output = UTF8.writeFile output $ serialize $ map toBC c diff --git a/src/Idris/Chaser.hs b/src/Idris/Chaser.hs index c581ee1ff6..cc545087e8 100644 --- a/src/Idris/Chaser.hs +++ b/src/Idris/Chaser.hs @@ -13,6 +13,7 @@ import Data.Time.Clock import Control.Monad.Trans import Control.Monad.State import Data.List +import qualified System.IO.UTF8 as UTF8 import Debug.Trace @@ -129,7 +130,7 @@ buildTree built fp = btree [] fp children lit f done = -- idrisCatch do exist <- runIO $ doesFileExist f if exist then do - file_in <- runIO $ readFile f + file_in <- runIO $ UTF8.readFile f file <- if lit then tclift $ unlit f file_in else return file_in (_, modules, _) <- parseImports f file -- The chaser should never report warnings from sub-modules diff --git a/src/Idris/Core/Execute.hs b/src/Idris/Core/Execute.hs index 2ca1fd14ab..0d897c5f9e 100644 --- a/src/Idris/Core/Execute.hs +++ b/src/Idris/Core/Execute.hs @@ -36,6 +36,7 @@ import Foreign.Ptr #endif import System.IO +import qualified System.IO.UTF8 as UTF8 #ifndef IDRIS_FFI execute :: Term -> Idris Term @@ -244,7 +245,7 @@ execApp env ctxt (EP _ fp _) (_:fn:_:handle:_:rest) | fp == mkfprim, Just (FFun "idris_readStr" _ _) <- foreignFromTT fn = case handle of - EHandle h -> do contents <- execIO $ hGetLine h + EHandle h -> do contents <- execIO $ UTF8.hGetLine h execApp env ctxt (EConstant (Str (contents ++ "\n"))) rest _ -> execFail . Msg $ "The argument to idris_readStr should be a handle, but it was " ++ @@ -395,7 +396,7 @@ getOp fn [EP _ fn' _] return (EConstant (Str line)) getOp fn [EHandle h] | fn == prs = - Just $ do contents <- execIO $ hGetLine h + Just $ do contents <- execIO $ UTF8.hGetLine h return (EConstant (Str (contents ++ "\n"))) getOp n args = getPrim n primitives >>= flip applyPrim args where getPrim :: Name -> [Prim] -> Maybe ([ExecVal] -> Maybe ExecVal) diff --git a/src/Idris/IdrisDoc.hs b/src/Idris/IdrisDoc.hs index f34b924662..5f30b777a9 100644 --- a/src/Idris/IdrisDoc.hs +++ b/src/Idris/IdrisDoc.hs @@ -31,6 +31,7 @@ import qualified Data.Map as M hiding ((!)) import qualified Data.Ord (compare) import qualified Data.Set as S import qualified Data.Text as T +import qualified System.IO.UTF8 as UTF8 import System.IO import System.IO.Error @@ -381,7 +382,7 @@ createDocs ist nsd out = createIndex nss out -- Create an empty IdrisDoc file to signal 'out' is used for IdrisDoc if new -- But only if it not already existed... - then withFile (out "IdrisDoc") WriteMode ((flip hPutStr) "") + then withFile (out "IdrisDoc") WriteMode ((flip UTF8.hPutStr) "") else return () copyDependencies out return $ Right () diff --git a/src/Idris/Interactive.hs b/src/Idris/Interactive.hs index 07fb601d02..b2bae02768 100644 --- a/src/Idris/Interactive.hs +++ b/src/Idris/Interactive.hs @@ -22,14 +22,15 @@ import Util.System import System.FilePath import System.Directory -import System.IO +import System.IO (Handle(..)) import Data.Char import Data.Maybe (fromMaybe) +import qualified System.IO.UTF8 as UTF8 caseSplitAt :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () caseSplitAt h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn res <- splitOnLine l n fn iLOG (showSep "\n" (map show res)) let (before, (ap : later)) = splitAt (l-1) (lines src) @@ -37,14 +38,14 @@ caseSplitAt h fn updatefile l n let new = concat res' if updatefile then do let fb = fn ++ "~" -- make a backup! - runIO $ writeFile fb (unlines before ++ new ++ unlines later) + runIO $ UTF8.writeFile fb (unlines before ++ new ++ unlines later) runIO $ copyFile fb fn else -- do ihputStrLn h (show res) ihPrintResult h new addClauseFrom :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () addClauseFrom h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) let indent = getIndent 0 (show n) tyline cl <- getClause l n fn @@ -52,7 +53,7 @@ addClauseFrom h fn updatefile l n let (nonblank, rest) = span (not . all isSpace) (tyline:later) if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (unlines (before ++ nonblank) ++ + runIO $ UTF8.writeFile fb (unlines (before ++ nonblank) ++ replicate indent ' ' ++ cl ++ "\n" ++ unlines rest) @@ -66,7 +67,7 @@ addClauseFrom h fn updatefile l n addProofClauseFrom :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () addProofClauseFrom h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) let indent = getIndent 0 (show n) tyline cl <- getProofClause l n fn @@ -74,7 +75,7 @@ addProofClauseFrom h fn updatefile l n let (nonblank, rest) = span (not . all isSpace) (tyline:later) if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (unlines (before ++ nonblank) ++ + runIO $ UTF8.writeFile fb (unlines (before ++ nonblank) ++ replicate indent ' ' ++ cl ++ "\n" ++ unlines rest) @@ -87,7 +88,7 @@ addProofClauseFrom h fn updatefile l n addMissing :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () addMissing h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) let indent = getIndent 0 (show n) tyline i <- getIState @@ -101,7 +102,7 @@ addMissing h fn updatefile l n let (nonblank, rest) = span (not . all isSpace) (tyline:later) if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (unlines (before ++ nonblank) + runIO $ UTF8.writeFile fb (unlines (before ++ nonblank) ++ extras ++ unlines rest) runIO $ copyFile fb fn else ihPrintResult h extras @@ -133,7 +134,7 @@ addMissing h fn updatefile l n makeWith :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () makeWith h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) let ind = getIndent tyline let with = mkWith tyline n @@ -143,7 +144,7 @@ makeWith h fn updatefile l n not (ind == getIndent x)) later if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (unlines (before ++ nonblank) + runIO $ UTF8.writeFile fb (unlines (before ++ nonblank) ++ with ++ "\n" ++ unlines rest) runIO $ copyFile fb fn @@ -156,7 +157,7 @@ doProofSearch :: Handle -> FilePath -> Bool -> Bool -> doProofSearch h fn updatefile rec l n hints Nothing = doProofSearch h fn updatefile rec l n hints (Just 10) doProofSearch h fn updatefile rec l n hints (Just depth) - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) ctxt <- getContext mn <- case lookupNames n ctxt of @@ -184,7 +185,7 @@ doProofSearch h fn updatefile rec l n hints (Just depth) (\e -> return ("?" ++ show n)) if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (unlines before ++ + runIO $ UTF8.writeFile fb (unlines before ++ updateMeta False tyline (show n) newmv ++ "\n" ++ unlines later) runIO $ copyFile fb fn @@ -233,7 +234,7 @@ addBracket True new | any isSpace new = '(' : new ++ ")" makeLemma :: Handle -> FilePath -> Bool -> Int -> Name -> Idris () makeLemma h fn updatefile l n - = do src <- runIO $ readFile fn + = do src <- runIO $ UTF8.readFile fn let (before, tyline : later) = splitAt (l-1) (lines src) -- if the name is in braces, rather than preceded by a ?, treat it @@ -256,7 +257,7 @@ makeLemma h fn updatefile l n if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (addLem before tyline lem lem_app later) + runIO $ UTF8.writeFile fb (addLem before tyline lem lem_app later) runIO $ copyFile fb fn else case idris_outputmode i of RawOutput -> ihPrintResult h $ lem ++ "\n" ++ lem_app @@ -267,14 +268,14 @@ makeLemma h fn updatefile l n StringAtom lem_app], SexpList [SymbolAtom "definition-type", StringAtom lem]]] - in runIO . hPutStrLn h $ convSExp "return" good n + in runIO . UTF8.hPutStrLn h $ convSExp "return" good n else do -- provisional definition let lem_app = show n ++ appArgs [] mty ++ " = ?" ++ show n ++ "_rhs" if updatefile then do let fb = fn ++ "~" - runIO $ writeFile fb (addProv before tyline lem_app later) + runIO $ UTF8.writeFile fb (addProv before tyline lem_app later) runIO $ copyFile fb fn else case idris_outputmode i of RawOutput -> ihPrintResult h $ lem_app @@ -283,7 +284,7 @@ makeLemma h fn updatefile l n SexpList [SymbolAtom "provisional-definition-lemma", SexpList [SymbolAtom "definition-clause", StringAtom lem_app]]] - in runIO . hPutStrLn h $ convSExp "return" good n + in runIO . UTF8.hPutStrLn h $ convSExp "return" good n where getIndent s = length (takeWhile isSpace s) diff --git a/src/Idris/Parser.hs b/src/Idris/Parser.hs index b6a2a5db01..2947c2eb8b 100644 --- a/src/Idris/Parser.hs +++ b/src/Idris/Parser.hs @@ -68,7 +68,9 @@ import qualified Data.Set as S import Debug.Trace import System.FilePath -import System.IO +import System.IO (Handle(..)) +import qualified System.IO.UTF8 as UTF8 + {- @ @@ -1233,7 +1235,7 @@ loadSource h lidr f toline = do iLOG ("Reading " ++ f) i <- getIState let def_total = default_total i - file_in <- runIO $ readFile f + file_in <- runIO $ UTF8.readFile f file <- if lidr then tclift $ unlit f file_in else return file_in (mname, imports, pos) <- parseImports f file ids <- allImportDirs diff --git a/src/Idris/REPL.hs b/src/Idris/REPL.hs index 4262a33653..ee0157847f 100644 --- a/src/Idris/REPL.hs +++ b/src/Idris/REPL.hs @@ -51,6 +51,7 @@ import IRTS.System import Data.List.Split (splitOn) import qualified Data.Text as T +import qualified System.IO.UTF8 as UTF8 import Text.Trifecta.Result(Result(..)) @@ -151,7 +152,7 @@ startServer orig fn_in = do tid <- runIO $ forkOS serverLoop loop fn ist sock = do (h,_,_) <- accept sock - cmd <- hGetLine h + cmd <- UTF8.hGetLine h (ist', fn) <- processNetCmd orig ist h fn cmd hClose h loop fn ist' sock @@ -164,7 +165,7 @@ processNetCmd orig i h fn cmd Success c -> runErrorT $ evalStateT (processNet fn c) i case res of Right x -> return x - Left err -> do hPutStrLn h (show err) + Left err -> do UTF8.hPutStrLn h (show err) return (i, fn) where processNet fn Reload = processNet fn (Load fn Nothing) @@ -189,13 +190,13 @@ processNetCmd orig i h fn cmd runClient :: String -> IO () runClient str = withSocketsDo $ do h <- connectTo "localhost" (PortNumber 4294) - hPutStrLn h str + UTF8.hPutStrLn h str resp <- hGetResp "" h - putStr resp + UTF8.putStr resp hClose h where hGetResp acc h = do eof <- hIsEOF h if eof then return acc - else do l <- hGetLine h + else do l <- UTF8.hGetLine h hGetResp (acc ++ l ++ "\n") h -- | Run the IdeSlave @@ -246,7 +247,7 @@ runIdeSlaveCommand id orig fn mods (IdeSlave.Interpret cmd) = isetPrompt (mkPrompt mods) case idris_outputmode i of IdeSlave n -> -- signal completion of proof to ide - runIO . hPutStrLn stdout $ + runIO . UTF8.hPutStrLn stdout $ IdeSlave.convSExp "return" (IdeSlave.SymbolAtom "ok", "") n @@ -255,7 +256,7 @@ runIdeSlaveCommand id orig fn mods (IdeSlave.Interpret cmd) = isetPrompt (mkPrompt mods) case idris_outputmode i of IdeSlave n -> - runIO . hPutStrLn stdout $ + runIO . UTF8.hPutStrLn stdout $ IdeSlave.convSExp "abandon-proof" "Abandoned" n _ -> return () ihRenderError stdout $ pprintErr ist e) @@ -838,7 +839,7 @@ process h fn' (AddProof prf) else ifail $ "Neither \""++fn''++"\" nor \""++fnExt++"\" exist" let fb = fn ++ "~" runIO $ copyFile fn fb -- make a backup in case something goes wrong! - prog <- runIO $ readFile fb + prog <- runIO $ UTF8.readFile fb i <- getIState let proofs = proof_list i n' <- case prf of @@ -850,7 +851,7 @@ process h fn' (AddProof prf) case lookup n proofs of Nothing -> iputStrLn "No proof to add" Just p -> do let prog' = insertScript (showProof (lit fn) n p) ls - runIO $ writeFile fn (unlines prog') + runIO $ UTF8.writeFile fn (unlines prog') removeProof n iputStrLn $ "Added proof " ++ show n where ls = (lines prog) @@ -908,7 +909,7 @@ process h fn Execute case idris_outputmode ist of RawOutput -> do runIO $ system tmpn return () - IdeSlave n -> runIO . hPutStrLn h $ + IdeSlave n -> runIO . UTF8.hPutStrLn h $ IdeSlave.convSExp "run-program" tmpn n) (\e -> getIState >>= ihRenderError stdout . flip pprintErr e) where fc = fileFC "main" @@ -1365,7 +1366,7 @@ initScript = do script <- getInitScript runInit h = do eof <- lift . lift $ hIsEOF h ist <- getIState unless eof $ do - line <- runIO $ hGetLine h + line <- runIO $ UTF8.hGetLine h script <- getInitScript c <- colourise processLine ist line script c diff --git a/src/Pkg/PParser.hs b/src/Pkg/PParser.hs index b7e4c13d55..b71b91a8dc 100644 --- a/src/Pkg/PParser.hs +++ b/src/Pkg/PParser.hs @@ -12,7 +12,7 @@ import Idris.CmdOptions import Control.Monad.State.Strict import Control.Applicative - +import qualified System.IO.UTF8 as UTF8 type PParser = StateT PkgDesc IdrisInnerParser @@ -36,7 +36,7 @@ instance TokenParsing PParser where defaultPkg = PkgDesc "" [] [] Nothing [] "" [] (sUN "") Nothing [] parseDesc :: FilePath -> IO PkgDesc -parseDesc fp = do p <- readFile fp +parseDesc fp = do p <- UTF8.readFile fp case runparser pPkg defaultPkg fp p of Failure err -> fail (show err) Success x -> return x diff --git a/src/Pkg/Package.hs b/src/Pkg/Package.hs index 5d8f2813e0..c9c3246ae2 100644 --- a/src/Pkg/Package.hs +++ b/src/Pkg/Package.hs @@ -7,6 +7,7 @@ import System.Exit import System.IO import System.FilePath ((), addTrailingPathSeparator, takeFileName, takeDirectory, normalise) import System.Directory (createDirectoryIfMissing, copyFile) +import qualified System.IO.UTF8 as UTF8 import Util.System @@ -168,7 +169,7 @@ testPkg fp make (makefile pkgdesc) -- Get a temporary file to save the tests' source in (tmpn, tmph) <- tempIdr - hPutStrLn tmph $ + UTF8.hPutStrLn tmph $ "module Test_______\n" ++ concat ["import " ++ show m ++ "\n" | m <- modules pkgdesc] ++