{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module HIE.Bios.Cradle.ProgramVersions ( ProgramVersions(..) , makeVersions , runCachedIO ) where import HIE.Bios.Types import qualified HIE.Bios.Process as Process import Colog.Core (LogAction (..), WithSeverity (..)) import Data.Version import Data.IORef import Text.ParserCombinators.ReadP (readP_to_S) data ProgramVersions = ProgramVersions { ProgramVersions -> CachedIO (Maybe Version) cabalVersion :: CachedIO (Maybe Version) , ProgramVersions -> CachedIO (Maybe Version) stackVersion :: CachedIO (Maybe Version) , ProgramVersions -> CachedIO (Maybe Version) ghcVersion :: CachedIO (Maybe Version) } newtype CachedIO a = CachedIO (IORef (Either (IO a) a)) makeCachedIO :: IO a -> IO (CachedIO a) makeCachedIO :: forall a. IO a -> IO (CachedIO a) makeCachedIO IO a act = IORef (Either (IO a) a) -> CachedIO a forall a. IORef (Either (IO a) a) -> CachedIO a CachedIO (IORef (Either (IO a) a) -> CachedIO a) -> IO (IORef (Either (IO a) a)) -> IO (CachedIO a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Either (IO a) a -> IO (IORef (Either (IO a) a)) forall a. a -> IO (IORef a) newIORef (IO a -> Either (IO a) a forall a b. a -> Either a b Left IO a act) runCachedIO :: CachedIO a -> IO a runCachedIO :: forall a. CachedIO a -> IO a runCachedIO (CachedIO IORef (Either (IO a) a) ref) = IORef (Either (IO a) a) -> IO (Either (IO a) a) forall a. IORef a -> IO a readIORef IORef (Either (IO a) a) ref IO (Either (IO a) a) -> (Either (IO a) a -> IO a) -> IO a forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Right a x -> a -> IO a forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure a x Left IO a act -> do a x <- IO a act IORef (Either (IO a) a) -> Either (IO a) a -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Either (IO a) a) ref (a -> Either (IO a) a forall a b. b -> Either a b Right a x) a -> IO a forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure a x makeVersions :: LogAction IO (WithSeverity Log) -> FilePath -> ([String] -> IO (CradleLoadResult String)) -> IO ProgramVersions makeVersions :: LogAction IO (WithSeverity Log) -> FilePath -> ([FilePath] -> IO (CradleLoadResult FilePath)) -> IO ProgramVersions makeVersions LogAction IO (WithSeverity Log) l FilePath wdir [FilePath] -> IO (CradleLoadResult FilePath) ghc = do CachedIO (Maybe Version) cabalVersion <- IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a. IO a -> IO (CachedIO a) makeCachedIO (IO (Maybe Version) -> IO (CachedIO (Maybe Version))) -> IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a b. (a -> b) -> a -> b $ LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getCabalVersion LogAction IO (WithSeverity Log) l FilePath wdir CachedIO (Maybe Version) stackVersion <- IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a. IO a -> IO (CachedIO a) makeCachedIO (IO (Maybe Version) -> IO (CachedIO (Maybe Version))) -> IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a b. (a -> b) -> a -> b $ LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getStackVersion LogAction IO (WithSeverity Log) l FilePath wdir CachedIO (Maybe Version) ghcVersion <- IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a. IO a -> IO (CachedIO a) makeCachedIO (IO (Maybe Version) -> IO (CachedIO (Maybe Version))) -> IO (Maybe Version) -> IO (CachedIO (Maybe Version)) forall a b. (a -> b) -> a -> b $ ([FilePath] -> IO (CradleLoadResult FilePath)) -> IO (Maybe Version) getGhcVersion [FilePath] -> IO (CradleLoadResult FilePath) ghc ProgramVersions -> IO ProgramVersions forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ProgramVersions{CachedIO (Maybe Version) cabalVersion :: CachedIO (Maybe Version) stackVersion :: CachedIO (Maybe Version) ghcVersion :: CachedIO (Maybe Version) cabalVersion :: CachedIO (Maybe Version) stackVersion :: CachedIO (Maybe Version) ghcVersion :: CachedIO (Maybe Version) ..} getCabalVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getCabalVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getCabalVersion LogAction IO (WithSeverity Log) l FilePath wdir = do CradleLoadResult FilePath res <- LogAction IO (WithSeverity Log) -> FilePath -> FilePath -> [FilePath] -> FilePath -> IO (CradleLoadResult FilePath) Process.readProcessWithCwd LogAction IO (WithSeverity Log) l FilePath wdir FilePath "cabal" [FilePath "--numeric-version"] FilePath "" case CradleLoadResult FilePath res of CradleSuccess FilePath stdo -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Version -> IO (Maybe Version)) -> Maybe Version -> IO (Maybe Version) forall a b. (a -> b) -> a -> b $ FilePath -> Maybe Version versionMaybe FilePath stdo CradleLoadResult FilePath _ -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Version forall a. Maybe a Nothing getStackVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getStackVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) getStackVersion LogAction IO (WithSeverity Log) l FilePath wdir = do CradleLoadResult FilePath res <- LogAction IO (WithSeverity Log) -> FilePath -> FilePath -> [FilePath] -> FilePath -> IO (CradleLoadResult FilePath) Process.readProcessWithCwd LogAction IO (WithSeverity Log) l FilePath wdir FilePath "stack" [FilePath "--numeric-version"] FilePath "" case CradleLoadResult FilePath res of CradleSuccess FilePath stdo -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Version -> IO (Maybe Version)) -> Maybe Version -> IO (Maybe Version) forall a b. (a -> b) -> a -> b $ FilePath -> Maybe Version versionMaybe FilePath stdo CradleLoadResult FilePath _ -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Version forall a. Maybe a Nothing getGhcVersion :: ([String] -> IO (CradleLoadResult String)) -> IO (Maybe Version) getGhcVersion :: ([FilePath] -> IO (CradleLoadResult FilePath)) -> IO (Maybe Version) getGhcVersion [FilePath] -> IO (CradleLoadResult FilePath) ghc = do CradleLoadResult FilePath res <- [FilePath] -> IO (CradleLoadResult FilePath) ghc [FilePath "--numeric-version"] case CradleLoadResult FilePath res of CradleSuccess FilePath stdo -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Version -> IO (Maybe Version)) -> Maybe Version -> IO (Maybe Version) forall a b. (a -> b) -> a -> b $ FilePath -> Maybe Version versionMaybe FilePath stdo CradleLoadResult FilePath _ -> Maybe Version -> IO (Maybe Version) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Version forall a. Maybe a Nothing versionMaybe :: String -> Maybe Version versionMaybe :: FilePath -> Maybe Version versionMaybe FilePath xs = case [(Version, FilePath)] -> [(Version, FilePath)] forall a. [a] -> [a] reverse ([(Version, FilePath)] -> [(Version, FilePath)]) -> [(Version, FilePath)] -> [(Version, FilePath)] forall a b. (a -> b) -> a -> b $ ReadP Version -> ReadS Version forall a. ReadP a -> ReadS a readP_to_S ReadP Version parseVersion FilePath xs of [] -> Maybe Version forall a. Maybe a Nothing ((Version, FilePath) x:[(Version, FilePath)] _) -> Version -> Maybe Version forall a. a -> Maybe a Just ((Version, FilePath) -> Version forall a b. (a, b) -> a fst (Version, FilePath) x)