{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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
(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 SourceFile = RealFile FilePath | FakeFile (Maybe FilePath)
data ModuleInfo
= ModuleInfo
{ ModuleInfo -> ModuleName
modInfoName :: ModuleName
, ModuleInfo -> Unit
modInfoUnit :: Unit
, ModuleInfo -> Bool
modInfoIsBoot :: Bool
, ModuleInfo -> Maybe String
modInfoSrcFile :: Maybe FilePath
, ModuleInfo -> Bool
modInfoIsReal :: Bool
, ModuleInfo -> Fingerprint
modInfoHash :: Fingerprint
} deriving ModuleInfo -> ModuleInfo -> Bool
(ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool) -> Eq ModuleInfo
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 = [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 Unit
b Bool
c Maybe String
d Bool
e Fingerprint
f) = (ModuleName, Unit, Bool, Maybe String, Bool, Fingerprint)
-> [SQLData]
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 (ModuleName
-> Unit
-> Bool
-> Maybe String
-> Bool
-> Fingerprint
-> ModuleInfo)
-> RowParser ModuleName
-> RowParser
(Unit -> Bool -> Maybe String -> Bool -> Fingerprint -> ModuleInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser ModuleName
forall a. FromField a => RowParser a
field RowParser
(Unit -> Bool -> Maybe String -> Bool -> Fingerprint -> ModuleInfo)
-> RowParser Unit
-> RowParser
(Bool -> Maybe String -> Bool -> Fingerprint -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Unit
forall a. FromField a => RowParser a
field RowParser
(Bool -> Maybe String -> Bool -> Fingerprint -> ModuleInfo)
-> RowParser Bool
-> RowParser (Maybe String -> Bool -> Fingerprint -> 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 -> Fingerprint -> ModuleInfo)
-> RowParser (Maybe String)
-> RowParser (Bool -> Fingerprint -> 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 -> Fingerprint -> ModuleInfo)
-> RowParser Bool -> RowParser (Fingerprint -> ModuleInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
field RowParser (Fingerprint -> ModuleInfo)
-> RowParser Fingerprint -> RowParser ModuleInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Fingerprint
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 FromRow ModuleName where
fromRow :: RowParser ModuleName
fromRow = RowParser ModuleName
forall a. FromField a => RowParser a
field
instance ToField Unit where
toField :: Unit -> SQLData
toField Unit
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
$ Unit -> String
unitString Unit
uid
instance FromField Unit where
fromField :: FieldParser Unit
fromField Field
fld = String -> Unit
stringToUnit (String -> Unit) -> (Text -> String) -> Text -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Unit) -> Ok Text -> Ok Unit
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 Fingerprint where
toField :: Fingerprint -> SQLData
toField Fingerprint
hash = 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
$ Fingerprint -> String
forall a. Show a => a -> String
show Fingerprint
hash
instance FromField Fingerprint where
fromField :: FieldParser Fingerprint
fromField Field
fld = String -> Fingerprint
readHexFingerprint (String -> Fingerprint) -> (Text -> String) -> Text -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Fingerprint) -> Ok Text -> Ok Fingerprint
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
, HieModuleRow -> ModuleInfo
hieModInfo :: ModuleInfo
} deriving HieModuleRow -> HieModuleRow -> Bool
(HieModuleRow -> HieModuleRow -> Bool)
-> (HieModuleRow -> HieModuleRow -> Bool) -> Eq HieModuleRow
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 = [SQLData] -> String
forall a. Show a => a -> String
show ([SQLData] -> String)
-> (HieModuleRow -> [SQLData]) -> HieModuleRow -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieModuleRow -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow
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 -> 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) = ((String, OccName, ModuleName) :. ((Unit, Int, Int) :. (Int, Int)))
-> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ((String
a,OccName
b,ModuleName
c)(String, OccName, ModuleName)
-> ((Unit, Int, Int) :. (Int, Int))
-> (String, OccName, ModuleName)
:. ((Unit, Int, Int) :. (Int, Int))
forall h t. h -> t -> h :. t
:.(Unit
d,Int
e,Int
f)(Unit, Int, Int) -> (Int, Int) -> (Unit, 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
-> Unit
-> Int
-> Int
-> Int
-> Int
-> RefRow
RefRow (String
-> OccName
-> ModuleName
-> Unit
-> Int
-> Int
-> Int
-> Int
-> RefRow)
-> RowParser String
-> RowParser
(OccName
-> ModuleName -> Unit -> 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 -> Unit -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser OccName
-> RowParser
(ModuleName -> Unit -> 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 -> Unit -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser ModuleName
-> RowParser (Unit -> 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 (Unit -> Int -> Int -> Int -> Int -> RefRow)
-> RowParser Unit -> RowParser (Int -> Int -> Int -> Int -> RefRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Unit
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 -> 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) = ((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
data ExportRow = ExportRow
{ ExportRow -> String
exportHieFile :: FilePath
, ExportRow -> OccName
exportName :: OccName
, ExportRow -> ModuleName
exportMod :: ModuleName
, 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) = (String, OccName, ModuleName, Unit, Maybe OccName,
Maybe ModuleName, Maybe Unit, Bool)
-> [SQLData]
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 (String
-> OccName
-> ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
-> RowParser String
-> RowParser
(OccName
-> ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser String
forall a. FromField a => RowParser a
field RowParser
(OccName
-> ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
-> RowParser OccName
-> RowParser
(ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser OccName
forall a. FromField a => RowParser a
field RowParser
(ModuleName
-> Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
-> RowParser ModuleName
-> RowParser
(Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser ModuleName
forall a. FromField a => RowParser a
field RowParser
(Unit
-> Maybe OccName
-> Maybe ModuleName
-> Maybe Unit
-> Bool
-> ExportRow)
-> RowParser Unit
-> RowParser
(Maybe OccName
-> Maybe ModuleName -> Maybe Unit -> Bool -> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Unit
forall a. FromField a => RowParser a
field RowParser
(Maybe OccName
-> Maybe ModuleName -> Maybe Unit -> Bool -> ExportRow)
-> RowParser (Maybe OccName)
-> RowParser (Maybe ModuleName -> Maybe Unit -> Bool -> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe OccName)
forall a. FromField a => RowParser a
field RowParser (Maybe ModuleName -> Maybe Unit -> Bool -> ExportRow)
-> RowParser (Maybe ModuleName)
-> RowParser (Maybe Unit -> Bool -> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe ModuleName)
forall a. FromField a => RowParser a
field RowParser (Maybe Unit -> Bool -> ExportRow)
-> RowParser (Maybe Unit) -> RowParser (Bool -> ExportRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe Unit)
forall a. FromField a => RowParser a
field RowParser (Bool -> ExportRow)
-> RowParser Bool -> RowParser ExportRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
field
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 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
(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
<> Unit -> String
unitString (Module -> Unit
moduleUnit (Module -> Unit) -> Module -> Unit
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 :: Unit
uid = String -> Unit
stringToUnit String
u
sym :: Symbol
sym = Symbol :: OccName -> Module -> Symbol
Symbol
{ symName :: OccName
symName = NameSpace -> String -> OccName
mkOccName NameSpace
ns String
n
, symModule :: Module
symModule = Unit -> ModuleName -> Module
mkModule Unit
uid ModuleName
mn
}
Symbol -> ReadP Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
sym
newtype LibDir = LibDir FilePath
type HieTarget = Either FilePath (ModuleName, Maybe Unit)