{-# LANGUAGE DeriveDataTypeable #-}
{- |
   Module      : Data.FileStore.MercurialCommandServer
   Copyright   : Copyright (C) 2011 John Lenz (lenz@math.uic.edu)
   License     : BSD 3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : GHC 6.10 required

   In version 1.9, mercurial introduced a command server which allows
   a single instance of mercurial to be launched and multiple commands
   can be executed without requiring mercurial to start and stop.  See
   http://mercurial.selenic.com/wiki/CommandServer
-}

module Data.FileStore.MercurialCommandServer
    ( runMercurialCommand
    , rawRunMercurialCommand
    )
where

import Control.Applicative ((<$>))
import Control.Exception (Exception, onException, throwIO)
import Control.Monad (when)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.Char (isLower, isUpper)
import Data.FileStore.Utils (runShellCommand)
import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef)
import Data.List (intercalate, isPrefixOf)
import Data.List.Split (splitOn)
import Data.Typeable (Typeable)
import Data.Word (Word32)
import System.Exit (ExitCode(..))
import System.IO (Handle, hClose, hPutStr, hFlush)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (runInteractiveProcess)

import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.UTF8 as LUTF8
import qualified Data.Map as M
import qualified System.Info as SI

-- | Maximum number of servers to keep around
maxPoolSize :: Int
maxPoolSize :: Int
maxPoolSize = Int
2

-- | Run a mercurial command and return error status, error output, standard output.  The repository
-- is used as working directory.
runMercurialCommand :: FilePath -> String -> [String] -> IO (ExitCode, String, BL.ByteString)
runMercurialCommand :: String -> String -> [String] -> IO (ExitCode, String, ByteString)
runMercurialCommand String
repo String
command [String]
args = do
  Maybe (Handle, Handle, Handle)
server <- String -> IO (Maybe (Handle, Handle, Handle))
getServer String
repo
  case Maybe (Handle, Handle, Handle)
server of
     Maybe (Handle, Handle, Handle)
Nothing -> String -> String -> [String] -> IO (ExitCode, String, ByteString)
rawRunMercurialCommand String
repo String
command [String]
args
     Just (Handle, Handle, Handle)
h  -> do (ExitCode, String, ByteString)
ret <- String
-> [String]
-> (Handle, Handle, Handle)
-> IO (ExitCode, String, ByteString)
runMercurialServer String
command [String]
args (Handle, Handle, Handle)
h forall a b. IO a -> IO b -> IO a
`onException` (Handle, Handle, Handle) -> IO ()
cleanupServer (Handle, Handle, Handle)
h
                   String -> (Handle, Handle, Handle) -> IO ()
putServer String
repo (Handle, Handle, Handle)
h
                   forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode, String, ByteString)
ret

-- | Run a mercurial command directly without using the server.
rawRunMercurialCommand :: FilePath -> String -> [String] -> IO (ExitCode, String, BL.ByteString)
rawRunMercurialCommand :: String -> String -> [String] -> IO (ExitCode, String, ByteString)
rawRunMercurialCommand String
repo String
command [String]
args = do
   let env :: [(String, String)]
env = [(String
"HGENCODING",String
"utf8")]
   (ExitCode
status, ByteString
err, ByteString
out) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
repo (forall a. a -> Maybe a
Just [(String, String)]
env) String
"hg" (String
command forall a. a -> [a] -> [a]
: [String]
args)
   forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
status, ByteString -> String
LUTF8.toString ByteString
err, ByteString
out)

-- | Create a new command server for the given repository
createServer :: FilePath -> IO (Handle,Handle,Handle)
createServer :: String -> IO (Handle, Handle, Handle)
createServer String
repo = do
    (Handle
hin,Handle
hout,Handle
herr,ProcessHandle
_) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
"hg" [String
"serve", String
"--cmdserver", String
"pipe"] (forall a. a -> Maybe a
Just String
repo) forall a. Maybe a
Nothing
    MercurialMessage
hello <- Handle -> IO MercurialMessage
readMessage Handle
hout
    case MercurialMessage
hello of
       MessageO ByteString
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hin,Handle
hout,Handle
herr)
       MessageE ByteString
x -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException (ByteString -> String
UTF8.toString ByteString
x)
       MercurialMessage
_          -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException String
"unknown hello message"

-- | Cleanup a command sever.  Mercurial will automatically exit itself
--   when the handles are closed.
cleanupServer :: (Handle,Handle,Handle) -> IO ()
cleanupServer :: (Handle, Handle, Handle) -> IO ()
cleanupServer (Handle
hin,Handle
hout,Handle
herr) = Handle -> IO ()
hClose Handle
hin forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
hout forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
herr

