module Shellify (parseOptionsAndCalculateExpectedFiles, runShellify) where

import Prelude hiding (writeFile)
import Constants
import FlakeTemplate
import Options
import ShellifyTemplate
import TemplateGeneration

import Control.Monad (when, (>=>))
import Data.Bool (bool)
import Data.Text (pack, Text(), unpack)
import Data.Text.IO (hPutStrLn, writeFile)
import qualified Data.Text.IO as Text
import GHC.IO.Exception (ExitCode(ExitSuccess, ExitFailure))
import System.Directory (doesPathExist)
import System.Exit (exitWith)
import System.IO (stderr)

createAFile :: (Text, Text) -> IO ()
createAFile (Text
name, Text
content) = do ExitCode
extCde <- FilePath -> Text -> IO ExitCode
createFile (Text -> FilePath
unpack Text
name) Text
content
                                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
extCde ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess)
                                   (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
extCde


runShellify :: [Text] -> IO ()
runShellify :: [Text] -> IO ()
runShellify(Text
pName:[Text]
args) = IO (Either Text Text)
getRegistryDB
             IO (Either Text Text) -> (Either Text Text -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> IO ()) -> (Text -> IO ()) -> Either Text Text -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                   ((Text -> IO ExitCode
printErrorAndReturnFailure (Text -> IO ExitCode) -> (Text -> Text) -> Text -> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Error calling nix registry: " <>) ) (Text -> IO ExitCode) -> (ExitCode -> IO ()) -> Text -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith)
                   (\Text
registryDB -> (Text -> IO ())
-> ([(Text, Text)] -> IO ()) -> Either Text [(Text, Text)] -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> IO ()
printError
                                          (((Text, Text) -> IO ()) -> [(Text, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, Text) -> IO ()
createAFile)
                                          (Either Text [(Text, Text)] -> IO ())
-> Either Text [(Text, Text)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text] -> Either Text [(Text, Text)]
parseOptionsAndCalculateExpectedFiles Text
registryDB Text
pName [Text]
args)


parseOptionsAndCalculateExpectedFiles :: Text -> Text -> [Text] -> Either Text [(Text,Text)]
parseOptionsAndCalculateExpectedFiles :: Text -> Text -> [Text] -> Either Text [(Text, Text)]
parseOptionsAndCalculateExpectedFiles Text
registry Text
programName =
  (Options -> [(Text, Text)])
-> Either Text Options -> Either Text [(Text, Text)]
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Options
opts ->
        (Text
"shell.nix", Options -> Text
generateShellDotNixText Options
opts)
      (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            []
            ((Text, Text) -> [(Text, Text)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text) -> [(Text, Text)])
-> (Text -> (Text, Text)) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"flake.nix",))
            (Text -> Options -> Maybe Text
generateFlakeText Text
registry Options
opts))
  (Either Text Options -> Either Text [(Text, Text)])
-> ([Text] -> Either Text Options)
-> [Text]
-> Either Text [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Either Text Options
options Text
programName

createFile :: FilePath -> Text -> IO ExitCode
createFile :: FilePath -> Text -> IO ExitCode
createFile FilePath
fileName Text
expectedContents = do
  Maybe Text
fileContents <-     FilePath -> IO Bool
doesPathExist FilePath
fileName
                  IO Bool -> (Bool -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe Text) -> IO (Maybe Text) -> Bool -> IO (Maybe Text)
forall a. a -> a -> Bool -> a
bool
                       (Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)
                       (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
Text.readFile FilePath
fileName)
  Text -> IO ()
printError (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Text
actionDescription (FilePath -> Text
pack FilePath
fileName) Text
expectedContents Maybe Text
fileContents
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
shouldGenerateNewFile Maybe Text
fileContents)
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
writeFile FilePath
fileName Text
expectedContents
  ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> ExitCode
returnCode Text
expectedContents Maybe Text
fileContents

actionDescription :: Text -> Text -> Maybe Text -> Text
actionDescription :: Text -> Text -> Maybe Text -> Text
actionDescription Text
fName Text
_ Maybe Text
Nothing = Text
fName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist. Creating one"
actionDescription Text
fName Text
a (Just Text
b) | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b = Text
"The existing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is good already"
actionDescription Text
fName Text
_ Maybe Text
_ = Text
"A " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exists already. Delete it or move it and try again"

returnCode :: Text -> Maybe Text -> ExitCode
returnCode :: Text -> Maybe Text -> ExitCode
returnCode Text
_ Maybe Text
Nothing = ExitCode
ExitSuccess
returnCode Text
a (Just Text
b) | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b = ExitCode
ExitSuccess
returnCode Text
_ Maybe Text
_ = Int -> ExitCode
ExitFailure Int
1

shouldGenerateNewFile :: Maybe Text -> Bool
shouldGenerateNewFile :: Maybe Text -> Bool
shouldGenerateNewFile = (Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
forall a. Maybe a
Nothing)

printErrorAndReturnFailure :: Text -> IO ExitCode
printErrorAndReturnFailure Text
err = Text -> IO ()
printError Text
err IO () -> IO ExitCode -> IO ExitCode
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1)
printError :: Text -> IO ()
printError = Handle -> Text -> IO ()
hPutStrLn Handle
stderr