module Hix.Managed.Data.StateFileConfig where

import Path (Abs, Dir, File, Path, Rel, relfile)

data StateFileConfig =
  StateFileConfig {
    StateFileConfig -> Path Rel File
file :: Path Rel File,
    StateFileConfig -> Maybe (Path Abs Dir)
projectRoot :: Maybe (Path Abs Dir)
  }
  deriving stock (StateFileConfig -> StateFileConfig -> Bool
(StateFileConfig -> StateFileConfig -> Bool)
-> (StateFileConfig -> StateFileConfig -> Bool)
-> Eq StateFileConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateFileConfig -> StateFileConfig -> Bool
== :: StateFileConfig -> StateFileConfig -> Bool
$c/= :: StateFileConfig -> StateFileConfig -> Bool
/= :: StateFileConfig -> StateFileConfig -> Bool
Eq, Int -> StateFileConfig -> ShowS
[StateFileConfig] -> ShowS
StateFileConfig -> String
(Int -> StateFileConfig -> ShowS)
-> (StateFileConfig -> String)
-> ([StateFileConfig] -> ShowS)
-> Show StateFileConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateFileConfig -> ShowS
showsPrec :: Int -> StateFileConfig -> ShowS
$cshow :: StateFileConfig -> String
show :: StateFileConfig -> String
$cshowList :: [StateFileConfig] -> ShowS
showList :: [StateFileConfig] -> ShowS
Show, (forall x. StateFileConfig -> Rep StateFileConfig x)
-> (forall x. Rep StateFileConfig x -> StateFileConfig)
-> Generic StateFileConfig
forall x. Rep StateFileConfig x -> StateFileConfig
forall x. StateFileConfig -> Rep StateFileConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StateFileConfig -> Rep StateFileConfig x
from :: forall x. StateFileConfig -> Rep StateFileConfig x
$cto :: forall x. Rep StateFileConfig x -> StateFileConfig
to :: forall x. Rep StateFileConfig x -> StateFileConfig
Generic)

instance Default StateFileConfig where
  def :: StateFileConfig
def =
    StateFileConfig {
      file :: Path Rel File
file = [relfile|ops/managed.nix|],
      projectRoot :: Maybe (Path Abs Dir)
projectRoot = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
    }