Utils.hs 2.07 KB
Newer Older
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
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
  FlexibleInstances, TypeOperators #-}

module Argo.Utils where

import           Turtle
import           Prelude                 hiding ( FilePath )
import           System.Console.ANSI
import           System.Console.ANSI.Types      ( Color )
import           System.Posix.Signals
import           System.Process          hiding ( shell )

-- | Miscellaneous printing utilities
colorShell :: Color -> Shell () -> Shell ()
colorShell color s = setC color *> s *> setC White
  where setC c = liftIO $ setSGR [SetColor Foreground Dull c]

printInfo :: Text -> Shell ()
printError :: Text -> Shell ()
printWarning :: Text -> Shell ()
printInfo = printf ("Info:" % s)
printWarning = colorShell Yellow . printf ("Warning:" % s)
printError = colorShell Red . printf ("Error:" % s)

myWhich str = which str >>= \case
  (Just p) ->
    printInfo (format ("Found " % fp % " at " % fp % "\n") str p) >> return p
  Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str

sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do
  foundSocket <- testfile filePath
  when foundSocket $ go False
  printInfo $ format ("OK: " % s % " " % fp % "\n") desc filePath
 where
  go useSudo = do
    printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
    shell
        (format ((if useSudo then "sudo " else "") % "rm -f " % fp) filePath)
        empty
      >>= \case
            ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
            ExitFailure n -> if useSudo
              then printer $ format
                ("Failed to remove stale " % s % ", even with sudo.")
                desc
              else do
                printer $ format
                  ("Failed to remove stale " % s % ". Trying sudo..\n")
                  desc
                go True

cleanSocket = sudoRemoveFile printError "socket"
cleanLog = sudoRemoveFile printWarning "log file"

kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing