{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-}
module CabalHelper.Shared.Common where
#ifdef MIN_VERSION_Cabal
#undef CH_MIN_VERSION_Cabal
#define CH_MIN_VERSION_Cabal MIN_VERSION_Cabal
#endif
import Distribution.PackageDescription
( GenericPackageDescription
)
import Distribution.Verbosity
( Verbosity
)
#if CH_MIN_VERSION_Cabal(2,2,0)
import qualified Distribution.PackageDescription.Parsec as P
#else
import qualified Distribution.PackageDescription.Parse as P
#endif
import Control.Applicative
import Control.Exception as E
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Version
import Data.Typeable
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import System.Environment
import System.IO
import qualified System.Info
import System.Exit
import System.Directory
import System.FilePath
import Text.ParserCombinators.ReadP
import Prelude
data Panic = Panic String deriving (Typeable)
instance Exception Panic
instance Show Panic where
show :: Panic -> String
show (Panic String
msg) = String
"panic! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
panic :: String -> a
panic :: String -> a
panic String
msg = Panic -> a
forall a e. Exception e => e -> a
throw (Panic -> a) -> Panic -> a
forall a b. (a -> b) -> a -> b
$ String -> Panic
Panic String
msg
panicIO :: String -> IO a
panicIO :: String -> IO a
panicIO String
msg = Panic -> IO a
forall e a. Exception e => e -> IO a
throwIO (Panic -> IO a) -> Panic -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Panic
Panic String
msg
handlePanic :: IO a -> IO a
handlePanic :: IO a -> IO a
handlePanic IO a
action =
IO a
action IO a -> (Panic -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(Panic String
msg) -> String -> IO ()
errMsg String
msg IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure
errMsg :: String -> IO ()
errMsg :: String -> IO ()
errMsg String
str = do
String
prog <- IO String
getProgName
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
parsePkgId :: String -> Maybe (String, Version)
parsePkgId :: String -> Maybe (String, Version)
parsePkgId String
s =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'-') (ShowS
forall a. [a] -> [a]
reverse String
s) of
(String
vers, Char
'-':String
pkg) -> (String, Version) -> Maybe (String, Version)
forall a. a -> Maybe a
Just (ShowS
forall a. [a] -> [a]
reverse String
pkg, String -> Version
parseVer (ShowS
forall a. [a] -> [a]
reverse String
vers))
(String, String)
_ -> Maybe (String, Version)
forall a. Maybe a
Nothing
parsePkgIdBS :: ByteString -> Maybe (ByteString, Version)
parsePkgIdBS :: ByteString -> Maybe (ByteString, Version)
parsePkgIdBS ByteString
bs =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'-') (ByteString -> ByteString
BS.reverse ByteString
bs) of
(ByteString
vers, ByteString
pkg') ->
(ByteString, Version) -> Maybe (ByteString, Version)
forall a. a -> Maybe a
Just ( ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.tail ByteString
pkg'
, String -> Version
parseVer (ByteString -> String
BS8.unpack (ByteString -> ByteString
BS.reverse ByteString
vers)))
parseVer :: String -> Version
parseVer :: String -> Version
parseVer String
vers = ReadP Version -> String -> Version
forall t. ReadP t -> String -> t
runReadP ReadP Version
parseVersion String
vers
parseVerMay :: String -> Maybe Version
parseVerMay :: String -> Maybe Version
parseVerMay String
vers = ReadP Version -> String -> Maybe Version
forall t. ReadP t -> String -> Maybe t
runReadPMay ReadP Version
parseVersion String
vers
trim :: String -> String
trim :: ShowS
trim = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
majorVer :: Version -> Version
majorVer :: Version -> Version
majorVer (Version [Int]
b [String]
_) = [Int] -> [String] -> Version
Version (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 [Int]
b) []
sameMajorVersionAs :: Version -> Version -> Bool
sameMajorVersionAs :: Version -> Version -> Bool
sameMajorVersionAs Version
a Version
b = Version -> Version
majorVer Version
a Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Version
majorVer Version
b
runReadP :: ReadP t -> String -> t
runReadP :: ReadP t -> String -> t
runReadP ReadP t
p String
i =
case ReadP t -> String -> Maybe t
forall t. ReadP t -> String -> Maybe t
runReadPMay ReadP t
p String
i of
Just t
x -> t
x
Maybe t
Nothing -> String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String
"Error parsing version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
i
runReadPMay :: ReadP t -> String -> Maybe t
runReadPMay :: ReadP t -> String -> Maybe t
runReadPMay ReadP t
p String
i = case ((t, String) -> Bool) -> [(t, String)] -> [(t, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"") (String -> Bool) -> ((t, String) -> String) -> (t, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t, String) -> String
forall a b. (a, b) -> b
snd) ([(t, String)] -> [(t, String)]) -> [(t, String)] -> [(t, String)]
forall a b. (a -> b) -> a -> b
$ ReadP t -> ReadS t
forall a. ReadP a -> ReadS a
readP_to_S ReadP t
p String
i of
(t
a,String
""):[] -> t -> Maybe t
forall a. a -> Maybe a
Just t
a
[(t, String)]
_ -> Maybe t
forall a. Maybe a
Nothing
appCacheDir :: IO FilePath
appCacheDir :: IO String
appCacheDir =
(String -> ShowS
</> String
"cabal-helper") ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String -> IO String
getEnvDefault String
"XDG_CACHE_HOME" (String -> IO String
homeRel String
cache)
where
lookupEnv' :: String -> IO (Maybe String)
lookupEnv' String
var = do [(String, String)]
env <- IO [(String, String)]
getEnvironment; Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
var [(String, String)]
env)
getEnvDefault :: String -> IO String -> IO String
getEnvDefault String
var IO String
def = String -> IO (Maybe String)
lookupEnv' String
var IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe String
m -> case Maybe String
m of Maybe String
Nothing -> IO String
def; Just String
x -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
homeRel :: String -> IO String
homeRel String
path = (String -> ShowS
</> String
path) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory
cache :: String
cache =
case String
System.Info.os of
String
"mingw32" -> String
windowsCache
String
_ -> String
unixCache
windowsCache :: String
windowsCache = String
"Local Settings" String -> ShowS
</> String
"Cache"
unixCache :: String
unixCache = String
".cache"
replace :: String -> String -> String -> String
replace :: String -> String -> ShowS
replace String
n String
r String
hs' = String -> ShowS
go String
"" String
hs'
where
go :: String -> ShowS
go String
acc String
h
| Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) String
h String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n =
ShowS
forall a. [a] -> [a]
reverse String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) String
h
go String
acc (Char
h:String
hs) = String -> ShowS
go (Char
hChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) String
hs
go String
acc [] = ShowS
forall a. [a] -> [a]
reverse String
acc
readPackageDescription
:: Verbosity
-> FilePath
-> IO GenericPackageDescription
#if CH_MIN_VERSION_Cabal(2,0,0)
readPackageDescription :: Verbosity -> String -> IO GenericPackageDescription
readPackageDescription = Verbosity -> String -> IO GenericPackageDescription
Verbosity -> String -> IO GenericPackageDescription
P.readGenericPackageDescription
#else
readPackageDescription = P.readPackageDescription
#endif
mightExist :: FilePath -> IO (Maybe FilePath)
mightExist :: String -> IO (Maybe String)
mightExist String
f = do
Bool
exists <- String -> IO Bool
doesFileExist String
f
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then (String -> Maybe String
forall a. a -> Maybe a
Just String
f) else (Maybe String
forall a. Maybe a
Nothing)