{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module HieDb.Types where

import Prelude hiding (mod)

import Data.IORef

import qualified Data.Text as T

import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Exception

import Data.List.NonEmpty (NonEmpty(..))

import Data.Int

import Database.SQLite.Simple
import Database.SQLite.Simple.ToField
import Database.SQLite.Simple.FromField

import qualified Text.ParserCombinators.ReadP as R

import HieDb.Compat

newtype HieDb = HieDb { HieDb -> Connection
getConn :: Connection }

data HieDbException
  = IncompatibleSchemaVersion
  { HieDbException -> Integer
expectedVersion :: Integer, HieDbException -> Integer
gotVersion :: Integer }
  deriving (HieDbException -> HieDbException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HieDbException -> HieDbException -> Bool
$c/= :: HieDbException -> HieDbException -> Bool
== :: HieDbException -> HieDbException -> Bool
$c== :: HieDbException -> HieDbException -> Bool
Eq,Eq HieDbException
HieDbException -> HieDbException -> Bool
HieDbException -> HieDbException -> Ordering
HieDbException -> HieDbException -> HieDbException
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 :: HieDbException -> HieDbException -> HieDbException
$cmin :: HieDbException -> HieDbException -> HieDbException
max :: HieDbException -> HieDbException -> HieDbException
$cmax :: HieDbException -> HieDbException -> HieDbException
>= :: HieDbException -> HieDbException -> Bool
$c>= :: HieDbException -> HieDbException -> Bool
> :: HieDbException -> HieDbException -> Bool
$c> :: HieDbException -> HieDbException -> Bool
<= :: HieDbException -> HieDbException -> Bool
$c<= :: HieDbException -> HieDbException -> Bool
< :: HieDbException -> HieDbException -> Bool
$c< :: HieDbException -> HieDbException -> Bool
compare :: HieDbException -> HieDbException -> Ordering
$ccompare :: HieDbException -> HieDbException -> Ordering
Ord,Int -> HieDbException -> ShowS
[HieDbException] -> ShowS
HieDbException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HieDbException] -> ShowS
$cshowList :: [HieDbException] -> ShowS
show :: HieDbException -> String
$cshow :: HieDbException -> String
showsPrec :: Int -> HieDbException -> ShowS
$cshowsPrec :: Int -> HieDbException -> ShowS
Show)

instance Exception HieDbException where

setHieTrace :: HieDb -> Maybe (T.Text -> IO ()) -> IO ()
setHieTrace :: HieDb -> Maybe (Text -> IO ()) -> IO ()
setHieTrace = Connection -> Maybe (Text -> IO ()) -> IO ()
setTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDb -> Connection
getConn

-- | Encodes the original haskell source file of a module, along with whether
-- it is "real" or not
-- A file is "real" if it comes from the user project, as opposed to a
-- dependency
data SourceFile = RealFile FilePath | FakeFile (Maybe FilePath)

data ModuleInfo
  = ModuleInfo
  { ModuleInfo -> ModuleName
modInfoName :: ModuleName
  , ModuleInfo -> Unit
modInfoUnit :: Unit -- ^ Identifies the package this module is part of
  , ModuleInfo -> Bool
modInfoIsBoot :: Bool -- ^ True, when this ModuleInfo was created by indexing @.hie-boot@  file;
                          -- False when it was created from @.hie@ file
  , ModuleInfo -> Maybe String
modInfoSrcFile :: Maybe FilePath -- ^ The path to the haskell source file, from which the @.hie@ file was created
  , ModuleInfo -> Bool
modInfoIsReal :: Bool -- ^ Is this a real source file? I.e. does it come from user's project (as opposed to from project's dependency)?
  , ModuleInfo -> Fingerprint
modInfoHash :: Fingerprint -- ^ The hash of the @.hie@ file from which this ModuleInfo was created
  } deriving ModuleInfo -> ModuleInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleInfo -> ModuleInfo -> Bool
