-
Notifications
You must be signed in to change notification settings - Fork 3
Expand file tree
/
Copy pathShellify.hs
More file actions
58 lines (49 loc) · 2.4 KB
/
Shellify.hs
File metadata and controls
58 lines (49 loc) · 2.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
module Shellify (printErrorAndReturnFailure, runShellify, calculateExpectedFiles) where
import Prelude hiding (readFile, writeFile)
import Options (Options())
import TemplateGeneration ( generateFlakeText, generateShellDotNixText, getRegistryDB)
import Control.Monad (guard, when)
import Data.Bool (bool)
import Data.Maybe (isNothing)
import Data.Text (pack, Text(), unpack)
import Data.Text.IO (hPutStrLn, readFile, writeFile)
import GHC.IO.Exception (ExitCode(ExitSuccess, ExitFailure))
import System.Directory (doesPathExist)
import System.Exit (exitWith)
import System.IO (stderr)
runShellify :: Options -> IO ()
runShellify opts =
getRegistryDB >>=
either
(printErrorAndReturnFailure . ("Error calling nix registry: " <>))
(mapM_ createAFile . (`calculateExpectedFiles` opts))
createAFile :: (Text, Text) -> IO ()
createAFile (name, content) = do extCde <- createFile (unpack name) content
when (extCde /= ExitSuccess)
$ exitWith extCde
where createFile :: FilePath -> Text -> IO ExitCode
createFile fileName expectedContents = do
fileContents <- traverse readFile . bool Nothing
(Just fileName)
=<< doesPathExist fileName
printError $ actionDescription (pack fileName) expectedContents fileContents
when (isNothing fileContents)
$ writeFile fileName expectedContents
return $ returnCode expectedContents fileContents
calculateExpectedFiles :: Text -> Options -> [(Text,Text)]
calculateExpectedFiles registry options =
("shell.nix", generateShellDotNixText options)
: maybe
[]
(pure . ("flake.nix",))
(generateFlakeText registry options)
actionDescription :: Text -> Text -> Maybe Text -> Text
actionDescription fName _ Nothing = fName <> " does not exist. Creating one"
actionDescription fName a (Just b) | a == b = "The existing " <> fName <> " is good already"
actionDescription fName _ _ = "A " <> fName <> " exists already. Delete it or move it and try again"
returnCode :: Text -> Maybe Text -> ExitCode
returnCode _ Nothing = ExitSuccess
returnCode a (Just b) | a == b = ExitSuccess
returnCode _ _ = ExitFailure 1
printErrorAndReturnFailure err = printError err >> exitWith (ExitFailure 1)
printError = hPutStrLn stderr