System.hs

{-# LANGUAGE CPP #-}
module Smerdyakov.System
  {-# WARNING "This is for me, not you." #-}
  where

import Data.Monoid ((<>))
import Control.Monad
import GHC.TypeLits
import GHC.Generics (Generic)
import Data.String (IsString(..))
import System.Exit (ExitCode(..))

import Smerdyakov.Internal.Class
import Smerdyakov.Internal.FreeIO

data Executable (s :: Symbol) = Executable String
  deriving (Eq, Show, Read, Generic)

data Sudo = Sudo
  deriving (Eq, Show, Read, Generic)

instance Gives Sudo where
  give = do
    -- This is not ideal, since attempts to sudo are logged and may result in
    -- warnings
    (exitStatus, _, _) <- shellA "sudo -n true"
    case exitStatus of
      ExitFailure _ -> throwA $ ExpectationFailure "Need sudo"
      ExitSuccess   -> return Sudo

instance Gives KnownOS where
  give = do
    uname <- shellWithErrA "uname"
    case uname of
      "Darwin" -> return OSXOS
      "Linux"  -> do
        x <- shellWithErrA "lsb_release -is"
        case x of
          "Ubuntu" -> return UbuntuOS
          "Debian" -> return DebianOS
          "Arch"   -> return ArchOS
          d        -> throwA . ExpectationFailure $ "Unknown distro: " <> d
      d        -> throwA . ExpectationFailure $ "Unknown distro: " <> d

instance (Needs KnownOS, Needs Sudo) => Gives (Executable "ack") where
  give = do
    Sudo <- give
    getPackage "ack-grep"
    return $ Executable "ack-grep"


data PackageDetails
  = PackageDetails
  { homebrew :: String
  , aptGet   :: String
  , pacman   :: String
  } deriving (Eq, Show, Read, Generic)

getPackage :: (Needs KnownOS) => PackageDetails -> Action ()
getPackage deets = do
  os <- give
  let run = void . shellWithErrA
  case os of
    OSXOS    -> run $ "brew install " <> homebrew deets
    UbuntuOS -> give >>= \Sudo -> run $ "sudo apt-get install " <> aptGet deets
    DebianOS -> give >>= \Sudo -> run $ "sudo apt-get install " <> aptGet deets
    ArchOS   -> give >>= \Sudo -> run $ "pacman -S " <> pacman deets


instance IsString PackageDetails where
  fromString s = PackageDetails s s s


-- * Operating systems



data KnownOS
  = DebianOS
  | ArchOS
  | UbuntuOS
  | OSXOS
  deriving (Eq, Show, Read, Generic)

{-
data Debian = Debian
data Arch = Arch
data OSX = OSX
data Linux = Linux
data Homebrew
type family PackageManagerNeeds a where
  PackageManagerNeeds Debian = ()
  PackageManagerNeeds Arch   = ()
  PackageManagerNeeds OSX    = Homebrew
-- This function generates a @Gives@ declaration with the OS and distribution
-- of the machine in which the program is compiled.
mkOSDec :: Q Dec
mkOSDec = do
  [d| instance Gives $osT where give = return $osC |]
  [d| hostOs :: HostOS ; hostOS = $hos |]
  -}