{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Make changes to the stack yaml file

module Stack.ConfigCmd
       (ConfigCmdSet(..)
       ,cfgCmdSet
       ,cfgCmdSetName
       ,cfgCmdName) where

import           Control.Monad.Catch (MonadMask, throwM)
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Control.Monad.Reader (MonadReader, asks)
import           Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.ByteString as S
import qualified Data.HashMap.Strict as HMap
import qualified Data.Yaml as Yaml
import           Network.HTTP.Client.Conduit (HasHttpManager)
import           Path
import           Stack.BuildPlan
import           Stack.Config (makeConcreteResolver)
import           Stack.Types

data ConfigCmdSet = ConfigCmdSetResolver AbstractResolver

cfgCmdSet :: ( MonadIO m
             , MonadBaseControl IO m
             , MonadMask m
             , MonadReader env m
             , HasBuildConfig env
             , HasHttpManager env
             , HasGHCVariant env
             , MonadLogger m)
             => ConfigCmdSet -> m ()
cfgCmdSet (ConfigCmdSetResolver newResolver) = do
    stackYaml <- fmap bcStackYaml (asks getBuildConfig)
    let stackYamlFp =
            toFilePath stackYaml
    -- We don't need to worry about checking for a valid yaml here
    (projectYamlConfig :: Yaml.Object) <-
        liftIO (Yaml.decodeFileEither stackYamlFp) >>=
        either throwM return
    -- TODO: custom snapshot support?
    newResolverText <- fmap resolverName (makeConcreteResolver newResolver)
    -- We checking here that the snapshot actually exists
    snap <- parseSnapName newResolverText
    _ <- loadMiniBuildPlan snap

    let projectYamlConfig' =
            HMap.insert
                "resolver"
                (Yaml.String newResolverText)
                projectYamlConfig
    liftIO
        (S.writeFile
             stackYamlFp
             (Yaml.encode projectYamlConfig'))
    return ()

cfgCmdName :: String
cfgCmdName = "config"

cfgCmdSetName :: String
cfgCmdSetName = "set"