{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

module StaticLS.StaticEnv (
    initStaticEnv,
    runStaticLs,
    getStaticEnv,
    runHieDbExceptT,
    runHieDbMaybeT,
    StaticEnv (..),
    StaticLs,
    HieDbPath,
    HieFilePath,
    HiFilePath,
    HasStaticEnv,
)
where

import Control.Exception (Exception, IOException, SomeException, catch)
import Control.Monad.IO.Unlift (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Trans.Except (ExceptT (..))
import Control.Monad.Trans.Maybe (MaybeT (..), exceptToMaybeT)
import Control.Monad.Trans.Reader (ReaderT (..))
import Database.SQLite.Simple (SQLError)
import qualified HieDb
import StaticLS.StaticEnv.Options (StaticEnvOptions (..))
import System.FilePath ((</>))

runStaticLs :: StaticEnv -> StaticLs a -> IO a
runStaticLs :: forall a. StaticEnv -> StaticLs a -> IO a
runStaticLs = (StaticLs a -> StaticEnv -> IO a)
-> StaticEnv -> StaticLs a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StaticLs a -> StaticEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

type HieDbPath = FilePath
type HieFilePath = FilePath
type HiFilePath = FilePath

data HieDbException
    = HieDbIOException IOException
    | HieDbSqlException SQLError
    | HieDbNoHieDbSourceException
    | HieDbOtherException
    deriving (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
$cshowsPrec :: Int -> HieDbException -> ShowS
showsPrec :: Int -> HieDbException -> ShowS
$cshow :: HieDbException -> String
show :: HieDbException -> String
$cshowList :: [HieDbException] -> ShowS
showList :: [HieDbException] -> ShowS
Show)

instance Exception HieDbException

-- | Static environment used to fetch data
data StaticEnv = StaticEnv
    { StaticEnv -> String
hieDbPath :: HieDbPath
    -- ^ Path to the hiedb file
    , StaticEnv -> String
hieFilesPath :: HieFilePath
    , StaticEnv -> String
hiFilesPath :: HiFilePath
    , StaticEnv -> String
wsRoot :: FilePath
    -- ^ workspace root
    , StaticEnv -> [String]
srcDirs :: [FilePath]
    -- ^ directories to search for source code in order of priority
    }
    deriving (StaticEnv -> StaticEnv -> Bool
(StaticEnv -> StaticEnv -> Bool)
-> (StaticEnv -> StaticEnv -> Bool) -> Eq StaticEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticEnv -> StaticEnv -> Bool
== :: StaticEnv -> StaticEnv -> Bool
$c/= :: StaticEnv -> StaticEnv -> Bool
/= :: StaticEnv -> StaticEnv -> Bool
Eq, Int -> StaticEnv -> ShowS
[StaticEnv] -> ShowS
StaticEnv -> String
(Int -> StaticEnv -> ShowS)
-> (StaticEnv -> String)
-> ([StaticEnv] -> ShowS)
-> Show StaticEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticEnv -> ShowS
showsPrec :: Int -> StaticEnv -> ShowS
$cshow :: StaticEnv -> String
show :: StaticEnv -> String
$cshowList :: [StaticEnv] -> ShowS
showList :: [StaticEnv] -> ShowS
Show)

type StaticLs = ReaderT StaticEnv IO

type HasStaticEnv = MonadReader StaticEnv

getStaticEnv :: (HasStaticEnv m) => m StaticEnv
getStaticEnv :: forall (m :: * -> *). HasStaticEnv m => m StaticEnv
getStaticEnv = m StaticEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

initStaticEnv :: FilePath -> StaticEnvOptions -> IO StaticEnv
initStaticEnv :: String -> StaticEnvOptions -> IO StaticEnv
initStaticEnv String
wsRoot StaticEnvOptions
staticEnvOptions =
    do
        let databasePath :: String
databasePath = String
wsRoot String -> ShowS
</> StaticEnvOptions
staticEnvOptions.optionHieDbPath
            hieFilesPath :: String
hieFilesPath = String
wsRoot String -> ShowS
</> StaticEnvOptions
staticEnvOptions.optionHieFilesPath
            srcDirs :: [String]
srcDirs = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
wsRoot String -> ShowS
</>) StaticEnvOptions
staticEnvOptions.optionSrcDirs
            hiFilesPath :: String
hiFilesPath = String
wsRoot String -> ShowS
</> StaticEnvOptions
staticEnvOptions.optionHiFilesPath

        let serverStaticEnv :: StaticEnv
serverStaticEnv =
                StaticEnv
                    { $sel:hieDbPath:StaticEnv :: String
hieDbPath = String
databasePath
                    , $sel:hieFilesPath:StaticEnv :: String
hieFilesPath = String
hieFilesPath
                    , $sel:hiFilesPath:StaticEnv :: String
hiFilesPath = String
hiFilesPath
                    , $sel:wsRoot:StaticEnv :: String
wsRoot = String
wsRoot
                    , $sel:srcDirs:StaticEnv :: [String]
srcDirs = [String]
srcDirs
                    }

        StaticEnv -> IO StaticEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StaticEnv
serverStaticEnv

-- | Run an hiedb action in an exceptT
runHieDbExceptT :: (HasStaticEnv m, MonadIO m) => (HieDb.HieDb -> IO a) -> ExceptT HieDbException m a
runHieDbExceptT :: forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> ExceptT HieDbException m a
runHieDbExceptT HieDb -> IO a
hieDbFn =
    ExceptT HieDbException m StaticEnv
forall (m :: * -> *). HasStaticEnv m => m StaticEnv
getStaticEnv
        ExceptT HieDbException m StaticEnv
-> (StaticEnv -> ExceptT HieDbException m a)
-> ExceptT HieDbException m a
forall a b.
ExceptT HieDbException m a
-> (a -> ExceptT HieDbException m b) -> ExceptT HieDbException m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \StaticEnv
staticEnv ->
            ( \String
hiedbPath ->
                m (Either HieDbException a) -> ExceptT HieDbException m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either HieDbException a) -> ExceptT HieDbException m a)