$c/= :: ModuleInfo -> ModuleInfo -> Bool
== :: ModuleInfo -> ModuleInfo -> Bool
$c== :: ModuleInfo -> ModuleInfo -> Bool
Eq

instance Show ModuleInfo where
  show :: ModuleInfo -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRow a => a -> [SQLData]
toRow

instance ToRow ModuleInfo where
  toRow :: ModuleInfo -> [SQLData]
toRow (ModuleInfo ModuleName
a Unit
b Bool
c Maybe String
d Bool
e Fingerprint
f) = forall a. ToRow a => a -> [SQLData]
toRow (ModuleName
a,Unit
b,Bool
c,Maybe String
d,Bool
e,Fingerprint
f)
instance FromRow ModuleInfo where
  fromRow :: RowParser ModuleInfo
fromRow = ModuleName
-> Unit
-> Bool
-> Maybe String
-> Bool
-> Fingerprint
-> ModuleInfo
ModuleInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

type Res a = a :. ModuleInfo

instance ToField ModuleName where
  toField :: ModuleName -> SQLData
toField ModuleName
mod = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mod
instance FromField ModuleName where
  fromField :: FieldParser ModuleName
fromField Field
fld = String -> ModuleName
mkModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
fld

instance FromRow ModuleName where
  fromRow :: RowParser ModuleName
fromRow = forall a. FromField a => RowParser a
field

instance ToField Unit where
  toField :: Unit -> SQLData
toField Unit
uid = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall u. IsUnitId u => u -> String
unitString Unit
uid
instance FromField Unit where
  fromField :: FieldParser Unit
fromField Field
fld = String -> Unit
stringToUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
fld

instance ToField Fingerprint where
  toField :: Fingerprint -> SQLData
toField Fingerprint
hash = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Fingerprint
hash
instance FromField Fingerprint where
  fromField :: FieldParser Fingerprint
fromField Field
fld = String -> Fingerprint
readHexFingerprint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
fromField Field
fld

toNsChar :: NameSpace -> Char
toNsChar :: NameSpace -> Char
toNsChar NameSpace
ns
  | NameSpace -> Bool
isVarNameSpace NameSpace
ns = Char
'v'
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = Char
'c'
  | NameSpace -> Bool
isTcClsNameSpace NameSpace
ns  = Char
't'
  | NameSpace -> Bool
isTvNameSpace NameSpace
ns = Char
'z'
  | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"namespace not recognized"

fromNsChar :: Char -> Maybe NameSpace
fromNsChar :: Char -> Maybe NameSpace
fromNsChar Char
'v' = forall a. a -> Maybe a
Just NameSpace
varName
fromNsChar Char
'c' = forall a. a -> Maybe a
Just NameSpace
dataName
fromNsChar Char
't' = forall a. a -> Maybe a
Just NameSpace
tcClsName
fromNsChar Char
'z' = forall a. a -> Maybe a
Just NameSpace
tvName
fromNsChar Char
_ = forall a. Maybe a
Nothing

instance ToField OccName where
  toField :: OccName -> SQLData
toField OccName
occ = Text -> SQLData
SQLText forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ NameSpace -> Char
toNsChar (OccName -> NameSpace
occNameSpace OccName
occ) forall a. a -> [a] -> [a]
: OccName -> String
occNameString OccName
occ
instance FromField OccName where
  fromField :: FieldParser OccName
fromField Field
fld =
    case Field -> SQLData
fieldData Field
fld of
      SQLText Text
t ->
        case Text -> Maybe (Char, Text)
T.uncons Text
t of
          Just (Char
nsChar,Text
occ)
            | Just NameSpace
ns <- Char -> Maybe NameSpace
fromNsChar Char
nsChar ->
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NameSpace -> String -> OccName
mkOccName NameSpace
ns (Text -> String
T.unpack Text
occ)
          Maybe (Char, Text)
_ -> forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
fld String
"OccName encoding invalid"
      SQLData
_ -> forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
Incompatible Field
fld String
"Expected a SQL string representing an OccName"

