{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.CallHierarchy.Query ( incomingCalls , outgoingCalls , getSymbolPosition ) where import qualified Data.Text as T import Database.SQLite.Simple import Development.IDE.GHC.Compat import HieDb (HieDb (getConn), Symbol (..), toNsChar) import Ide.Plugin.CallHierarchy.Types incomingCalls :: HieDb -> Symbol -> IO [Vertex] incomingCalls :: HieDb -> Symbol -> IO [Vertex] incomingCalls (HieDb -> Connection getConn -> Connection conn) Symbol symbol = do let (String o, String m, String u) = Symbol -> (String, String, String) parseSymbol Symbol symbol Connection -> Query -> (String, String, String, String, String, String) -> IO [Vertex] forall q r. (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r] query Connection conn (Text -> Query Query (Text -> Query) -> Text -> Query forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "SELECT mods.mod, decls.occ, mods.hs_src, decls.sl, decls.sc, " , String "decls.el, decls.ec, refs.sl, refs.sc, refs.el, refs.ec " , String "FROM refs " , String "JOIN decls ON decls.hieFile = refs.hieFile " , String "JOIN mods ON mods.hieFile = decls.hieFile " , String "where " , String "(refs.occ = ? AND refs.mod = ? AND refs.unit = ?) " , String "AND " , String "(decls.occ != ? OR mods.mod != ? OR mods.unit != ?) " , String "AND " , String "((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) " , String "AND " ,String "((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))" ] ) (String o, String m, String u, String o, String m, String u) outgoingCalls :: HieDb -> Symbol -> IO [Vertex] outgoingCalls :: HieDb -> Symbol -> IO [Vertex] outgoingCalls (HieDb -> Connection getConn -> Connection conn) Symbol symbol = do let (String o, String m, String u) = Symbol -> (String, String, String) parseSymbol Symbol symbol Connection -> Query -> (String, String, String, String, String, String) -> IO [Vertex] forall q r. (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r] query Connection conn (Text -> Query Query (Text -> Query) -> Text -> Query forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "SELECT rm.mod, defs.occ, rm.hs_src, defs.sl, defs.sc, defs.el, defs.ec, " , String "refs.sl, refs.sc, refs.el, refs.ec " , String "from refs " , String "JOIN defs ON defs.occ = refs.occ " , String "JOIN decls rd ON rd.hieFile = defs.hieFile AND rd.occ = defs.occ " , String "JOIN mods rm ON rm.mod = refs.mod AND rm.unit = refs.unit AND rm.hieFile = defs.hieFile " , String "JOIN decls ON decls.hieFile = refs.hieFile " , String "JOIN mods ON mods.hieFile = decls.hieFile " , String "where " , String "(decls.occ = ? AND mods.mod = ? AND mods.unit = ?) " , String "AND " , String "(defs.occ != ? OR rm.mod != ? OR rm.unit != ?) " , String "AND " , String "((refs.sl = decls.sl AND refs.sc > decls.sc) OR (refs.sl > decls.sl)) " , String "AND " , String "((refs.el = decls.el AND refs.ec <= decls.ec) OR (refs.el < decls.el))" ] ) (String o, String m, String u, String o, String m, String u) getSymbolPosition :: HieDb -> Vertex -> IO [SymbolPosition] getSymbolPosition :: HieDb -> Vertex -> IO [SymbolPosition] getSymbolPosition (HieDb -> Connection getConn -> Connection conn) Vertex{Int String $sel:caec:Vertex :: Vertex -> Int $sel:cael:Vertex :: Vertex -> Int $sel:casc:Vertex :: Vertex -> Int $sel:casl:Vertex :: Vertex -> Int $sel:ec:Vertex :: Vertex -> Int $sel:el:Vertex :: Vertex -> Int $sel:sc:Vertex :: Vertex -> Int $sel:sl:Vertex :: Vertex -> Int $sel:hieSrc:Vertex :: Vertex -> String $sel:occ:Vertex :: Vertex -> String $sel:mod:Vertex :: Vertex -> String caec :: Int cael :: Int casc :: Int casl :: Int ec :: Int el :: Int sc :: Int sl :: Int hieSrc :: String occ :: String mod :: String ..} = do Connection -> Query -> (String, Int, Int, Int, Int, Int, Int) -> IO [SymbolPosition] forall q r. (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r] query Connection conn (Text -> Query Query (Text -> Query) -> Text -> Query forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "SELECT refs.sl, refs.sc from refs where " , String "(occ = ?) " , String "AND " , String "((refs.sl = ? AND refs.sc > ?) OR (refs.sl > ?)) " , String "AND " , String "((refs.el = ? AND refs.ec <= ?) OR (refs.el < ?))" ] ) (String occ, Int sl, Int sc, Int sl, Int el, Int ec, Int el) parseSymbol :: Symbol -> (String, String, String) parseSymbol :: Symbol -> (String, String, String) parseSymbol Symbol{Module OccName symName :: Symbol -> OccName symModule :: Symbol -> Module symModule :: Module symName :: OccName ..} = let o :: String o = NameSpace -> Char toNsChar (OccName -> NameSpace occNameSpace OccName symName) Char -> String -> String forall a. a -> [a] -> [a] : OccName -> String occNameString OccName symName m :: String m = ModuleName -> String moduleNameString (ModuleName -> String) -> ModuleName -> String forall a b. (a -> b) -> a -> b $ Module -> ModuleName moduleName Module symModule u :: String u = Unit -> String unitString (Unit -> String) -> Unit -> String forall a b. (a -> b) -> a -> b $ Module -> Unit moduleUnit Module symModule in (String o, String m, String u)