-- | format a command for sending to the server
formatCommand :: String -> [String] -> B.ByteString
formatCommand :: String -> [String] -> ByteString
formatCommand String
cmd [String]
args = String -> ByteString
UTF8.fromString forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"\0" forall a b. (a -> b) -> a -> b
$ String
cmd forall a. a -> [a] -> [a]
: [String]
args

-- | run a command using the mercurial server
runMercurialServer :: String -> [String] -> (Handle,Handle,Handle) -> IO (ExitCode, String, BL.ByteString)
runMercurialServer :: String
-> [String]
-> (Handle, Handle, Handle)
-> IO (ExitCode, String, ByteString)
runMercurialServer String
cmd [String]
args (Handle
hin,Handle
hout,Handle
herr) = do
    Handle -> String -> IO ()
hPutStr Handle
hin String
"runcommand\n"
    let fcmd :: ByteString
fcmd = String -> [String] -> ByteString
formatCommand String
cmd [String]
args
    Handle -> Word32 -> IO ()
hWriteWord32be Handle
hin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
fcmd
    Handle -> ByteString -> IO ()
B.hPut Handle
hin ByteString
fcmd
    Handle -> IO ()
hFlush Handle
hin
    Handle -> Handle -> IO (ExitCode, String, ByteString)
processUntilR Handle
hout Handle
herr

-- | Read messages from the server until the command finishes or an error message appears
processUntilR :: Handle -> Handle -> IO (ExitCode, String, BL.ByteString)
processUntilR :: Handle -> Handle -> IO (ExitCode, String, ByteString)
processUntilR Handle
hout Handle
_ = ByteString -> ByteString -> IO (ExitCode, String, ByteString)
loop ByteString
BL.empty ByteString
BL.empty
  where loop :: ByteString -> ByteString -> IO (ExitCode, String, ByteString)
loop ByteString
out ByteString
err =
          do MercurialMessage
m <- Handle -> IO MercurialMessage
readMessage Handle
hout
             case MercurialMessage
m of
                MessageO ByteString
x -> ByteString -> ByteString -> IO (ExitCode, String, ByteString)
loop (ByteString -> ByteString -> ByteString
BL.append ByteString
out forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks [ByteString
x]) ByteString
err
                MessageE ByteString
x -> ByteString -> ByteString -> IO (ExitCode, String, ByteString)
loop ByteString
out (ByteString -> ByteString -> ByteString
BL.append ByteString
err forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks [ByteString
x])
                MessageR Int
c -> if Int
c forall a. Eq a => a -> a -> Bool
== Int
0
                                then forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, String
"", ByteString
out)
                                else forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
c, ByteString -> String
LUTF8.toString ByteString
err, ByteString
out)

data MercurialMessage = MessageO B.ByteString
                      | MessageE B.ByteString
                      | MessageR Int

data MercurialServerException = MercurialServerException String
  deriving (Int -> MercurialServerException -> ShowS
[MercurialServerException] -> ShowS
MercurialServerException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MercurialServerException] -> ShowS
$cshowList :: [MercurialServerException] -> ShowS
show :: MercurialServerException -> String
$cshow :: MercurialServerException -> String
showsPrec :: Int -> MercurialServerException -> ShowS
$cshowsPrec :: Int -> MercurialServerException -> ShowS
Show,Typeable)
instance Exception MercurialServerException

-- | Read a single message
readMessage :: Handle -> IO MercurialMessage
readMessage :: Handle -> IO MercurialMessage
readMessage Handle
hout = do
    ByteString
buf <- Handle -> Int -> IO ByteString
B.hGet Handle
hout Int
1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
buf forall a. Eq a => a -> a -> Bool
== ByteString
B.empty) forall a b. (a -> b) -> a -> b
$
       forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException String
"Unknown channel"
    let c :: Char
c = ByteString -> Char
B8.head ByteString
buf
    -- Mercurial says unknown lower case channels can be ignored, but upper case channels
    -- must be handled.  Currently there are two upper case channels, 'I' and 'L' which
    -- are both used for user input/output.  So error on any upper case channel.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char -> Bool
isUpper Char
c) forall a b. (a -> b) -> a -> b
$
       forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException forall a b. (a -> b) -> a -> b
$ String
"Unknown channel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c
    Int
len <- Handle -> IO Int
hReadWord32be Handle
hout
    ByteString
bdata <- Handle -> Int -> IO ByteString
B.hGet Handle
hout Int
len
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
bdata forall a. Eq a => a -> a -> Bool
/= Int
len) forall a b. (a -> b) -> a -> b
$
       forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException String
"Mercurial did not produce enough output"
    case Char
c of
      Char
'r' | Int
len forall a. Ord a => a -> a -> Bool
>= Int
4 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> MercurialMessage
MessageR forall a b. (a -> b) -> a -> b
$ ByteString -> Int
bsReadWord32be ByteString
bdata
      Char
