Cabal.hs

module HaskellWorks.Polysemy.Cabal
  ( findDefaultPlanJsonFile
  , getPlanJsonFile
  , binDist
  ) where

import           HaskellWorks.Polysemy.Cabal.Types
import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS
import           HaskellWorks.Polysemy.Error.Types
import           HaskellWorks.Polysemy.Prelude
import           HaskellWorks.Polysemy.System.Directory
import           HaskellWorks.Polysemy.System.Environment
import           System.FilePath                            (takeDirectory)

import           Data.Aeson
import qualified Data.List                                  as L
import qualified HaskellWorks.Polysemy.Data.Text            as T
import           HaskellWorks.Polysemy.FilePath
import           Polysemy
import           Polysemy.Error
import           Polysemy.Log

-- | Find the nearest plan.json going upwards from the current directory.
findDefaultPlanJsonFile :: ()
  => Member (Embed IO) r
  => Member (Error IOException) r
  => Member Log r
  => Sem r FilePath
findDefaultPlanJsonFile = getCurrentDirectory >>= go
  where go :: ()
          => Member (Embed IO) r
          => Member (Error IOException) r
          => Member Log r
          => FilePath
          -> Sem 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 :: ()
  => Member (Embed IO) r
  => Member (Error IOException) r
  => Member Log r
  => Sem r String
getPlanJsonFile =  do
  maybeBuildDir <- lookupEnv "CABAL_BUILDDIR"
  case maybeBuildDir of
    Just buildDir -> return $ ".." </> 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:: ()
  => Member (Embed IO) r
  => Member (Error GenericError) r
  => Member (Error IOException) r
  => Member Log r
  => String
  -- ^ Package name
  -> Sem r FilePath
  -- ^ Path to executable
binDist pkg = do
  planJsonFile <- getPlanJsonFile
  contents <- LBS.readFile planJsonFile

  case eitherDecode 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 componentName component of
          Just name -> name == "exe:" <> T.pack pkg
          Nothing   -> False