data HieModuleRow
  = HieModuleRow
  { HieModuleRow -> String
hieModuleHieFile :: FilePath -- ^ Full path to @.hie@ file based on which this row was created
  , HieModuleRow -> ModuleInfo
hieModInfo :: ModuleInfo
  } deriving HieModuleRow -> HieModuleRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HieModuleRow -> HieModuleRow -> Bool
$c/= :: HieModuleRow -> HieModuleRow -> Bool
== :: HieModuleRow -> HieModuleRow -> Bool
$c== :: HieModuleRow -> HieModuleRow -> Bool
Eq

instance Show HieModuleRow where
  show :: HieModuleRow -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToRow a => a -> [SQLData]
toRow

instance ToRow HieModuleRow where
  toRow :: HieModuleRow -> [SQLData]
toRow (HieModuleRow String
a ModuleInfo
b) =
     forall a. ToField a => a -> SQLData
toField String
a forall a. a -> [a] -> [a]
: forall a. ToRow a => a -> [SQLData]
toRow ModuleInfo
b

instance FromRow HieModuleRow where
  fromRow :: RowParser HieModuleRow
fromRow =
    String -> ModuleInfo -> HieModuleRow
HieModuleRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromRow a => RowParser a
fromRow

data RefRow
  = RefRow
  { RefRow -> String
refSrc :: FilePath
  , RefRow -> OccName
refNameOcc :: OccName
  , RefRow -> ModuleName
refNameMod :: ModuleName
  , RefRow -> Unit
refNameUnit :: Unit
  , RefRow -> Int
refSLine :: Int
  , RefRow -> Int
refSCol :: Int
  , RefRow -> Int
refELine :: Int
  , RefRow -> Int
refECol :: Int
  }

instance ToRow RefRow where
  toRow :: RefRow -> [SQLData]
toRow (RefRow String
a OccName
b ModuleName
c Unit
d Int
e Int
f Int
g Int
h) = forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,ModuleName
c)forall h t. h -> t -> h :. t
:.(Unit
d,Int
e,Int
f)forall h t. h -> t -> h :. t
:.(Int
g,Int
h))

instance FromRow RefRow where
  fromRow :: RowParser RefRow
fromRow = String
-> OccName
-> ModuleName
-> Unit
-> Int
-> Int
-> Int
-> Int
-> RefRow
RefRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

data DeclRow
  = DeclRow
  { DeclRow -> String
declSrc :: FilePath
  , DeclRow -> OccName
declNameOcc :: OccName
  , DeclRow -> Int
declSLine :: Int
  , DeclRow -> Int
declSCol :: Int
  , DeclRow -> Int
declELine :: Int
  , DeclRow -> Int
declECol :: Int
  , DeclRow -> Bool
declRoot :: Bool
  }

instance ToRow DeclRow where
  toRow :: DeclRow -> [SQLData]
toRow (DeclRow String
a OccName
b Int
c Int
d Int
e Int
f Bool
g) = forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,Int
c,Int
d)forall h t. h -> t -> h :. t
:.(Int
e,Int
f,Bool
g))

instance FromRow DeclRow where
  fromRow :: RowParser DeclRow
fromRow = String -> OccName -> Int -> Int -> Int -> Int -> Bool -> DeclRow
DeclRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

data TypeName = TypeName
  { TypeName -> OccName
typeName :: OccName
  , TypeName -> ModuleName
typeMod :: ModuleName
  , TypeName -> Unit
typeUnit :: Unit
  }

data TypeRef = TypeRef
  { TypeRef -> Int64
typeRefOccId :: Int64
  , TypeRef -> String
typeRefHieFile :: FilePath
  , TypeRef -> Int
typeRefDepth :: Int
  , TypeRef -> Int
typeRefSLine :: Int
  , TypeRef -> Int
typeRefSCol :: Int
  , TypeRef -> Int
typeRefELine :: Int
  , TypeRef -> Int
typeRefECol :: Int
  }

instance ToRow TypeRef where
  toRow :: TypeRef -> [SQLData]
