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 {
    $sel:global:SolveFlags :: GlobalFlags
global = GlobalFlags
defaultGlobalFlags {globalConfigFile :: Flag FilePath
globalConfigFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"/dev/null"},
    $sel:main:SolveFlags :: 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 :: Maybe Bool
remoteRepoSecure = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
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 :: Flag FilePath
globalConfigFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"/dev/null",
    globalCacheDir :: Flag FilePath
globalCacheDir = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
cacheDir,
    globalRemoteRepos :: NubList RemoteRepo
globalRemoteRepos = [RemoteRepo] -> NubList RemoteRepo
forall a. Ord a => [a] -> NubList a
toNubList [Item [RemoteRepo]
RemoteRepo
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
configFlags :: ConfigFlags
configFlags :: ConfigFlags
configFlags,
    projectFlags :: ProjectFlags
projectFlags = NixStyleFlags ()
basic.projectFlags {flagIgnoreProject :: Flag Bool
flagIgnoreProject = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True}
  }
  where
    basic :: NixStyleFlags ()
basic = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()

    configFlags :: ConfigFlags
configFlags =
      (ProgramDb -> ConfigFlags
defaultConfigFlags ProgramDb
defaultProgramDb) {
        configHcPath :: Flag FilePath
configHcPath = Path Rel File -> Flag FilePath
pathFlag [relfile|ghc|],
        configHcPkg :: Flag FilePath
configHcPkg = Path Rel File -> Flag FilePath
pathFlag [relfile|ghc-pkg|],
        configVerbosity :: Flag Verbosity
configVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag SolveConfig
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
$sel:global:SolveFlags :: GlobalFlags
global :: GlobalFlags
global, NixStyleFlags ()
$sel:main:SolveFlags :: NixStyleFlags ()
main :: NixStyleFlags ()
main}