f20f461 · Idris-dev · git.iko.soy

src/Idris/Chaser.hs+1−1

compare with master

unifiedsplit

@@ -82,7 +82,7 @@ buildTree built fp = btree [] fp

82 iLOG $ "CHASING " ++ show file

83 ibcsd <- valIBCSubDir i

84 ids <- allImportDirs

85− fp <- runIO $ findImport ids ibcsd file

85+ fp <- findImport ids ibcsd file

86 iLOG $ "Found " ++ show fp

87 mt <- runIO $ getIModTime fp

88 if (file `elem` built)

src/Idris/IBC.hs+1−1

@@ -300,7 +300,7 @@ pImports fs

300 = do mapM_ (\f -> do i <- getIState

301 ibcsd <- valIBCSubDir i

302 ids <- allImportDirs

303− fp <- runIO $ findImport ids ibcsd f

303+ fp <- findImport ids ibcsd f

304 if (f `elem` imported i)

305 then iLOG $ "Already read " ++ f

306 else do putIState (i { imported = f : imported i })

src/Idris/Imports.hs+7−6

@@ -1,6 +1,7 @@

1module Idris.Imports where

2

3import Idris.AbsSyntax

4+import Idris.Error

4

5

5import Idris.Core.TT

6import Idris.Core.TT

6import Paths_idris

7import Paths_idris

@@ -43,15 +44,15 @@ ibcPathWithFallback ibcsd fp = do let ibcp = ibcPath ibcsd True fp

43ibcPathNoFallback :: FilePath -> FilePath -> FilePath

44ibcPathNoFallback :: FilePath -> FilePath -> FilePath

44ibcPathNoFallback ibcsd fp = ibcPath ibcsd True fp

45ibcPathNoFallback ibcsd fp = ibcPath ibcsd True fp

45

46

46−findImport :: [FilePath] -> FilePath -> FilePath -> IO IFileType

47+findImport :: [FilePath] -> FilePath -> FilePath -> Idris IFileType

47−findImport [] ibcsd fp = fail $ "Can't find import " ++ fp

48+findImport [] ibcsd fp = ierror . Msg $ "Can't find import " ++ fp

48findImport (d:ds) ibcsd fp = do let fp_full = d </> fp

49findImport (d:ds) ibcsd fp = do let fp_full = d </> fp

49− ibcp <- ibcPathWithFallback ibcsd fp_full

50+ ibcp <- runIO $ ibcPathWithFallback ibcsd fp_full

50 let idrp = srcPath fp_full

51 let idrp = srcPath fp_full

51 let lidrp = lsrcPath fp_full

52 let lidrp = lsrcPath fp_full

52− ibc <- doesFileExist ibcp

53+ ibc <- runIO $ doesFileExist ibcp

53− idr <- doesFileExist idrp

54+ idr <- runIO $ doesFileExist idrp

54− lidr <- doesFileExist lidrp

55+ lidr <- runIO $ doesFileExist lidrp

55-- when idr $ putStrLn $ idrp ++ " ok"

56-- when idr $ putStrLn $ idrp ++ " ok"

56-- when lidr $ putStrLn $ lidrp ++ " ok"

57-- when lidr $ putStrLn $ lidrp ++ " ok"

57-- when ibc $ putStrLn $ ibcp ++ " ok"

58-- when ibc $ putStrLn $ ibcp ++ " ok"

src/Idris/Output.hs+3−1

@@ -23,7 +23,9 @@ ihWarn h fc err = do i <- getIState

23 case idris_outputmode i of

24 RawOutput ->

25 do err' <- iRender . fmap (fancifyAnnots i) $

26+ if fc_fname fc /= ""

26− text (show fc) <> colon <//> err

27+ then text (show fc) <> colon <//> err

28+ else err

27 runIO . hPutStrLn h $ displayDecorated (consoleDecorate i) err'

29 runIO . hPutStrLn h $ displayDecorated (consoleDecorate i) err'

28 IdeSlave n ->

30 IdeSlave n ->

29 do err' <- iRender . fmap (fancifyAnnots i) $ err

31 do err' <- iRender . fmap (fancifyAnnots i) $ err

src/Idris/Parser.hs+6−5

@@ -1158,8 +1158,7 @@ loadModule outh f

1158 = idrisCatch (loadModule' outh f)

1159 (\e -> do setErrSpan (getErrSpan e)

1160 ist <- getIState

1161− msg <- showErr e

1161+ ihWarn outh (getErrSpan e) $ pprintErr ist e

1162− ihputStrLn outh msg

1163 return "")

1162 return "")

1164

1163

1165{- | Load idris module -}

1164{- | Load idris module -}

@@ -1169,7 +1168,7 @@ loadModule' outh f

1169 let file = takeWhile (/= ' ') f

1168 let file = takeWhile (/= ' ') f

1170 ibcsd <- valIBCSubDir i

1169 ibcsd <- valIBCSubDir i

1171 ids <- allImportDirs

1170 ids <- allImportDirs

1172− fp <- liftIO $ findImport ids ibcsd file

1171+ fp <- findImport ids ibcsd file

1173 if file `elem` imported i

1172 if file `elem` imported i

1174 then iLOG $ "Already read " ++ file

1173 then iLOG $ "Already read " ++ file

1175 else do putIState (i { imported = file : imported i })

1174 else do putIState (i { imported = file : imported i })

@@ -1206,7 +1205,9 @@ loadSource' h lidr r

1206 = idrisCatch (loadSource h lidr r)

1205 = idrisCatch (loadSource h lidr r)

1207 (\e -> do setErrSpan (getErrSpan e)

1206 (\e -> do setErrSpan (getErrSpan e)

1208 ist <- getIState

1207 ist <- getIState

1208+ case e of

1209+ At f e' -> ihWarn h f (pprintErr ist e')

1209− ihRenderError h (pprintErr ist e))

1210+ _ -> ihWarn h (getErrSpan e) (pprintErr ist e))

