{-# 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)