#!/usr/bin/env runhaskell
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

import Control.Monad
import System.Environment
import System.Exit
import System.IO
import System.Process

-- Note: to type check this code
-- `ghc manage.hs -Werror=all -fno-code'

main :: IO ()
main = do
  let showHelpOr args elseDo =
        if "--help" `elem` args then putStr help
        else elseDo

  getArgs >>= \case
    ( "os" : host : action
      : (partitionArgs -> (manageArgs, extraArgs))
      ) ->
        manageArgs `showHelpOr` do
          nixpkgs <- readNixpkgsPath
          exitWith =<< transparentProcess "nixos-rebuild" (action : nixosRebuildArgs nixpkgs host <> extraArgs)

    ( "install" : host
      : (partitionArgs -> (manageArgs, extraArgs))
      ) ->
        manageArgs `showHelpOr` do
          nixpkgs <- readNixpkgsPath
          exitWith =<< transparentProcess "nixos-install" (nixosInstallArgs nixpkgs host <> extraArgs)

    _ -> putStr help >> exitFailure

newtype StorePath = StorePath { unStorePath :: String }

defaultNixosCmdArgs :: StorePath -> String -> [String]
defaultNixosCmdArgs (unStorePath -> nixpkgsPath) hostname =
  [ "-I", "nixpkgs=" <> nixpkgsPath
  , "-I", "nixos-config=./nix/configurations/" <> hostname <> ".nix"
  , "--file", "./default.nix"
  , "--attr", "nixosConfigurations." <> hostname
  ]

nixosInstallArgs :: StorePath -> String -> [String]
nixosInstallArgs = defaultNixosCmdArgs

nixosRebuildArgs :: StorePath -> String -> [String]
nixosRebuildArgs =
  defaultNixosCmdArgs
  -- This is not a nixos-install flag
  <> (\_ _ -> ["--no-reexec"])

help :: String
help =
  unlines
    [ "Manage.hs"
    , ""
    , "Manage.hs is a thin wrapper to make nixos-{install,rebuild} easier to use."
    , "Black lives matter. Trans rights are human rights. No nazi bullsh*t."
    , ""
    , "Available commands:"
    , indent "os <hostname> <action>:" <> indent "run perhost action with nixos-rebuild"
    , indent "install <hostname>:" <> indent "run perhost action with nixos-install"
    , indent "--help:" <> indent "show this help menu"
    ]
  where indent = ("\t" <>)

partitionArgs :: [String] -> ([String], [String])
partitionArgs = finalize . span (/= "--")
  where finalize (xs, ys) = (xs, drop 1 ys)

quote :: String -> String
quote x = "\"" <> x <> "\""

-- https://stackoverflow.com/a/70162369
blueForeground :: String -> String
blueForeground x = "\ESC[34m" <> x <> "\ESC[0m"

-- |
-- Run with a shared std{in,out,err}
transparentProcess :: String -> [String] -> IO ExitCode
transparentProcess cmdName args = do
  hPutStrLn stderr
    $ "Executing: " <> (quote . blueForeground) (showCommandForUser cmdName args)
  (_, _, _, pid) <- createProcess
      ( proc cmdName args
      ) { std_in = UseHandle stdin
        , std_out = UseHandle stdout
        , std_err = UseHandle stderr
        }
  waitForProcess pid

readProcessFriendly :: String -> [String] -> String -> IO String
readProcessFriendly cmdName args inp = do
  hPutStrLn stderr
    $ "Executing: " <> (quote . blueForeground) (showCommandForUser cmdName args)
  readProcess cmdName args inp

readNixpkgsPath :: IO StorePath
readNixpkgsPath =
  StorePath . clean <$> readProcessFriendly
    "nix-instantiate"
    [ "--eval"
    , "-E"
    , "let sources = import ./npins; in sources.nixpkgs.outPath"
    ]
    ""
  where
    clean = filter (\c -> c /= '\n' && c /= '"')