-> (IO (Either HieDbException a) -> m (Either HieDbException a))
-> IO (Either HieDbException a)
-> ExceptT HieDbException m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either HieDbException a) -> m (Either HieDbException a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HieDbException a) -> ExceptT HieDbException m a)
-> IO (Either HieDbException a) -> ExceptT HieDbException m a
forall a b. (a -> b) -> a -> b
$
                    String
-> (HieDb -> IO (Either HieDbException a))
-> IO (Either HieDbException a)
forall a. String -> (HieDb -> IO a) -> IO a
HieDb.withHieDb String
hiedbPath ((a -> Either HieDbException a)
-> IO a -> IO (Either HieDbException a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either HieDbException a
forall a b. b -> Either a b
Right (IO a -> IO (Either HieDbException a))
-> (HieDb -> IO a) -> HieDb -> IO (Either HieDbException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDb -> IO a
hieDbFn)
                        IO (Either HieDbException a)
-> (IOException -> IO (Either HieDbException a))
-> IO (Either HieDbException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Either HieDbException a -> IO (Either HieDbException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HieDbException a -> IO (Either HieDbException a))
-> (IOException -> Either HieDbException a)
-> IOException
-> IO (Either HieDbException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDbException -> Either HieDbException a
forall a b. a -> Either a b
Left (HieDbException -> Either HieDbException a)
-> (IOException -> HieDbException)
-> IOException
-> Either HieDbException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> HieDbException
HieDbIOException)
                        IO (Either HieDbException a)
-> (SQLError -> IO (Either HieDbException a))
-> IO (Either HieDbException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Either HieDbException a -> IO (Either HieDbException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HieDbException a -> IO (Either HieDbException a))
-> (SQLError -> Either HieDbException a)
-> SQLError
-> IO (Either HieDbException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDbException -> Either HieDbException a
forall a b. a -> Either a b
Left (HieDbException -> Either HieDbException a)
-> (SQLError -> HieDbException)
-> SQLError
-> Either HieDbException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLError -> HieDbException
HieDbSqlException)
                        IO (Either HieDbException a)
-> (SomeException -> IO (Either HieDbException a))
-> IO (Either HieDbException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Either HieDbException a -> IO (Either HieDbException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HieDbException a -> IO (Either HieDbException a))
-> (HieDbException -> Either HieDbException a)
-> HieDbException
-> IO (Either HieDbException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDbException -> Either HieDbException a
forall a b. a -> Either a b
Left (HieDbException -> IO (Either HieDbException a))
-> HieDbException -> IO (Either HieDbException a)
forall a b. (a -> b) -> a -> b
$ HieDbException
HieDbOtherException)
            )
                StaticEnv
staticEnv.hieDbPath

-- | Run an hiedb action with the MaybeT Monad
runHieDbMaybeT :: (HasStaticEnv m, MonadIO m) => (HieDb.HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT :: forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT = ExceptT HieDbException m a -> MaybeT m a
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT (ExceptT HieDbException m a -> MaybeT m a)
-> ((HieDb -> IO a) -> ExceptT HieDbException m a)
-> (HieDb -> IO a)
-> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HieDb -> IO a) -> ExceptT HieDbException m a
forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> ExceptT HieDbException m a
runHieDbExceptT