{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
-- | Module location
module GHC.Unit.Module.Location
   ( ModLocation
    ( ..
    , ml_hs_file
    , ml_hi_file
    , ml_dyn_hi_file
    , ml_obj_file
    , ml_dyn_obj_file
    , ml_hie_file
    )
   , pattern ModLocation
   , addBootSuffix
   , addBootSuffixLocn
   , addBootSuffixLocnOut
   , removeBootSuffix
   , mkFileSrcSpan
   )
where

import GHC.Prelude

import GHC.Data.OsPath
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Data.FastString (mkFastString)

import qualified System.OsString as OsString

-- | Module Location
--
-- Where a module lives on the file system: the actual locations
-- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them.
--
-- For a module in another unit, the ml_hs_file_ospath and ml_obj_file_ospath components of
-- ModLocation are undefined.
--
-- The locations specified by a ModLocation may or may not
-- correspond to actual files yet: for example, even if the object
-- file doesn't exist, the ModLocation still contains the path to
-- where the object file will reside if/when it is created.
--
-- The paths of anything which can affect recompilation should be placed inside
-- ModLocation.
--
-- When a ModLocation is created none of the filepaths will have -boot suffixes.
-- This is because in --make mode the ModLocation is put in the finder cache which
-- is indexed by ModuleName, when a ModLocation is retrieved from the FinderCache
-- the boot suffixes are appended.
-- The other case is in -c mode, there the ModLocation immediately gets given the
-- boot suffixes in mkOneShotModLocation.

data ModLocation
   = OsPathModLocation {
        ModLocation -> Maybe OsPath
ml_hs_file_ospath   :: Maybe OsPath,
                -- ^ The source file, if we have one.  Package modules
                -- probably don't have source files.

        ModLocation -> OsPath
ml_hi_file_ospath   :: OsPath,
                -- ^ Where the .hi file is, whether or not it exists
                -- yet.  Always of form foo.hi, even if there is an
                -- hi-boot file (we add the -boot suffix later)

        ModLocation -> OsPath
ml_dyn_hi_file_ospath :: OsPath,
                -- ^ Where the .dyn_hi file is, whether or not it exists
                -- yet.

        ModLocation -> OsPath
ml_obj_file_ospath  :: OsPath,
                -- ^ Where the .o file is, whether or not it exists yet.
                -- (might not exist either because the module hasn't
                -- been compiled yet, or because it is part of a
                -- unit with a .a file)

        ModLocation -> OsPath
ml_dyn_obj_file_ospath :: OsPath,
                -- ^ Where the .dy file is, whether or not it exists
                -- yet.

        ModLocation -> OsPath
ml_hie_file_ospath  :: OsPath
                -- ^ Where the .hie file is, whether or not it exists
                -- yet.
  } deriving Int -> ModLocation -> ShowS
[ModLocation] -> ShowS
ModLocation -> String
(Int -> ModLocation -> ShowS)
-> (ModLocation -> String)
-> ([ModLocation] -> ShowS)
-> Show ModLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModLocation -> ShowS
showsPrec :: Int -> ModLocation -> ShowS
$cshow :: ModLocation -> String
show :: ModLocation -> String
$cshowList :: [ModLocation] -> ShowS
showList :: [ModLocation] -> ShowS
Show

instance Outputable ModLocation where
   ppr :: ModLocation -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (ModLocation -> String) -> ModLocation -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModLocation -> String
forall a. Show a => a -> String
show

-- | Add the @-boot@ suffix to .hs, .hi and .o files
addBootSuffix :: OsPath -> OsPath
addBootSuffix :: OsPath -> OsPath
addBootSuffix OsPath
path = OsPath
path OsPath -> OsPath -> OsPath
forall a. Monoid a => a -> a -> a
`mappend` String -> OsPath
os String
"-boot"

-- | Remove the @-boot@ suffix to .hs, .hi and .o files
removeBootSuffix :: OsPath -> OsPath
removeBootSuffix :: OsPath -> OsPath
removeBootSuffix OsPath
pathWithBootSuffix =
  case OsPath -> OsPath -> Maybe OsPath
OsString.stripSuffix (String -> OsPath
os String
"-boot") OsPath
pathWithBootSuffix of
    Just OsPath
path -> OsPath
path
    Maybe OsPath
Nothing -> String -> OsPath
forall a. HasCallStack => String -> a
error String
"removeBootSuffix: no -boot suffix"

-- | Add the @-boot@ suffix to all file paths associated with the module
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn ModLocation
locn
  = ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) }

