never executed always true always false
1 -- | Module location
2 module GHC.Unit.Module.Location
3 ( ModLocation(..)
4 , addBootSuffix
5 , addBootSuffix_maybe
6 , addBootSuffixLocn_maybe
7 , addBootSuffixLocn
8 , addBootSuffixLocnOut
9 , removeBootSuffix
10 )
11 where
12
13 import GHC.Prelude
14 import GHC.Unit.Types
15 import GHC.Utils.Outputable
16
17 -- | Module Location
18 --
19 -- Where a module lives on the file system: the actual locations
20 -- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them.
21 --
22 -- For a module in another unit, the ml_hs_file and ml_obj_file components of
23 -- ModLocation are undefined.
24 --
25 -- The locations specified by a ModLocation may or may not
26 -- correspond to actual files yet: for example, even if the object
27 -- file doesn't exist, the ModLocation still contains the path to
28 -- where the object file will reside if/when it is created.
29 --
30 -- The paths of anything which can affect recompilation should be placed inside
31 -- ModLocation.
32 --
33 -- When a ModLocation is created none of the filepaths will have -boot suffixes.
34 -- This is because in --make mode the ModLocation is put in the finder cache which
35 -- is indexed by ModuleName, when a ModLocation is retrieved from the FinderCache
36 -- the boot suffixes are appended.
37 -- The other case is in -c mode, there the ModLocation immediately gets given the
38 -- boot suffixes in mkOneShotModLocation.
39
40 data ModLocation
41 = ModLocation {
42 ml_hs_file :: Maybe FilePath,
43 -- ^ The source file, if we have one. Package modules
44 -- probably don't have source files.
45
46 ml_hi_file :: FilePath,
47 -- ^ Where the .hi file is, whether or not it exists
48 -- yet. Always of form foo.hi, even if there is an
49 -- hi-boot file (we add the -boot suffix later)
50
51 ml_dyn_hi_file :: FilePath,
52 -- ^ Where the .dyn_hi file is, whether or not it exists
53 -- yet.
54
55 ml_obj_file :: FilePath,
56 -- ^ Where the .o file is, whether or not it exists yet.
57 -- (might not exist either because the module hasn't
58 -- been compiled yet, or because it is part of a
59 -- unit with a .a file)
60
61 ml_dyn_obj_file :: FilePath,
62 -- ^ Where the .dy file is, whether or not it exists
63 -- yet.
64
65 ml_hie_file :: FilePath
66 -- ^ Where the .hie file is, whether or not it exists
67 -- yet.
68 } deriving Show
69
70 instance Outputable ModLocation where
71 ppr = text . show
72
73 -- | Add the @-boot@ suffix to .hs, .hi and .o files
74 addBootSuffix :: FilePath -> FilePath
75 addBootSuffix path = path ++ "-boot"
76
77 -- | Remove the @-boot@ suffix to .hs, .hi and .o files
78 removeBootSuffix :: FilePath -> FilePath
79 removeBootSuffix "-boot" = []
80 removeBootSuffix (x:xs) = x : removeBootSuffix xs
81 removeBootSuffix [] = error "removeBootSuffix: no -boot suffix"
82
83
84 -- | Add the @-boot@ suffix if the @Bool@ argument is @True@
85 addBootSuffix_maybe :: IsBootInterface -> FilePath -> FilePath
86 addBootSuffix_maybe is_boot path = case is_boot of
87 IsBoot -> addBootSuffix path
88 NotBoot -> path
89
90 addBootSuffixLocn_maybe :: IsBootInterface -> ModLocation -> ModLocation
91 addBootSuffixLocn_maybe is_boot locn = case is_boot of
92 IsBoot -> addBootSuffixLocn locn
93 _ -> locn
94
95 -- | Add the @-boot@ suffix to all file paths associated with the module
96 addBootSuffixLocn :: ModLocation -> ModLocation
97 addBootSuffixLocn locn
98 = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
99 , ml_hi_file = addBootSuffix (ml_hi_file locn)
100 , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
101 , ml_obj_file = addBootSuffix (ml_obj_file locn)
102 , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
103 , ml_hie_file = addBootSuffix (ml_hie_file locn) }
104
105 -- | Add the @-boot@ suffix to all output file paths associated with the
106 -- module, not including the input file itself
107 addBootSuffixLocnOut :: ModLocation -> ModLocation
108 addBootSuffixLocnOut locn
109 = locn { ml_hi_file = addBootSuffix (ml_hi_file locn)
110 , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
111 , ml_obj_file = addBootSuffix (ml_obj_file locn)
112 , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
113 , ml_hie_file = addBootSuffix (ml_hie_file locn)
114 }
115
116