1210

1211

1211{- | Load Idris source code-}

1212{- | Load Idris source code-}

1212loadSource :: Handle -> Bool -> FilePath -> Idris ()

1213loadSource :: Handle -> Bool -> FilePath -> Idris ()

@@ -1219,7 +1220,7 @@ loadSource h lidr f

1219 (mname, imports, pos) <- parseImports f file

1220 (mname, imports, pos) <- parseImports f file

1220 ids <- allImportDirs

1221 ids <- allImportDirs

1221 ibcsd <- valIBCSubDir i

1222 ibcsd <- valIBCSubDir i

1222− mapM_ (\f -> do fp <- runIO $ findImport ids ibcsd f

1223+ mapM_ (\f -> do fp <- findImport ids ibcsd f

1223 case fp of

1224 case fp of

1224 LIDR fn -> ifail $ "No ibc for " ++ f

1225 LIDR fn -> ifail $ "No ibc for " ++ f

1225 IDR fn -> ifail $ "No ibc for " ++ f

1226 IDR fn -> ifail $ "No ibc for " ++ f

src/Idris/REPL.hs+3−3

@@ -1259,11 +1259,11 @@ loadInputs h inputs

1259 idris_patdefs = patdefs }))

1260 (\e -> do i <- getIState

1261 case e of

1262− At f _ -> do setErrSpan f

1262+ At f e' -> do setErrSpan f

1263− ihRenderError stdout $ pprintErr i e

1263+ ihWarn stdout f $ pprintErr i e'

1264 ProgramLineComment -> return () -- fail elsewhere

1265 _ -> do setErrSpan emptyFC -- FIXME! Propagate it

1266− iputStrLn (pshow i e))

1266+ ihWarn stdout emptyFC $ pprintErr i e)

1267 where -- load all files, stop if any fail

1268 tryLoad :: Bool -> [IFileType] -> Idris ()

1269 tryLoad keepstate [] = return ()