'r'            -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException forall a b. (a -> b) -> a -> b
$ String
"return value is fewer than 4 bytes"
      Char
'o'            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> MercurialMessage
MessageO ByteString
bdata
      Char
'e'            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> MercurialMessage
MessageE ByteString
bdata
      Char
_ | Char -> Bool
isLower Char
c  -> Handle -> IO MercurialMessage
readMessage Handle
hout -- skip this message
      Char
_              -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException forall a b. (a -> b) -> a -> b
$ String
"Unknown channel " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c

-- | Read a 32-bit big-endian into an Int
hReadWord32be :: Handle -> IO Int
hReadWord32be :: Handle -> IO Int
hReadWord32be Handle
h = do
    ByteString
s <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
4
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
s forall a. Eq a => a -> a -> Bool
/= Int
4) forall a b. (a -> b) -> a -> b
$
      forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> MercurialServerException
MercurialServerException String
"unable to read int"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Int
bsReadWord32be ByteString
s

-- | Read a 32-bit big-endian from a bytestring into an Int
bsReadWord32be :: B.ByteString -> Int
bsReadWord32be :: ByteString -> Int
bsReadWord32be ByteString
s = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s HasCallStack => ByteString -> Int -> Word8
`B.index` Int
0) forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall a. Bits a => a -> a -> a
.|.
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s HasCallStack => ByteString -> Int -> Word8
`B.index` Int
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|.
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s HasCallStack => ByteString -> Int -> Word8
`B.index` Int
2) forall a. Bits a => a -> Int -> a
`shiftL`  Int
8) forall a. Bits a => a -> a -> a
.|.
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString
s HasCallStack => ByteString -> Int -> Word8
`B.index` Int
3) )

-- | Write a Word32 in big-endian to the handle
hWriteWord32be :: Handle -> Word32 -> IO ()
hWriteWord32be :: Handle -> Word32 -> IO ()
hWriteWord32be Handle
h Word32
w = Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
buf
  where buf :: ByteString
