{-# 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 msg :: String
msg) = "panic! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
panic :: String -> a
panic :: String -> a
panic msg :: 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 msg :: 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 action :: 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 msg :: 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 str :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
parsePkgId :: String -> Maybe (String, Version)
parsePkgId :: String -> Maybe (String, Version)
parsePkgId s :: 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
/='-') (ShowS
forall a. [a] -> [a]
reverse String
s) of
(vers :: String
vers, '-':pkg :: 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))
_ -> Maybe (String, Version)
forall a. Maybe a
Nothing
parsePkgIdBS :: ByteString -> Maybe (ByteString, Version)
parsePkgIdBS :: ByteString -> Maybe (ByteString, Version)
parsePkgIdBS bs :: ByteString
bs =
case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='-') (ByteString -> ByteString
BS.reverse ByteString
bs) of
(vers :: ByteString
vers, pkg' :: 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 vers :: 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 vers :: 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 b :: [Int]
b _) = [Int] -> [String] -> Version
Version (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take 2 [Int]
b) []
sameMajorVersionAs :: Version -> Version -> Bool
sameMajorVersionAs :: Version -> Version -> Bool
sameMajorVersionAs a :: Version
a b :: 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 p :: ReadP t
p i :: String
i =
case ReadP t -> String -> Maybe t
forall t. ReadP t -> String -> Maybe t
runReadPMay ReadP t
p String
i of
Just x :: t
x -> t
x
Nothing -> String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ "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 p :: ReadP t
p i :: 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 -> 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
(a :: t
a,""):[] -> t -> Maybe t
forall a. a -> Maybe a
Just t
a
_ -> Maybe t
forall a. Maybe a
Nothing
appCacheDir :: IO FilePath
appCacheDir :: IO String
appCacheDir =
(String -> ShowS
</> "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 "XDG_CACHE_HOME" (String -> IO String
homeRel String
cache)
where
lookupEnv' :: String -> IO (Maybe String)
lookupEnv' var :: 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 var :: String
var def :: 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
>>= \m :: Maybe String
m -> case Maybe String
m of Nothing -> IO String
def; Just x :: String
x -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
homeRel :: String -> IO String
homeRel path :: 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
"mingw32" -> String
windowsCache
_ -> String
unixCache
windowsCache :: String
windowsCache = "Local Settings" String -> ShowS
</> "Cache"
unixCache :: String
unixCache = ".cache"
replace :: String -> String -> String -> String
replace :: String -> String -> ShowS
replace n :: String
n r :: String
r hs' :: String
hs' = String -> ShowS
go "" String
hs'
where
go :: String -> ShowS
go acc :: String
acc h :: 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 acc :: String
acc (h :: Char
h:hs :: String
hs) = String -> ShowS
go (Char
hChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) String
hs
go acc :: 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 f :: 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)