module GHC.Types.SourceFile
   ( HscSource(..)
   , hscSourceToIsBoot
   , isHsBootOrSig
   , isHsigFile
   , hscSourceString
   )
where

import GHC.Prelude
import GHC.Utils.Binary
import GHC.Unit.Types

-- Note [HscSource types]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- There are three types of source file for Haskell code:
--
--      * HsSrcFile is an ordinary hs file which contains code,
--
--      * HsBootFile is an hs-boot file, which is used to break
--        recursive module imports (there will always be an
--        HsSrcFile associated with it), and
--
--      * HsigFile is an hsig file, which contains only type
--        signatures and is used to specify signatures for
--        modules.
--
-- Syntactically, hs-boot files and hsig files are quite similar: they
-- only include type signatures and must be associated with an
-- actual HsSrcFile.  isHsBootOrSig allows us to abstract over code
-- which is indifferent to which.  However, there are some important
-- differences, mostly owing to the fact that hsigs are proper
-- modules (you `import Sig` directly) whereas HsBootFiles are
-- temporary placeholders (you `import {-# SOURCE #-} Mod).
-- When we finish compiling the true implementation of an hs-boot,
-- we replace the HomeModInfo with the real HsSrcFile.  An HsigFile, on the
-- other hand, is never replaced (in particular, we *cannot* use the
-- HomeModInfo of the original HsSrcFile backing the signature, since it
-- will export too many symbols.)
--
-- Additionally, while HsSrcFile is the only Haskell file
-- which has *code*, we do generate .o files for HsigFile, because
-- this is how the recompilation checker figures out if a file
-- needs to be recompiled.  These are fake object files which
-- should NOT be linked against.

data HscSource
   = HsSrcFile  -- ^ .hs file
   | HsBootFile -- ^ .hs-boot file
   | HsigFile   -- ^ .hsig file
   deriving (HscSource -> HscSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HscSource -> HscSource -> Bool
$c/= :: HscSource -> HscSource -> Bool
== :: HscSource -> HscSource -> Bool
$c== :: HscSource -> HscSource -> Bool
Eq, Eq HscSource
HscSource -> HscSource -> Bool
HscSource -> HscSource -> Ordering
HscSource -> HscSource -> HscSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HscSource -> HscSource -> HscSource
$cmin :: HscSource -> HscSource -> HscSource
max :: HscSource -> HscSource -> HscSource
$cmax :: HscSource -> HscSource -> HscSource
>= :: HscSource -> HscSource -> Bool
$c>= :: HscSource -> HscSource -> Bool
> :: HscSource -> HscSource -> Bool
$c> :: HscSource -> HscSource -> Bool
<= :: HscSource -> HscSource -> Bool
$c<= :: HscSource -> HscSource -> Bool
< :: HscSource -> HscSource -> Bool
$c< :: HscSource -> HscSource -> Bool
compare :: HscSource -> HscSource -> Ordering
$ccompare :: HscSource -> HscSource -> Ordering
Ord, Int -> HscSource -> ShowS
[HscSource] -> ShowS
HscSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HscSource] -> ShowS
$cshowList :: [HscSource] -> ShowS
show :: HscSource -> String
$cshow :: HscSource -> String
showsPrec :: Int -> HscSource -> ShowS
$cshowsPrec :: Int -> HscSource -> ShowS
Show)

-- | Tests if an 'HscSource' is a boot file, primarily for constructing elements
-- of 'BuildModule'. We conflate signatures and modules because they are bound
-- in the same namespace; only boot interfaces can be disambiguated with
-- `import {-# SOURCE #-}`.
hscSourceToIsBoot :: HscSource -> IsBootInterface
hscSourceToIsBoot :: HscSource -> IsBootInterface
hscSourceToIsBoot HscSource
HsBootFile = IsBootInterface
IsBoot
hscSourceToIsBoot HscSource
_ = IsBootInterface
NotBoot

instance Binary HscSource where
    put_ :: BinHandle -> HscSource -> IO ()
put_ BinHandle
bh HscSource
HsSrcFile = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh HscSource
HsBootFile = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh HscSource
HsigFile = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    get :: BinHandle -> IO HscSource
get BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return HscSource
HsSrcFile
            Word8
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return HscSource
HsBootFile
            Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return HscSource
HsigFile

hscSourceString :: HscSource -> String
hscSourceString :: HscSource -> String
hscSourceString HscSource
HsSrcFile   = String
""
hscSourceString HscSource
HsBootFile  = String
"[boot]"
hscSourceString HscSource
HsigFile    = String
"[sig]"

-- See Note [HscSource types]
isHsBootOrSig :: HscSource -> Bool
isHsBootOrSig :: HscSource -> Bool
isHsBootOrSig HscSource
HsBootFile = Bool
True
isHsBootOrSig HscSource
HsigFile   = Bool
True
isHsBootOrSig HscSource
_          = Bool
False

isHsigFile :: HscSource -> Bool
isHsigFile :: HscSource -> Bool
isHsigFile HscSource
HsigFile = Bool
True
isHsigFile HscSource
_        = Bool
False