effectful-zoo-0.0.4.0: components/hedgehog/Effectful/Zoo/Hedgehog/Api/Internal/Cabal.hs
module Effectful.Zoo.Hedgehog.Api.Internal.Cabal
( findDefaultPlanJsonFile,
getPlanJsonFile,
binDist,
) where
import Data.Aeson
import Data.List qualified as L
import Data.Text qualified as T
import Effectful
import Effectful.Zoo.Core
import Effectful.Zoo.Environment
import Effectful.Zoo.Error.Static
import Effectful.Zoo.FileSystem
import Effectful.Zoo.Hedgehog.Api.Internal.Cabal.Types
import Effectful.Zoo.Hedgehog.Api.Internal.FilePath
import Effectful.Zoo.Log.Static
import HaskellWorks.Error.Types
import HaskellWorks.Prelude
import System.FilePath (takeDirectory, (</>))
-- | Find the nearest plan.json going upwards from the current directory.
findDefaultPlanJsonFile :: ()
=> r <: Error IOException
=> r <: FileSystem
=> r <: IOE
=> r <: Log Text
=> Eff r FilePath
findDefaultPlanJsonFile = getCurrentDirectory >>= go
where go :: ()
=> r <: Error IOException
=> r <: FileSystem
=> r <: IOE
=> r <: Log Text
=> FilePath
-> Eff r FilePath
go d = do
let file = d </> "dist-newstyle/cache/plan.json"
exists <- doesFileExist file
if exists
then return file
else do
let parent = takeDirectory d
if parent == d
then return "dist-newstyle/cache/plan.json"
else go parent
getPlanJsonFile :: ()
=> r <: Environment
=> r <: Error IOException
=> r <: FileSystem
=> r <: IOE
=> r <: Log Text
=> Eff r FilePath
getPlanJsonFile = do
maybeBuildDir <- lookupEnvMaybe "CABAL_BUILDDIR"
case maybeBuildDir of
Just buildDir -> pure $ ".." </> T.unpack buildDir </> "cache/plan.json"
Nothing -> findDefaultPlanJsonFile
-- | Consult the "plan.json" generated by cabal to get the path to the executable corresponding.
-- to a haskell package. It is assumed that the project has already been configured and the
-- executable has been built.
binDist:: ()
=> r <: Environment
=> r <: Error GenericError
=> r <: Error IOException
=> r <: FileSystem
=> r <: IOE
=> r <: Log Text
=> String
-- ^ Package name
-> Eff r FilePath
-- ^ Path to executable
binDist pkg = do
planJsonFile <- getPlanJsonFile
contents <- readLazyByteStringFile planJsonFile
case eitherDecode @Plan contents of
Right plan -> case L.filter matching plan.installPlan of
(component:_) -> case component.binFile of
Just bin -> return $ addExeSuffix (T.unpack bin)
Nothing -> throw $ GenericError $ "Missing bin-file in " <> tshow component
[] -> throw $ GenericError $ "Cannot find exe " <> tshow pkg <> " in plan"
Left msg -> throw $ GenericError $ "Cannot decode plan: " <> T.pack msg
where matching :: Component -> Bool
matching component = case component.componentName of
Just name -> name == "exe:" <> T.pack pkg
Nothing -> False