~ubuntu-branches/ubuntu/raring/agda/raring-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Interaction/FindFile.hs

  • Committer: Bazaar Package Importer
  • Author(s): Iain Lane
  • Date: 2010-01-05 23:43:20 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20100105234320-6ksc0sdsfhtweknu
Tags: 2.2.6-1
* New upstream release 2.2.6, for headlines please see:
  http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Main.Version-2-2-6
* debian/control
  + Bump standards-version to 3.8.3, no changes
  + Fix Vcs-Git to point to correct URL
  + Update build-depends for new upstream release
  + Undo arch/indep split per current pkg-haskell practice
  + Add Homepage field
* debian/copyright: Fix encoding to UTF-8 (thanks Lintian) 
* debian/README.source: Remove, no repacking so not necessary any more 
* debian/50agda.el:
  + Only load file if it exists, prevents a non-intrusive emacs warning
    where 50agda.el is left on system when package is removed. 
    (Closes: #559197). 
  + Do not load file on XEmacs — agda-mode is not compatible with XEmacs.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
------------------------------------------------------------------------
 
2
-- | Functions which map between module names and file names.
 
3
--
 
4
-- Note that file name lookups are cached in the 'TCState'. The code
 
5
-- assumes that no Agda source files are added or removed from the
 
6
-- include directories while the code is being type checked.
 
7
------------------------------------------------------------------------
 
8
 
 
9
module Agda.Interaction.FindFile
 
10
  ( toIFile
 
11
  , FindError(..), findErrorToTypeError
 
12
  , findFile, findFile', findFile''
 
13
  , findInterfaceFile
 
14
  , checkModuleName
 
15
  , ModuleToSource
 
16
  , SourceToModule, sourceToModule
 
17
  , tests
 
18
  ) where
 
19
 
 
20
import Control.Applicative
 
21
import Control.Monad
 
22
import Control.Monad.State.Class
 
23
import Control.Monad.Trans
 
24
import Data.List
 
25
import Data.Map (Map)
 
26
import qualified Data.Map as Map
 
27
import System.FilePath
 
28
import System.Directory
 
29
 
 
30
import Agda.Syntax.Concrete.Name
 
31
import Agda.TypeChecking.Monad
 
32
import Agda.Utils.FileName
 
33
import Agda.Utils.Monad
 
34
 
 
35
-- | Converts an Agda file name to the corresponding interface file
 
36
-- name.
 
37
 
 
38
toIFile :: AbsolutePath -> AbsolutePath
 
39
toIFile f = mkAbsolute (replaceExtension (filePath f) ".agdai")
 
40
 
 
41
-- | Errors which can arise when trying to find a source file.
 
42
--
 
43
-- Invariant: All paths are absolute.
 
44
 
 
45
data FindError
 
46
  = NotFound [AbsolutePath]
 
47
    -- ^ The file was not found. It should have had one of the given
 
48
    -- file names.
 
49
  | Ambiguous [AbsolutePath]
 
50
    -- ^ Several matching files were found.
 
51
    --
 
52
    -- Invariant: The list of matching files has at least two
 
53
    -- elements.
 
54
 
 
55
-- | Given the module name which the error applies to this function
 
56
-- converts a 'FindError' to a 'TypeError'.
 
57
 
 
58
findErrorToTypeError :: TopLevelModuleName -> FindError -> TypeError
 
59
findErrorToTypeError m (NotFound  files) = FileNotFound m files
 
60
findErrorToTypeError m (Ambiguous files) =
 
61
  AmbiguousTopLevelModuleName m files
 
62
 
 
63
-- | Finds the source file corresponding to a given top-level module
 
64
-- name. The returned paths are absolute.
 
65
--
 
66
-- Raises an error if the file cannot be found.
 
67
 
 
68
findFile :: TopLevelModuleName -> TCM AbsolutePath
 
69
findFile m = do
 
70
  mf <- findFile' m
 
71
  case mf of
 
72
    Left err -> typeError $ findErrorToTypeError m err
 
73
    Right f  -> return f
 
74
 
 
75
-- | Tries to find the source file corresponding to a given top-level
 
76
-- module name. The returned paths are absolute.
 
77
 
 
78
findFile' :: TopLevelModuleName -> TCM (Either FindError AbsolutePath)
 
79
findFile' m = do
 
80
    dirs         <- getIncludeDirs
 
81
    modFile      <- stModuleToSource <$> get
 
82
    (r, modFile) <- liftIO $ findFile'' dirs m modFile
 
83
    modify $ \s -> s { stModuleToSource = modFile }
 
84
    return r
 
85
 
 
86
-- | A variant of 'findFile'' which does not require 'TCM'.
 
87
 
 
88
findFile''
 
89
  :: [AbsolutePath]
 
90
  -- ^ Include paths.
 
91
  -> TopLevelModuleName
 
92
  -> ModuleToSource
 
93
  -- ^ Cached invocations of 'findFile'''. An updated copy is returned.
 
94
  -> IO (Either FindError AbsolutePath, ModuleToSource)
 
95
findFile'' dirs m modFile =
 
96
    case Map.lookup m modFile of
 
97
      Just f  -> return (Right f, modFile)
 
98
      Nothing -> do
 
99
        existingFiles <-
 
100
          liftIO $ filterM (doesFileExist . filePath) files
 
101
        return $ case nub existingFiles of
 
102
          []     -> (Left (NotFound files), modFile)
 
103
          [file] -> (Right file, Map.insert m file modFile)
 
104
          files  -> (Left (Ambiguous files), modFile)
 
105
    where
 
106
    files = [ mkAbsolute (filePath dir </> file)
 
107
            | dir  <- dirs
 
108
            , file <- map (moduleNameToFileName m) [".agda", ".lagda"]
 
109
            ]
 
110
 
 
111
-- | Finds the interface file corresponding to a given top-level
 
112
-- module name. The returned paths are absolute.
 
113
--
 
114
-- Raises an error if the source file cannot be found, and returns
 
115
-- 'Nothing' if the source file can be found but not the interface
 
116
-- file.
 
117
 
 
118
findInterfaceFile :: TopLevelModuleName -> TCM (Maybe AbsolutePath)
 
119
findInterfaceFile m = do
 
120
  f  <- toIFile <$> findFile m
 
121
  ex <- liftIO $ doesFileExist $ filePath f
 
122
  return $ if ex then Just f else Nothing
 
123
 
 
124
-- | Ensures that the module name matches the file name. The file
 
125
-- corresponding to the module name (according to the include path)
 
126
-- has to be the same as the given file name.
 
127
 
 
128
checkModuleName :: TopLevelModuleName
 
129
                   -- ^ The name of the module.
 
130
                -> AbsolutePath
 
131
                   -- ^ The file from which it was loaded.
 
132
                -> TCM ()
 
133
checkModuleName name file = do
 
134
  moduleShouldBeIn <- findFile' name
 
135
  case moduleShouldBeIn of
 
136
    Left (NotFound files)  -> typeError $
 
137
                                ModuleNameDoesntMatchFileName name files
 
138
    Left (Ambiguous files) -> typeError $
 
139
                                AmbiguousTopLevelModuleName name files
 
140
    Right file' ->
 
141
      ifM (liftIO $ filePath file === filePath file')
 
142
          (return ())
 
143
          (typeError $ ModuleDefinedInOtherFile name file file')
 
144
 
 
145
-- | Maps top-level module names to the corresponding source file
 
146
-- names.
 
147
 
 
148
type ModuleToSource = Map TopLevelModuleName AbsolutePath
 
149
 
 
150
-- | Maps source file names to the corresponding top-level module
 
151
-- names.
 
152
 
 
153
type SourceToModule = Map AbsolutePath TopLevelModuleName
 
154
 
 
155
-- | Creates a 'SourceToModule' map based on 'stModuleToSource'.
 
156
 
 
157
sourceToModule :: TCM SourceToModule
 
158
sourceToModule =
 
159
  Map.fromList
 
160
     .  map (\(m, f) -> (f, m))
 
161
     .  Map.toList
 
162
     .  stModuleToSource
 
163
    <$> get