module Hix.Managed.Cabal.Init where

import Distribution.Client.Config (defaultCacheDir)
import Distribution.Client.GlobalFlags (GlobalFlags (..), defaultGlobalFlags)
import Distribution.Client.NixStyleOptions (NixStyleFlags (..), defaultNixStyleFlags)
import Distribution.Client.ProjectFlags (flagIgnoreProject)
import Distribution.Client.Types (RemoteRepo (..))
import Distribution.Parsec (eitherParsec)
import Distribution.Simple.Program (defaultProgramDb)
import Distribution.Simple.Setup (ConfigFlags (..), defaultConfigFlags, maybeToFlag, toFlag)
import Distribution.Utils.NubList (toNubList)
import Exon (exon)
import Path (reldir, relfile, toFilePath, (</>))

import Hix.Data.Error (Error (Fatal))
import qualified Hix.Managed.Cabal.Data.Config
import Hix.Managed.Cabal.Data.Config (GhcPath (GhcPath), HackageRepoName, SolveConfig)
import Hix.Managed.Cabal.Repo (ensureHackageIndex)
import Hix.Monad (M, throwM, tryIOMWith)

data SolveFlags =
  SolveFlags {
    SolveFlags -> GlobalFlags
global :: GlobalFlags,
    SolveFlags -> NixStyleFlags ()
main :: NixStyleFlags ()
  }

emptySolveFlags :: SolveFlags
emptySolveFlags :: SolveFlags
emptySolveFlags =
  SolveFlags {
    global :: GlobalFlags
global = GlobalFlags
defaultGlobalFlags {globalConfigFile = toFlag "/dev/null"},
    main :: NixStyleFlags ()
main = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
  }

hackageRepo ::
  HackageRepoName ->
  M RemoteRepo
hackageRepo :: HackageRepoName -> M RemoteRepo
hackageRepo HackageRepoName
repoName =
  case FilePath -> Either FilePath RemoteRepo
forall a. Parsec a => FilePath -> Either FilePath a
eitherParsec [exon|##{repoName}:http://hackage.haskell.org/|] of
    Right RemoteRepo
repo -> RemoteRepo -> M RemoteRepo
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteRepo
repo {remoteRepoSecure = Just True}
    Left FilePath
err -> Error -> M RemoteRepo
forall a. Error -> M a
throwM (Text -> Error
Fatal [exon|Parse error: #{toText err}|])

globalFlags :: RemoteRepo -> FilePath -> GlobalFlags
globalFlags :: RemoteRepo -> FilePath -> GlobalFlags
globalFlags RemoteRepo
hackage FilePath
cacheDir =
  GlobalFlags
defaultGlobalFlags {
    -- Cabal *always* reads ~/.cabal/config if no file is specified, and crashes if the file doesn't exist
    globalConfigFile = toFlag "/dev/null",
    globalCacheDir = toFlag cacheDir,
    globalRemoteRepos = toNubList [hackage]
  }

badCacheDir :: Text -> Error
badCacheDir :: Text -> Error
badCacheDir Text
err = Text -> Error
Fatal [exon|Cannot access Cabal cache dir: #{err}|]

mainFlags ::
  SolveConfig ->
  NixStyleFlags ()
mainFlags :: SolveConfig -> NixStyleFlags ()
mainFlags SolveConfig
conf =
  NixStyleFlags ()
basic {
    configFlags,
    projectFlags = basic.projectFlags {flagIgnoreProject = toFlag True}
  }
  where
    basic :: NixStyleFlags ()
basic = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()

    configFlags :: ConfigFlags
configFlags =
      (ProgramDb -> ConfigFlags
defaultConfigFlags ProgramDb
defaultProgramDb) {
        configHcPath = pathFlag [relfile|ghc|],
        configHcPkg = pathFlag [relfile|ghc-pkg|],
        configVerbosity = toFlag conf.verbosity
      }

    pathFlag :: Path Rel File -> Flag FilePath
pathFlag Path Rel File
exe = Maybe FilePath -> Flag FilePath
forall a. Maybe a -> Flag a
maybeToFlag (Path Rel File -> GhcPath -> FilePath
forall {t}. Path Rel t -> GhcPath -> FilePath
ghcPath Path Rel File
exe (GhcPath -> FilePath) -> Maybe GhcPath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SolveConfig
conf.ghc)

    ghcPath :: Path Rel t -> GhcPath -> FilePath
ghcPath Path Rel t
exe (GhcPath Path Abs Dir
dir) = Path Abs t -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir
dir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|bin|] Path Rel Dir -> Path Rel t -> Path Rel t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
exe)

initialize ::
  SolveConfig ->
  M SolveFlags
initialize :: SolveConfig -> M SolveFlags
initialize SolveConfig
conf = do
  RemoteRepo
hackage <- HackageRepoName -> M RemoteRepo
hackageRepo SolveConfig
conf.hackageRepoName
  FilePath
cacheDir <- (Text -> Error) -> IO FilePath -> M FilePath
forall a. (Text -> Error) -> IO a -> M a
tryIOMWith Text -> Error
badCacheDir IO FilePath
defaultCacheDir
  let global :: GlobalFlags
global = RemoteRepo -> FilePath -> GlobalFlags
globalFlags RemoteRepo
hackage FilePath
cacheDir
  let main :: NixStyleFlags ()
main = SolveConfig -> NixStyleFlags ()
mainFlags SolveConfig
conf
  SolveConfig -> GlobalFlags -> NixStyleFlags () -> M ()
ensureHackageIndex SolveConfig
conf GlobalFlags
global NixStyleFlags ()
main
  pure SolveFlags {GlobalFlags
global :: GlobalFlags
global :: GlobalFlags
global, NixStyleFlags ()
main :: NixStyleFlags ()
main :: NixStyleFlags ()
main}