-- | Add the @-boot@ suffix to all output file paths associated with the
-- module, not including the input file itself
addBootSuffixLocnOut :: ModLocation -> ModLocation
addBootSuffixLocnOut :: ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
locn
  = ModLocation
locn { ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn)
         , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn)
         , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn)
         , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn)
         , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn)
         }

-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan ModLocation
mod_loc
  = case ModLocation -> Maybe String
ml_hs_file ModLocation
mod_loc of
      Just String
file_path -> FastString -> SrcSpan
mkGeneralSrcSpan (String -> FastString
mkFastString String
file_path)
      Maybe String
Nothing        -> SrcSpan
interactiveSrcSpan   -- Presumably

-- ----------------------------------------------------------------------------
-- Helpers for backwards compatibility
-- ----------------------------------------------------------------------------

{-# COMPLETE ModLocation #-}

pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> ModLocation
pattern $mModLocation :: forall {r}.
ModLocation
-> (Maybe String
    -> String -> String -> String -> String -> String -> r)
-> ((# #) -> r)
-> r
$bModLocation :: Maybe String
-> String -> String -> String -> String -> String -> ModLocation
ModLocation
  { ModLocation -> Maybe String
ml_hs_file
  , ModLocation -> String
ml_hi_file
  , ModLocation -> String
ml_dyn_hi_file
  , ModLocation -> String
ml_obj_file
  , ModLocation -> String
ml_dyn_obj_file
  , ModLocation -> String
ml_hie_file
  } <- OsPathModLocation
    { ml_hs_file_ospath = (fmap unsafeDecodeUtf -> ml_hs_file)
    , ml_hi_file_ospath = (unsafeDecodeUtf -> ml_hi_file)
    , ml_dyn_hi_file_ospath = (unsafeDecodeUtf -> ml_dyn_hi_file)
    , ml_obj_file_ospath = (unsafeDecodeUtf -> ml_obj_file)
    , ml_dyn_obj_file_ospath = (unsafeDecodeUtf -> ml_dyn_obj_file)
    , ml_hie_file_ospath = (unsafeDecodeUtf -> ml_hie_file)
    } where
      ModLocation Maybe String
ml_hs_file String
ml_hi_file String
ml_dyn_hi_file String
ml_obj_file String
ml_dyn_obj_file String
ml_hie_file
        = OsPathModLocation
          { ml_hs_file_ospath :: Maybe OsPath
ml_hs_file_ospath = (String -> OsPath) -> Maybe String -> Maybe OsPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf Maybe String
ml_hs_file
          , ml_hi_file_ospath :: OsPath
ml_hi_file_ospath = HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf String
ml_hi_file
          , ml_dyn_hi_file_ospath :: OsPath
ml_dyn_hi_file_ospath = HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf String
ml_dyn_hi_file
          , ml_obj_file_ospath :: OsPath
ml_obj_file_ospath = HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf String
ml_obj_file
          , ml_dyn_obj_file_ospath :: OsPath
ml_dyn_obj_file_ospath = HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf String
ml_dyn_obj_file
          , ml_hie_file_ospath :: OsPath
ml_hie_file_ospath = HasCallStack => String -> OsPath
String -> OsPath
unsafeEncodeUtf String
ml_hie_file
          }