content: {-# LANGUAGE AllowAmbiguousTypes #-}
  
  module Axel.Haskell.Cabal where
  
  import Axel.Prelude
  
  import Axel.Eff ((:>>))
  import Axel.Eff.Console (putStr, putStrLn)
  import qualified Axel.Eff.Console as Effs
  import Axel.Eff.Error (Error(ProjectError), fatal)
  import qualified Axel.Eff.FileSystem as FS
  import qualified Axel.Eff.FileSystem as Effs
  import Axel.Eff.Process
    ( createIndependentProcess
    , handleGetLine
    , handleIsAtEnd
    , passthroughProcess
    , readProcess
    , waitOnProcess
    )
  import qualified Axel.Eff.Process as Effs
  import Axel.Haskell.Error (processStackOutputLine)
  import Axel.Sourcemap (ModuleInfo)
  import Axel.Utils.FilePath (takeFileName)
  import Axel.Utils.Monad (whileM)
  
  import Control.Lens (op)
  import Control.Lens.Operators ((%~), (^?!))
  import Control.Monad (void)
  
  import Data.Aeson.Key (toText)
  import Data.Aeson.KeyMap (keys)
  import Data.Aeson.Lens (_Array, _Object, key)
  import Data.Function ((&))
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  import Data.Vector (cons)
  import Data.Version (showVersion)
  import qualified Data.Yaml as Yaml
  
  import Effectful ((:>))
  import qualified Effectful as Eff
  import qualified Effectful.Error.Static as Eff
  
  import Paths_axel (version)
  
  import System.Exit (ExitCode(ExitFailure, ExitSuccess))
  
  type ProjectPath = FilePath
  
  type StackageId = Text
  
  type StackageResolver = Text
  
  type Target = Text
  
  type Version = Text
  
  axelVersion :: Version
  axelVersion = T.pack $ showVersion version
  
  axelPackageId :: StackageId
  axelPackageId = "axel"
  
  getProjectExecutableTargets ::
       (Effs.FileSystem :> effs) => ProjectPath -> Eff.Eff effs [Target]
  getProjectExecutableTargets projectPath =
    FS.withCurrentDirectory projectPath $ do
      config <- readPackageConfig
      pure $ map toText $ keys $ config ^?! key "executables" . _Object
  
  packageConfigRelativePath :: FilePath
  packageConfigRelativePath = FilePath "package.yaml"
  
  readPackageConfig :: (Effs.FileSystem :> effs) => Eff.Eff effs Yaml.Value
  readPackageConfig = do
    packageConfigContents <- FS.readFile packageConfigRelativePath
    case Yaml.decodeEither' $ T.encodeUtf8 packageConfigContents of
      Right contents -> pure contents
      Left _ -> fatal "readPackageConfig" "0001"
  
  addDependency ::
       (Effs.FileSystem :> effs) => StackageId -> ProjectPath -> Eff.Eff effs ()
  addDependency dependencyId projectPath =
    FS.withCurrentDirectory projectPath $ do
      config <- readPackageConfig
      let newContents :: Yaml.Value =
            config & key "dependencies" . _Array %~
            cons (Yaml.String dependencyId)
          encodedContents = T.decodeUtf8 $ Yaml.encode newContents
      FS.writeFile packageConfigRelativePath encodedContents
  
  buildProject ::
       ('[ Effs.Console, Eff.Error Error, Effs.FileSystem, Effs.Process] :>> effs)
    => ModuleInfo
    -> ProjectPath
    -> Eff.Eff effs ()
  buildProject moduleInfo projectPath = do
    FS.withCurrentDirectory projectPath $ do
      putStrLn ("Building " <> op FilePath (takeFileName projectPath) <> "...")
      (_, _, stderrHandle, processHandle) <-
        createIndependentProcess "cabal build --ghc-options='-ddump-json'"
      whileM (not <$> handleIsAtEnd stderrHandle) $ do
        stackOutputLine <- handleGetLine stderrHandle
        putStr $ T.unlines $ processStackOutputLine moduleInfo stackOutputLine
      exitCode <- waitOnProcess processHandle
      case exitCode of
        ExitSuccess -> pure ()
        ExitFailure _ -> Eff.throwError $ ProjectError "Project failed to build."
  
  createProject ::
       ('[ Effs.FileSystem, Effs.Process] :>> effs) => Text -> Eff.Eff effs ()
  createProject projectName =
    void $ readProcess ("cabal new " <> projectName <> " new-template")
  
  runProject ::
       ('[ Effs.Console, Eff.Error Error, Effs.FileSystem, Effs.Process] :>> effs)
    => ProjectPath
    -> Eff.Eff effs ()
  runProject projectPath = do
    targets <- getProjectExecutableTargets projectPath
    case targets of
      [target] -> do
        putStrLn $ "Running " <> target <> "..."
        void $ passthroughProcess ("cabal run " <> target)
      _ ->
        Eff.throwError $
        ProjectError "No executable target was unambiguously found!"
  
  includeAxelArguments :: Text
  includeAxelArguments = T.unwords ["--package", axelPackageId]
  