module Hix.Data.ProjectFile where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ask)
import qualified Data.Text.IO as Text
import Path (File, Path, Rel, parent, toFilePath, (</>))
import Path.IO (createDirIfMissing)

import Hix.Data.Error (tryIO)
import qualified Hix.Monad
import Hix.Monad (Env (Env), M)

data ProjectFile =
  ProjectFile {
    ProjectFile -> Path Rel File
path :: Path Rel File,
    ProjectFile -> Text
content :: Text
  }
  deriving stock (ProjectFile -> ProjectFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectFile -> ProjectFile -> Bool
$c/= :: ProjectFile -> ProjectFile -> Bool
== :: ProjectFile -> ProjectFile -> Bool
$c== :: ProjectFile -> ProjectFile -> Bool
Eq, Int -> ProjectFile -> ShowS
[ProjectFile] -> ShowS
ProjectFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectFile] -> ShowS
$cshowList :: [ProjectFile] -> ShowS
show :: ProjectFile -> String
$cshow :: ProjectFile -> String
showsPrec :: Int -> ProjectFile -> ShowS
$cshowsPrec :: Int -> ProjectFile -> ShowS
Show, forall x. Rep ProjectFile x -> ProjectFile
forall x. ProjectFile -> Rep ProjectFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectFile x -> ProjectFile
$cfrom :: forall x. ProjectFile -> Rep ProjectFile x
Generic)

createFile :: ProjectFile -> M ()
createFile :: ProjectFile -> M ()
createFile ProjectFile
f = do
  Env {Path Abs Dir
$sel:cwd:Env :: Env -> Path Abs Dir
cwd :: Path Abs Dir
cwd} <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let
    file :: Path Abs File
file = Path Abs Dir
cwd forall b t. Path b Dir -> Path Rel t -> Path b t
</> ProjectFile
f.path
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. IO a -> ExceptT Error IO a
tryIO do
    forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True (forall b t. Path b t -> Path b Dir
parent Path Abs File
file)
    String -> Text -> IO ()
Text.writeFile (forall b t. Path b t -> String
toFilePath Path Abs File
file) ProjectFile
f.content