{-# LANGUAGE ViewPatterns #-}

module StaticLS.HieDb (lookupHieFileFromHie) where

import Data.List (intercalate)
import Database.SQLite.Simple
import HieDb

{- | Lookup 'HieModule' row from 'HieDb' given the path to the Haskell hie file
A temporary function until this is supported in hiedb proper
-}
lookupHieFileFromHie :: HieDb -> FilePath -> IO (Maybe HieModuleRow)
lookupHieFileFromHie :: HieDb -> FilePath -> IO (Maybe HieModuleRow)
lookupHieFileFromHie (HieDb -> Connection
getConn -> Connection
conn) FilePath
fp = do
    [HieModuleRow]
files <- Connection -> Query -> Only FilePath -> IO [HieModuleRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT * FROM mods WHERE hieFile = ?" (FilePath -> Only FilePath
forall a. a -> Only a
Only FilePath
fp)
    case [HieModuleRow]
files of
        [] -> Maybe HieModuleRow -> IO (Maybe HieModuleRow)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HieModuleRow
forall a. Maybe a
Nothing
        [HieModuleRow
x] -> Maybe HieModuleRow -> IO (Maybe HieModuleRow)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HieModuleRow -> IO (Maybe HieModuleRow))
-> Maybe HieModuleRow -> IO (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> Maybe HieModuleRow
forall a. a -> Maybe a
Just HieModuleRow
x
        [HieModuleRow]
xs ->
            FilePath -> IO (Maybe HieModuleRow)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (Maybe HieModuleRow))
-> FilePath -> IO (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$
                FilePath
"DB invariant violated, hieFile in mods not unique: "
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
". Entries: "
                    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((HieModuleRow -> FilePath) -> [HieModuleRow] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ([SQLData] -> FilePath
forall a. Show a => a -> FilePath
show ([SQLData] -> FilePath)
-> (HieModuleRow -> [SQLData]) -> HieModuleRow -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieModuleRow -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow) [HieModuleRow]
xs)