toRow (TypeRef Int64
a String
b Int
c Int
d Int
e Int
f Int
g) = forall a. ToRow a => a -> [SQLData]
toRow ((Int64
a,String
b,Int
c,Int
d)forall h t. h -> t -> h :. t
:.(Int
e,Int
f,Int
g))

instance FromRow TypeRef where
  fromRow :: RowParser TypeRef
fromRow = Int64 -> String -> Int -> Int -> Int -> Int -> Int -> TypeRef
TypeRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

data DefRow
  = DefRow
  { DefRow -> String
defSrc :: FilePath
  , DefRow -> OccName
defNameOcc :: OccName
  , DefRow -> Int
defSLine :: Int
  , DefRow -> Int
defSCol :: Int
  , DefRow -> Int
defELine :: Int
  , DefRow -> Int
defECol :: Int
  }

instance ToRow DefRow where
  toRow :: DefRow -> [SQLData]
toRow (DefRow String
a OccName
b Int
c Int
d Int
e Int
f) = forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,Int
c,Int
d)forall h t. h -> t -> h :. t
:.(Int
e,Int
f))

instance FromRow DefRow where
  fromRow :: RowParser DefRow
fromRow = String -> OccName -> Int -> Int -> Int -> Int -> DefRow
DefRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

data ExportRow = ExportRow
  { ExportRow -> String
exportHieFile :: FilePath -- ^ Exporting module
  , ExportRow -> OccName
exportName :: OccName
  , ExportRow -> ModuleName
exportMod :: ModuleName -- ^ Definition module
  , ExportRow -> Unit
exportUnit :: Unit
  , ExportRow -> Maybe OccName
exportParent :: Maybe OccName
  , ExportRow -> Maybe ModuleName
exportParentMod :: Maybe ModuleName
  , ExportRow -> Maybe Unit
exportParentUnit :: Maybe Unit
  , ExportRow -> Bool
exportIsDatacon :: Bool
  }
instance ToRow ExportRow where
  toRow :: ExportRow -> [SQLData]
toRow (ExportRow String
a OccName
b ModuleName
c Unit
d Maybe OccName
e Maybe ModuleName
f Maybe Unit
g Bool
h) = forall a. ToRow a => a -> [SQLData]
toRow (String
a,OccName
b,ModuleName
c,Unit
d,Maybe OccName
e,Maybe ModuleName
f,Maybe Unit
g,Bool
h)

instance FromRow ExportRow where
  fromRow :: RowParser ExportRow
fromRow = String
-> OccName
-> ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow
ExportRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => RowParser a
field

{-| Monad with access to 'NameCacheUpdater', which is needed to deserialize @.hie@ files -}
class Monad m => NameCacheMonad m where
  getNcUpdater :: m NameCacheUpdater

newtype DbMonadT m a = DbMonadT { forall (m :: * -> *) a.
DbMonadT m a -> ReaderT (IORef NameCache) m a
runDbMonad :: ReaderT (IORef NameCache) m a } deriving (forall (m :: * -> *) a. Monad m => m a -> DbMonadT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> DbMonadT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> DbMonadT m a
MonadTrans)
deriving instance Monad m => Functor (DbMonadT m)
deriving instance Monad m => Applicative (DbMonadT m)
deriving instance Monad m => Monad (DbMonadT m)
deriving instance MonadIO m => MonadIO (DbMonadT m)

type DbMonad = DbMonadT IO

runDbM :: IORef NameCache -> DbMonad a -> IO a
runDbM :: forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc DbMonad a
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT IORef NameCache
nc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
DbMonadT m a -> ReaderT (IORef NameCache) m a
runDbMonad DbMonad a
x

instance MonadIO m => NameCacheMonad (DbMonadT m) where
#if __GLASGOW_HASKELL__ >= 903
  getNcUpdater = DbMonadT $ ReaderT $ \ref -> liftIO $ readIORef ref
#else
  getNcUpdater :: DbMonadT m NameCacheUpdater
