module HsInspect.Context where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT(..))
import Data.List (isSuffixOf)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import HsInspect.Util (locateDominating, locateDominatingDir)
import System.FilePath
data Context = Context
{ Context -> String
package_dir :: FilePath
, Context -> [Text]
ghcflags :: [Text]
, Context -> Text
ghcpath :: Text
, Context -> String
srcdir :: FilePath
}
findContext :: FilePath -> ExceptT String IO Context
findContext :: String -> ExceptT String IO Context
findContext String
src = do
String
ghcflags' <- String -> ExceptT String IO String
discoverGhcflags String
src
String
ghcpath' <- String -> ExceptT String IO String
discoverGhcpath String
src
let readWords :: String -> ExceptT String IO [Text]
readWords String
file = Text -> [Text]
T.words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT String IO Text
readFile' String
file
readFile' :: String -> ExceptT String IO Text
readFile' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
T.readFile
Text
ghcpath <- String -> ExceptT String IO Text
readFile' String
ghcpath'
String -> [Text] -> Text -> String -> Context
Context forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT String IO String
discoverPackageDir String
src forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT String IO [Text]
readWords String
ghcflags' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ghcpath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> String
takeDirectory String
ghcflags')
discoverPackageDir :: FilePath -> ExceptT String IO FilePath
discoverPackageDir :: String -> ExceptT String IO String
discoverPackageDir String
file = do
let dir :: String
dir = String -> String
takeDirectory String
file
isCabal :: String -> Bool
isCabal = (String
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`)
isHpack :: String -> Bool
isHpack = (String
"package.yaml" forall a. Eq a => a -> a -> Bool
==)
forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM String
"There must be a .cabal or package.yaml" forall a b. (a -> b) -> a -> b
$
(String -> Bool) -> String -> IO (Maybe String)
locateDominatingDir (\String
f -> String -> Bool
isCabal String
f Bool -> Bool -> Bool
|| String -> Bool
isHpack String
f) String
dir
discoverGhcflags :: FilePath -> ExceptT String IO FilePath
discoverGhcflags :: String -> ExceptT String IO String
discoverGhcflags String
file = do
let dir :: String
dir = String -> String
takeDirectory String
file
forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM (String
"There must be a .ghc.flags file. " forall a. [a] -> [a] -> [a]
++ String
help_ghcflags) forall a b. (a -> b) -> a -> b
$
(String -> Bool) -> String -> IO (Maybe String)
locateDominating (String
".ghc.flags" forall a. Eq a => a -> a -> Bool
==) String
dir
discoverGhcpath :: FilePath -> ExceptT String IO FilePath
discoverGhcpath :: String -> ExceptT String IO String
discoverGhcpath String
file = do
let dir :: String
dir = String -> String
takeDirectory String
file
forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM (String
"There must be a .ghc.path file. " forall a. [a] -> [a] -> [a]
++ String
help_ghcflags) forall a b. (a -> b) -> a -> b
$
(String -> Bool) -> String -> IO (Maybe String)
locateDominating (String
".ghc.path" forall a. Eq a => a -> a -> Bool
==) String
dir
help_ghcflags :: String
help_ghcflags :: String
help_ghcflags = String
"The cause of this error could be that this package has not been compiled yet, \
\or the ghcflags compiler plugin has not been installed for this package. \
\See https://gitlab.com/tseenshe/hsinspect#installation for more details."
failWithM :: Applicative m => e -> m (Maybe a) -> ExceptT e m a
failWithM :: forall (m :: * -> *) e a.
Applicative m =>
e -> m (Maybe a) -> ExceptT e m a
failWithM e
e m (Maybe a)
ma = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left e
e) forall a b. b -> Either a b
Right) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
ma