buf = [Word8] -> ByteString
B.pack [  -- fromIntegeral to convert to Word8
                forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
24),
                forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR` Int
16),
                forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w forall a. Bits a => a -> Int -> a
`shiftR`  Int
8),
                forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
              ]

-------------------------------------------------------------------
-- Maintain a pool of mercurial servers.  Currently stored in a
-- global IORef.  The code must provide two functions, to get
-- and put a server from the pool.  The code above takes care of
-- cleaning up if an exception occurs.
-------------------------------------------------------------------

data MercurialGlobalState = MercurialGlobalState {
    MercurialGlobalState -> Maybe Bool
useCommandServer :: Maybe Bool
  , MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles    :: M.Map FilePath [(Handle,Handle,Handle)]
} deriving (Int -> MercurialGlobalState -> ShowS
[MercurialGlobalState] -> ShowS
MercurialGlobalState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MercurialGlobalState] -> ShowS
$cshowList :: [MercurialGlobalState] -> ShowS
show :: MercurialGlobalState -> String
$cshow :: MercurialGlobalState -> String
showsPrec :: Int -> MercurialGlobalState -> ShowS
$cshowsPrec :: Int -> MercurialGlobalState -> ShowS
Show)

-- | See http://www.haskell.org/haskellwiki/Top_level_mutable_state
mercurialGlobalVar :: IORef MercurialGlobalState
{-# NOINLINE mercurialGlobalVar #-}
mercurialGlobalVar :: IORef MercurialGlobalState
mercurialGlobalVar = forall a. IO a -> a
unsafePerformIO (forall a. a -> IO (IORef a)
newIORef (Maybe Bool
-> Map String [(Handle, Handle, Handle)] -> MercurialGlobalState
MercurialGlobalState forall a. Maybe a
Nothing forall k a. Map k a
M.empty))

-- | Pull a server out of the pool.  Returns nothing if the mercurial version
--   does not support servers.
getServer :: FilePath -> IO (Maybe (Handle, Handle, Handle))
getServer :: String -> IO (Maybe (Handle, Handle, Handle))
getServer String
repo = do
    Maybe Bool
use <- MercurialGlobalState -> Maybe Bool
useCommandServer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef MercurialGlobalState
mercurialGlobalVar
    case Maybe Bool
use of
      Just Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Maybe Bool
Nothing    -> do Bool
isok <- IO Bool
checkVersion
                       forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef MercurialGlobalState
mercurialGlobalVar forall a b. (a -> b) -> a -> b
$ \MercurialGlobalState
state ->
                          (MercurialGlobalState
state { useCommandServer :: Maybe Bool
useCommandServer = forall a. a -> Maybe a
Just Bool
isok }, ())
                       String -> IO (Maybe (Handle, Handle, Handle))
getServer String
repo
      Just Bool
True  -> String -> IO (Maybe (Handle, Handle, Handle))
allocateServer String
repo

-- | Helper function called once we know that mercurial supports servers
allocateServer :: FilePath -> IO (Maybe (Handle, Handle, Handle))
allocateServer :: String -> IO (Maybe (Handle, Handle, Handle))
allocateServer String
repo = do
    Either () (Handle, Handle, Handle)
ret <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef MercurialGlobalState
mercurialGlobalVar forall a b. (a -> b) -> a -> b
$ \MercurialGlobalState
state ->
             case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
repo (MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles MercurialGlobalState
state) of
                Just ((Handle, Handle, Handle)
x:[(Handle, Handle, Handle)]
xs) -> (MercurialGlobalState
state { serverHandles :: Map String [(Handle, Handle, Handle)]
serverHandles = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
repo [(Handle, Handle, Handle)]
xs (MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles MercurialGlobalState
state)}, forall a b. b -> Either a b
Right (Handle, Handle, Handle)
x)
                Maybe [(Handle, Handle, Handle)]
_           -> (MercurialGlobalState
state, forall a b. a -> Either a b
Left ())
    case Either () (Handle, Handle, Handle)
ret of
      Right (Handle, Handle, Handle)
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Handle, Handle, Handle)
x
      Left () -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Handle, Handle, Handle)
createServer String
repo

-- | Puts a server back in the pool if the pool is not full,
--   otherwise closes the server.
putServer :: FilePath -> (Handle,Handle,Handle) -> IO ()
putServer :: String -> (Handle, Handle, Handle) -> IO ()
putServer String
repo (Handle, Handle, Handle)
h = do
    Either () ()
ret <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef MercurialGlobalState
mercurialGlobalVar forall a b. (a -> b) -> a -> b
$ \MercurialGlobalState
state -> do
              case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
repo (MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles MercurialGlobalState
state) of
                  Just [(Handle, Handle, Handle)]
xs | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Handle, Handle, Handle)]
xs forall a. Ord a => a -> a -> Bool
>= Int
maxPoolSize -> (MercurialGlobalState
state, forall a b. b -> Either a b
Right ())
                  Just [(Handle, Handle, Handle)]
xs -> (MercurialGlobalState
state { serverHandles :: Map String [(Handle, Handle, Handle)]
serverHandles = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
repo ((Handle, Handle, Handle)
hforall a. a -> [a] -> [a]
:[(Handle, Handle, Handle)]
xs) (MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles MercurialGlobalState
state)}, forall a b. a -> Either a b
Left ())
                  Maybe [(Handle, Handle, Handle)]
Nothing -> (MercurialGlobalState
state { serverHandles :: Map String [(Handle, Handle, Handle)]
serverHandles = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
repo [(Handle, Handle, Handle)
h] (MercurialGlobalState -> Map String [(Handle, Handle, Handle)]
serverHandles MercurialGlobalState
state)}, forall a b. a -> Either a b
Left ())
    case Either () ()
ret of
      Right () -> (Handle, Handle, Handle) -> IO ()
cleanupServer (Handle, Handle, Handle)
h
      Left  () -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check if the mercurial version supports servers
--   On windows, don't even try because talking to hg over a pipe does not
--   currently work correctly.
checkVersion :: IO Bool
checkVersion :: IO Bool
checkVersion
    | String -> Bool
isOperatingSystem String
"mingw32" = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    | Bool
otherwise                   = do
        (ExitCode
status,ByteString
_,ByteString
out) <- String
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand String
"." forall a. Maybe a
Nothing String
"hg" [String
"version", String
"-q"]
        case ExitCode
status of
          ExitFailure Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          ExitCode
ExitSuccess   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [Int]
parseVersion (ByteString -> String
LUTF8.toString ByteString
out) forall a. Ord a => a -> a -> Bool
>= [Int
2,Int
0]

-- | Helps to find out what operating system we are on
--   Example usage:
--      isOperatingSystem "mingw32" (on windows)
--      isOperatingSystem "darwin"
--      isOperatingSystem "linux"
isOperatingSystem :: String -> Bool
isOperatingSystem :: String -> Bool
isOperatingSystem String
sys = String
SI.os forall a. Eq a => a -> a -> Bool
== String
sys

-- | hg version -q returns something like "Mercurial Distributed SCM (version 1.9.1)"
--   This function returns the list [1,9,1]
parseVersion :: String -> [Int]
parseVersion :: String -> [Int]
parseVersion String
b = if Bool
starts then [Int]
verLst else [Int
0]
  where msg :: String
msg = String
"Mercurial Distributed SCM (version "
        starts :: Bool
starts = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
msg String
b
        ver :: String
ver    = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
')') forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg) String
b
        verLst :: [Int]
verLst = forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
ver