getNcUpdater = forall (m :: * -> *) a.
ReaderT (IORef NameCache) m a -> DbMonadT m a
DbMonadT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef NameCache
ref -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall c. (NameCache -> (NameCache, c)) -> IO c)
-> NameCacheUpdater
NCU forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef NameCache
ref)
#endif


data HieDbErr
  = NotIndexed ModuleName (Maybe Unit)
  | AmbiguousUnitId (NonEmpty ModuleInfo)
  | NameNotFound OccName (Maybe ModuleName) (Maybe Unit)
  | NoNameAtPoint HieTarget (Int,Int)
  | NameUnhelpfulSpan Name String

data Symbol = Symbol
    { Symbol -> OccName
symName   :: !OccName
    , Symbol -> Module
symModule :: !Module
    } deriving (Symbol -> Symbol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
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 :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmax :: Symbol -> Symbol -> Symbol
>= :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c< :: Symbol -> Symbol -> Bool
compare :: Symbol -> Symbol -> Ordering
$ccompare :: Symbol -> Symbol -> Ordering
Ord)

instance Show Symbol where
    show :: Symbol -> String
show Symbol
s =  NameSpace -> Char
toNsChar (OccName -> NameSpace
occNameSpace forall a b. (a -> b) -> a -> b
$ Symbol -> OccName
symName Symbol
s)
           forall a. a -> [a] -> [a]
:  Char
':'
           forall a. a -> [a] -> [a]
:  OccName -> String
occNameString (Symbol -> OccName
symName Symbol
s)
           forall a. Semigroup a => a -> a -> a
<> String
":"
           forall a. Semigroup a => a -> a -> a
<> ModuleName -> String
moduleNameString (forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ Symbol -> Module
symModule Symbol
s)
           forall a. Semigroup a => a -> a -> a
<> String
":"
        --    <> unitIdString (moduleUnit $ symModule s)
           forall a. Semigroup a => a -> a -> a
<> forall u. IsUnitId u => u -> String
unitString (forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ Symbol -> Module
symModule Symbol
s)

instance Read Symbol where
  readsPrec :: Int -> ReadS Symbol
readsPrec = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadS a
R.readP_to_S ReadP Symbol
readSymbol

readNameSpace :: R.ReadP NameSpace
readNameSpace :: ReadP NameSpace
readNameSpace = do
  Char
c <- ReadP Char
R.get
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadP a
R.pfail forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe NameSpace
fromNsChar Char
c)

readColon :: R.ReadP ()
readColon :: ReadP ()
readColon = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ReadP Char
R.char Char
':'

readSymbol :: R.ReadP Symbol
readSymbol :: ReadP Symbol
readSymbol = do
  NameSpace
ns <- ReadP NameSpace
readNameSpace
  ReadP ()
readColon
  String
n <- forall a. ReadP a -> ReadP [a]
R.many1 ReadP Char
R.get
  ReadP ()
readColon
  String
m <- forall a. ReadP a -> ReadP [a]
R.many1 ReadP Char
R.get
  ReadP ()
readColon
  String
u <- forall a. ReadP a -> ReadP [a]
R.many1 ReadP Char
R.get
  ReadP ()
R.eof
  let mn :: ModuleName
mn  = String -> ModuleName
mkModuleName String
m
      uid :: Unit
uid = String -> Unit
stringToUnit String
u
      sym :: Symbol
sym = Symbol
              { symName :: OccName
symName   = NameSpace -> String -> OccName
mkOccName NameSpace
ns String
n
              , symModule :: Module
symModule = forall u. u -> ModuleName -> GenModule u
mkModule Unit
uid ModuleName
mn
              }
  forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
sym

-- | GHC Library Directory. Typically you'll want to use
-- @libdir@ from <https://hackage.haskell.org/package/ghc-paths ghc-paths>
newtype LibDir = LibDir FilePath

-- | A way to specify which HieFile to operate on.
-- Either the path to @.hie@ file is given in the Left
-- Or ModuleName (with optional Unit) is given in the Right
type HieTarget = Either FilePath (ModuleName, Maybe Unit)