module Hix.Managed.StateFile where

import qualified Data.Map.Strict as Map
import Exon (exon)
import Path (Abs, Dir, Path)

import Hix.Class.EncodeNix (encodeNix)
import Hix.Data.Monad (M)
import Hix.Data.NixExpr (Expr (..), ExprAttr (..))
import Hix.Data.Overrides (Overrides)
import qualified Hix.Log as Log
import Hix.Managed.Data.EnvContext (EnvContext)
import qualified Hix.Managed.Data.EnvState
import Hix.Managed.Data.EnvState (EnvState)
import Hix.Managed.Data.Initial (Initial (Initial))
import Hix.Managed.Data.ProjectState (ProjectState)
import qualified Hix.Managed.Handlers.StateFile
import Hix.Managed.Handlers.StateFile (StateFileHandlers)
import Hix.Managed.UpdateState (envStateForBuild)
import Hix.NixExpr (renderRootExpr)

renderMap ::
  Coercible k Text =>
  (v -> Expr) ->
  Map k v ->
  Expr
renderMap :: forall k v. Coercible k Text => (v -> Expr) -> Map k v -> Expr
renderMap v -> Expr
v =
  [ExprAttr] -> Expr
ExprAttrs ([ExprAttr] -> Expr) -> (Map k v -> [ExprAttr]) -> Map k v -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> ExprAttr) -> [(k, v)] -> [ExprAttr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Expr -> ExprAttr) -> (Text, Expr) -> ExprAttr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expr -> ExprAttr
ExprAttr ((Text, Expr) -> ExprAttr)
-> ((k, v) -> (Text, Expr)) -> (k, v) -> ExprAttr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Text) -> (v -> Expr) -> (k, v) -> (Text, Expr)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> Text
forall a b. Coercible a b => a -> b
coerce v -> Expr
v) ([(k, v)] -> [ExprAttr])
-> (Map k v -> [(k, v)]) -> Map k v -> [ExprAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderManaged' :: ProjectState -> Expr
renderManaged' :: ProjectState -> Expr
renderManaged' =
  ProjectState -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix

writeStateFile ::
  Text ->
  StateFileHandlers ->
  Maybe (Path Abs Dir) ->
  ProjectState ->
  M ()
writeStateFile :: Text
-> StateFileHandlers
-> Maybe (Path Abs Dir)
-> ProjectState
-> M ()
writeStateFile Text
purpose StateFileHandlers
handlers Maybe (Path Abs Dir)
tmpRoot ProjectState
state = do
  Text -> M ()
Log.debug [exon|writing managed state file for #{purpose}: #{renderRootExpr expr}|]
  StateFileHandlers
handlers.writeFile Maybe (Path Abs Dir)
tmpRoot Expr
expr
  where
    expr :: Expr
expr = ProjectState -> Expr
forall a. EncodeNix a => a -> Expr
encodeNix ProjectState
state

writeProjectState ::
  StateFileHandlers ->
  ProjectState ->
  M ()
writeProjectState :: StateFileHandlers -> ProjectState -> M ()
writeProjectState StateFileHandlers
handlers ProjectState
newState =
  Text
-> StateFileHandlers
-> Maybe (Path Abs Dir)
-> ProjectState
-> M ()
writeStateFile Text
"final result persistence" StateFileHandlers
handlers Maybe (Path Abs Dir)
forall a. Maybe a
Nothing ProjectState
newState

writeBuildStateFor ::
  Text ->
  StateFileHandlers ->
  Path Abs Dir ->
  EnvContext ->
  Overrides ->
  M ()
writeBuildStateFor :: Text
-> StateFileHandlers
-> Path Abs Dir
-> EnvContext
-> Overrides
-> M ()
writeBuildStateFor Text
purpose StateFileHandlers
handlers Path Abs Dir
tmpRoot EnvContext
context Overrides
overrides =
  Text
-> StateFileHandlers
-> Maybe (Path Abs Dir)
-> ProjectState
-> M ()
writeStateFile Text
purpose StateFileHandlers
handlers (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
tmpRoot) (EnvContext -> Overrides -> ProjectState
envStateForBuild EnvContext
context Overrides
overrides)

writeInitialEnvState ::
  StateFileHandlers ->
  Path Abs Dir ->
  EnvContext ->
  Initial EnvState ->
  M ()
writeInitialEnvState :: StateFileHandlers
-> Path Abs Dir -> EnvContext -> Initial EnvState -> M ()
writeInitialEnvState StateFileHandlers
handlers Path Abs Dir
tmpRoot EnvContext
context (Initial EnvState
state) =
  Text
-> StateFileHandlers
-> Path Abs Dir
-> EnvContext
-> Overrides
-> M ()
writeBuildStateFor Text
"env initialization" StateFileHandlers
handlers Path Abs Dir
tmpRoot EnvContext
context EnvState
state.overrides