packages feed

effectful-zoo-0.0.3.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.Dynamic
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