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

import Prelude hiding (mod)

import Name
import Module
import NameCache

import IfaceEnv (NameCacheUpdater(..))
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.Time.Clock
import Data.Int

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

import qualified Text.ParserCombinators.ReadP as R

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

data HieDbException
  = IncompatibleSchemaVersion
  { HieDbException -> Integer
expectedVersion :: Integer, HieDbException -> Integer
gotVersion :: Integer }
  deriving (HieDbException -> HieDbException -> Bool
(HieDbException -> HieDbException -> Bool)
-> (HieDbException -> HieDbException -> Bool) -> Eq HieDbException
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
Eq HieDbException
-> (HieDbException -> HieDbException -> Ordering)
-> (HieDbException -> HieDbException -> Bool)
-> (HieDbException -> HieDbException -> Bool)
-> (HieDbException -> HieDbException -> Bool)
-> (HieDbException -> HieDbException -> Bool)
-> (HieDbException -> HieDbException -> HieDbException)
-> (HieDbException -> HieDbException -> HieDbException)
-> Ord 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
$cp1Ord :: Eq HieDbException
Ord,Int -> HieDbException -> ShowS
[HieDbException] -> ShowS
HieDbException -> String
(Int -> HieDbException -> ShowS)
-> (HieDbException -> String)
-> ([HieDbException] -> ShowS)
-> Show HieDbException
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 (Connection -> Maybe (Text -> IO ()) -> IO ())
-> (HieDb -> Connection) -> HieDb -> Maybe (Text -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDb -> Connection
getConn

data ModuleInfo
  = ModuleInfo
  { ModuleInfo -> ModuleName
modInfoName :: ModuleName
  , ModuleInfo -> UnitId
modInfoUnit :: UnitId -- ^ 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 -> UTCTime
modInfoTime :: UTCTime -- ^ The last modification time of the @.hie@ file from which this ModuleInfo was created
  }

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

instance ToRow ModuleInfo where
  toRow :: ModuleInfo -> [SQLData]
toRow (ModuleInfo ModuleName
a UnitId
b Bool
c Maybe String
d Bool
e UTCTime
f) = (ModuleName, UnitId, Bool, Maybe String, Bool, UTCTime)
-> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (ModuleName
a,UnitId
b,Bool
c,Maybe String
d,Bool
e,UTCTime
f)
instance FromRow ModuleInfo where
  fromRow :: RowParser ModuleInfo
fromRow = ModuleName
-> UnitId -> Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo
ModuleInfo (ModuleName
 -> UnitId -> Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo)
-> RowParser ModuleName
-> RowParser
     (UnitId -> Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser ModuleName
forall a. FromField a => RowParser a
field RowParser
  (UnitId -> Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo)
-> RowParser UnitId
-> RowParser
     (Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser UnitId
forall a. FromField a => RowParser a
field RowParser (Bool -> Maybe String -> Bool -> UTCTime -> ModuleInfo)
-> RowParser Bool
-> RowParser (Maybe String -> Bool -> UTCTime -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
field
                       RowParser (Maybe String -> Bool -> UTCTime -> ModuleInfo)
-> RowParser (Maybe String)
-> RowParser (Bool -> UTCTime -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe String)
forall a. FromField a => RowParser a
field RowParser (Bool -> UTCTime -> ModuleInfo)
-> RowParser Bool -> RowParser (UTCTime -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
field RowParser (UTCTime -> ModuleInfo)
-> RowParser UTCTime -> RowParser ModuleInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser UTCTime
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 (Text -> SQLData) -> Text -> SQLData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
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 (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ModuleName) -> Ok Text -> Ok ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Text
forall a. FromField a => FieldParser a
fromField Field
fld

instance ToField UnitId where
  toField :: UnitId -> SQLData
toField UnitId
uid = Text -> SQLData
SQLText (Text -> SQLData) -> Text -> SQLData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UnitId -> String
unitIdString UnitId
uid
instance FromField UnitId where
  fromField :: FieldParser UnitId
fromField Field
fld = String -> UnitId
stringToUnitId (String -> UnitId) -> (Text -> String) -> Text -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> UnitId) -> Ok Text -> Ok UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Text
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 = String -> Char
forall a. HasCallStack => String -> a
error String
"namespace not recognized"

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

instance ToField OccName where
  toField :: OccName -> SQLData
toField OccName
occ = Text -> SQLData
SQLText (Text -> SQLData) -> Text -> SQLData
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ NameSpace -> Char
toNsChar (OccName -> NameSpace
occNameSpace OccName
occ) Char -> ShowS
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 ->
              OccName -> Ok OccName
forall (m :: * -> *) a. Monad m => a -> m a
return (OccName -> Ok OccName) -> OccName -> Ok OccName
forall a b. (a -> b) -> a -> b
$ NameSpace -> String -> OccName
mkOccName NameSpace
ns (Text -> String
T.unpack Text
occ)
          Maybe (Char, Text)
_ -> (String -> String -> String -> ResultError)
-> Field -> String -> Ok OccName
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
_ -> (String -> String -> String -> ResultError)
-> Field -> String -> Ok OccName
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
  }

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

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

data RefRow
  = RefRow
  { RefRow -> String
refSrc :: FilePath
  , RefRow -> OccName
refNameOcc :: OccName
  , RefRow -> ModuleName
refNameMod :: ModuleName
  , RefRow -> UnitId
refNameUnit :: UnitId
  , 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 UnitId
d Int
e Int
f Int
g Int
h) = ((String, OccName, ModuleName)
 :. ((UnitId, Int, Int) :. (Int, Int)))
-> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,ModuleName
c)(String, OccName, ModuleName)
-> ((UnitId, Int, Int) :. (Int, Int))
-> (String, OccName, ModuleName)
   :. ((UnitId, Int, Int) :. (Int, Int))
forall h t. h -> t -> h :. t
:.(UnitId
d,Int
e,Int
f)(UnitId, Int, Int)
-> (Int, Int) -> (UnitId, Int, Int) :. (Int, Int)
forall h t. h -> t -> h :. t
:.(Int
g,Int
h))

instance FromRow RefRow where
  fromRow :: RowParser RefRow
fromRow = String
-> OccName
-> ModuleName
-> UnitId
-> Int
-> Int
-> Int
-> Int
-> RefRow
RefRow (String
 -> OccName
 -> ModuleName
 -> UnitId
 -> Int
 -> Int
 -> Int
 -> Int
 -> RefRow)
-> RowParser String
-> RowParser
     (OccName
      -> ModuleName -> UnitId -> Int -> Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser String
forall a. FromField a => RowParser a
field RowParser
  (OccName
   -> ModuleName -> UnitId -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser OccName
-> RowParser
     (ModuleName -> UnitId -> Int -> Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser OccName
forall a. FromField a => RowParser a
field RowParser
  (ModuleName -> UnitId -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser ModuleName
-> RowParser (UnitId -> Int -> Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser ModuleName
forall a. FromField a => RowParser a
field
                   RowParser (UnitId -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser UnitId
-> RowParser (Int -> Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser UnitId
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Int -> RefRow)
-> RowParser Int -> RowParser (Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> RefRow)
-> RowParser Int -> RowParser (Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field
                   RowParser (Int -> Int -> RefRow)
-> RowParser Int -> RowParser (Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> RefRow) -> RowParser Int -> RowParser RefRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
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) = ((String, OccName, Int, Int) :. (Int, Int, Bool)) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,Int
c,Int
d)(String, OccName, Int, Int)
-> (Int, Int, Bool)
-> (String, OccName, Int, Int) :. (Int, Int, Bool)
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 (String -> OccName -> Int -> Int -> Int -> Int -> Bool -> DeclRow)
-> RowParser String
-> RowParser
     (OccName -> Int -> Int -> Int -> Int -> Bool -> DeclRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser String
forall a. FromField a => RowParser a
field RowParser (OccName -> Int -> Int -> Int -> Int -> Bool -> DeclRow)
-> RowParser OccName
-> RowParser (Int -> Int -> Int -> Int -> Bool -> DeclRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser OccName
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Int -> Bool -> DeclRow)
-> RowParser Int
-> RowParser (Int -> Int -> Int -> Bool -> DeclRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Bool -> DeclRow)
-> RowParser Int -> RowParser (Int -> Int -> Bool -> DeclRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field
                    RowParser (Int -> Int -> Bool -> DeclRow)
-> RowParser Int -> RowParser (Int -> Bool -> DeclRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Bool -> DeclRow)
-> RowParser Int -> RowParser (Bool -> DeclRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Bool -> DeclRow) -> RowParser Bool -> RowParser DeclRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
field

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

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) = ((Int64, String, Int, Int) :. (Int, Int, Int)) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ((Int64
a,String
b,Int
c,Int
d)(Int64, String, Int, Int)
-> (Int, Int, Int) -> (Int64, String, Int, Int) :. (Int, Int, Int)
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 (Int64 -> String -> Int -> Int -> Int -> Int -> Int -> TypeRef)
-> RowParser Int64
-> RowParser (String -> Int -> Int -> Int -> Int -> Int -> TypeRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Int64
forall a. FromField a => RowParser a
field RowParser (String -> Int -> Int -> Int -> Int -> Int -> TypeRef)
-> RowParser String
-> RowParser (Int -> Int -> Int -> Int -> Int -> TypeRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser String
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Int -> Int -> TypeRef)
-> RowParser Int -> RowParser (Int -> Int -> Int -> Int -> TypeRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Int -> TypeRef)
-> RowParser Int -> RowParser (Int -> Int -> Int -> TypeRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field
                    RowParser (Int -> Int -> Int -> TypeRef)
-> RowParser Int -> RowParser (Int -> Int -> TypeRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> TypeRef)
-> RowParser Int -> RowParser (Int -> TypeRef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> TypeRef) -> RowParser Int -> RowParser TypeRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
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) = ((String, OccName, Int, Int) :. (Int, Int)) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,Int
c,Int
d)(String, OccName, Int, Int)
-> (Int, Int) -> (String, OccName, Int, Int) :. (Int, Int)
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 (String -> OccName -> Int -> Int -> Int -> Int -> DefRow)
-> RowParser String
-> RowParser (OccName -> Int -> Int -> Int -> Int -> DefRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser String
forall a. FromField a => RowParser a
field RowParser (OccName -> Int -> Int -> Int -> Int -> DefRow)
-> RowParser OccName
-> RowParser (Int -> Int -> Int -> Int -> DefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser OccName
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> Int -> DefRow)
-> RowParser Int -> RowParser (Int -> Int -> Int -> DefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> Int -> Int -> DefRow)
-> RowParser Int -> RowParser (Int -> Int -> DefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field
                   RowParser (Int -> Int -> DefRow)
-> RowParser Int -> RowParser (Int -> DefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
forall a. FromField a => RowParser a
field RowParser (Int -> DefRow) -> RowParser Int -> RowParser DefRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Int
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 { DbMonadT m a -> ReaderT (IORef NameCache) m a
runDbMonad :: ReaderT (IORef NameCache) m a } deriving (m a -> DbMonadT m a
(forall (m :: * -> *) a. Monad m => m a -> DbMonadT m a)
-> MonadTrans DbMonadT
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 :: 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 :: IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc DbMonad a
x = (ReaderT (IORef NameCache) IO a -> IORef NameCache -> IO a)
-> IORef NameCache -> ReaderT (IORef NameCache) IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (IORef NameCache) IO a -> IORef NameCache -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT IORef NameCache
nc (ReaderT (IORef NameCache) IO a -> IO a)
-> ReaderT (IORef NameCache) IO a -> IO a
forall a b. (a -> b) -> a -> b
$ DbMonad a -> ReaderT (IORef NameCache) IO a
forall (m :: * -> *) a.
DbMonadT m a -> ReaderT (IORef NameCache) m a
runDbMonad DbMonad a
x

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


data HieDbErr
  = NotIndexed ModuleName (Maybe UnitId)
  | AmbiguousUnitId (NonEmpty ModuleInfo)
  | NameNotFound OccName (Maybe ModuleName) (Maybe UnitId)
  | NameUnhelpfulSpan Name String

data Symbol = Symbol
    { Symbol -> OccName
symName   :: !OccName
    , Symbol -> Module
symModule :: !Module
    } deriving (Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
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
Eq Symbol
-> (Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord 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
$cp1Ord :: Eq Symbol
Ord)

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

instance Read Symbol where
  readsPrec :: Int -> ReadS Symbol
readsPrec = ReadS Symbol -> Int -> ReadS Symbol
forall a b. a -> b -> a
const (ReadS Symbol -> Int -> ReadS Symbol)
-> ReadS Symbol -> Int -> ReadS Symbol
forall a b. (a -> b) -> a -> b
$ ReadP Symbol -> ReadS Symbol
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
  ReadP NameSpace
-> (NameSpace -> ReadP NameSpace)
-> Maybe NameSpace
-> ReadP NameSpace
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadP NameSpace
forall a. ReadP a
R.pfail NameSpace -> ReadP NameSpace
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe NameSpace
fromNsChar Char
c)

readColon :: R.ReadP ()
readColon :: ReadP ()
readColon = () () -> ReadP Char -> ReadP ()
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 <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
R.many1 ReadP Char
R.get
  ReadP ()
readColon
  String
m <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
R.many1 ReadP Char
R.get
  ReadP ()
readColon
  String
u <- ReadP Char -> ReadP String
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 :: UnitId
uid = String -> UnitId
stringToUnitId String
u
      sym :: Symbol
sym = Symbol :: OccName -> Module -> Symbol
Symbol
              { symName :: OccName
symName   = NameSpace -> String -> OccName
mkOccName NameSpace
ns String
n
              , symModule :: Module
symModule = UnitId -> ModuleName -> Module
mkModule UnitId
uid ModuleName
mn
              }
  Symbol -> ReadP Symbol
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 UnitId) is given in the Right
type HieTarget = Either FilePath (ModuleName, Maybe UnitId)