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 :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
Sem r FilePath
findDefaultPlanJsonFile = Sem r FilePath
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Sem r FilePath
getCurrentDirectory Sem r FilePath -> (FilePath -> Sem r FilePath) -> Sem r FilePath
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Sem r FilePath
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
FilePath -> Sem r FilePath
go
  where go :: ()
          => Member (Embed IO) r
          => Member (Error IOException) r
          => Member Log r
          => FilePath
          -> Sem r FilePath
        go :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
FilePath -> Sem r FilePath
go FilePath
d = do
          let file :: FilePath
file = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"dist-newstyle/cache/plan.json"
          Bool
exists <- FilePath -> Sem r Bool
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> Sem r Bool
doesFileExist FilePath
file
          if Bool
exists
            then FilePath -> Sem r FilePath
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file
            else do
              let parent :: FilePath
parent = FilePath -> FilePath
takeDirectory FilePath
d
              if FilePath
parent FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
d
                then FilePath -> Sem r FilePath
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"dist-newstyle/cache/plan.json"
                else FilePath -> Sem r FilePath
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
FilePath -> Sem r FilePath
go FilePath
parent


getPlanJsonFile :: ()
  => Member (Embed IO) r
  => Member (Error IOException) r
  => Member Log r
  => Sem r String
getPlanJsonFile :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
Sem r FilePath
getPlanJsonFile =  do
  Maybe FilePath
maybeBuildDir <- FilePath -> Sem r (Maybe FilePath)
forall (r :: EffectRow).
(HasCallStack, Member (Embed IO) r) =>
FilePath -> Sem r (Maybe FilePath)
lookupEnv FilePath
"CABAL_BUILDDIR"
  case Maybe FilePath
maybeBuildDir of
    Just FilePath
buildDir -> FilePath -> Sem r FilePath
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sem r FilePath) -> FilePath -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
".." FilePath -> FilePath -> FilePath
</> FilePath
buildDir FilePath -> FilePath -> FilePath
</> FilePath
"cache/plan.json"
    Maybe FilePath
Nothing       -> Sem r FilePath
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
Sem r FilePath
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 :: forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error GenericError) r,
 Member (Error IOException) r, Member Log r) =>
FilePath -> Sem r FilePath
binDist FilePath
pkg = do
  FilePath
planJsonFile <- Sem r FilePath
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r,
 Member Log r) =>
Sem r FilePath
getPlanJsonFile
  ByteString
contents <- FilePath -> Sem r ByteString
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> Sem r ByteString
LBS.readFile FilePath
planJsonFile

  case ByteString -> Either FilePath Plan
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
contents of
    Right Plan
plan -> case (Component -> Bool) -> [Component] -> [Component]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Component -> Bool
matching (Plan
plan Plan -> (Plan -> [Component]) -> [Component]
forall a b. a -> (a -> b) -> b
& Plan -> [Component]
installPlan) of
      (Component
component:[Component]
_) -> case Component
component Component -> (Component -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& Component -> Maybe Text
binFile of
        Just Text
bin -> FilePath -> Sem r FilePath
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Sem r FilePath) -> FilePath -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
addExeSuffix (Text -> FilePath
T.unpack Text
bin)
        Maybe Text
Nothing  -> GenericError -> Sem r FilePath
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (GenericError -> Sem r FilePath) -> GenericError -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ Text -> GenericError
GenericError (Text -> GenericError) -> Text -> GenericError
forall a b. (a -> b) -> a -> b
$ Text
"Missing bin-file in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Component -> Text
forall a. Show a => a -> Text
tshow Component
component
      [] -> GenericError -> Sem r FilePath
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (GenericError -> Sem r FilePath) -> GenericError -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ Text -> GenericError
GenericError (Text -> GenericError) -> Text -> GenericError
forall a b. (a -> b) -> a -> b
$ Text
"Cannot find exe " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. Show a => a -> Text
tshow FilePath
pkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in plan"
    Left FilePath
msg -> GenericError -> Sem r FilePath
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (GenericError -> Sem r FilePath) -> GenericError -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ Text -> GenericError
GenericError (Text -> GenericError) -> Text -> GenericError
forall a b. (a -> b) -> a -> b
$ Text
"Cannot decode plan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
msg
  where matching :: Component -> Bool
        matching :: Component -> Bool
matching Component
component = case Component -> Maybe Text
componentName Component
component of
          Just Text
name -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"exe:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pkg
          Maybe Text
Nothing   -> Bool
False