{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} module Cabal.Paths ( Paths(..) , paths ) where import Imports import Data.Char import Data.Tuple import Data.Version hiding (parseVersion) import qualified Data.Version as Version import System.Exit hiding (die) import System.Directory import System.FilePath import System.IO import System.Process import Text.ParserCombinators.ReadP data Paths = Paths { Paths -> String ghc :: FilePath , Paths -> String ghcPkg :: FilePath , Paths -> String cache :: FilePath } deriving (Paths -> Paths -> Bool (Paths -> Paths -> Bool) -> (Paths -> Paths -> Bool) -> Eq Paths forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Paths -> Paths -> Bool == :: Paths -> Paths -> Bool $c/= :: Paths -> Paths -> Bool /= :: Paths -> Paths -> Bool Eq, Int -> Paths -> ShowS [Paths] -> ShowS Paths -> String (Int -> Paths -> ShowS) -> (Paths -> String) -> ([Paths] -> ShowS) -> Show Paths forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Paths -> ShowS showsPrec :: Int -> Paths -> ShowS $cshow :: Paths -> String show :: Paths -> String $cshowList :: [Paths] -> ShowS showList :: [Paths] -> ShowS Show) paths :: FilePath -> [String] -> IO Paths paths :: String -> [String] -> IO Paths paths String cabal [String] args = do String cabalVersion <- ShowS strip ShowS -> IO String -> IO String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> [String] -> String -> IO String readProcess String cabal [String "--numeric-version"] String "" let required :: Version required :: Version required = [Int] -> Version makeVersion [Int 3, Int 12] Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (String -> Maybe Version parseVersion String cabalVersion Maybe Version -> Maybe Version -> Bool forall a. Ord a => a -> a -> Bool < Version -> Maybe Version forall a. a -> Maybe a Just Version required) (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ do String -> IO () forall a. String -> IO a die (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "'cabal-install' version " String -> ShowS forall a. Semigroup a => a -> a -> a <> Version -> String showVersion Version required String -> ShowS forall a. Semigroup a => a -> a -> a <> String " or later is required, but 'cabal --numeric-version' returned " String -> ShowS forall a. Semigroup a => a -> a -> a <> String cabalVersion String -> ShowS forall a. Semigroup a => a -> a -> a <> String "." [(String, String)] values <- String -> [(String, String)] parseFields (String -> [(String, String)]) -> IO String -> IO [(String, String)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> [String] -> String -> IO String readProcess String cabal (String "path" String -> [String] -> [String] forall a. a -> [a] -> [a] : [String] args [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String "-v0"]) String "" let getPath :: String -> String -> IO FilePath getPath :: String -> String -> IO String getPath String subject String key = case String -> [(String, String)] -> Maybe String forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup String key [(String, String)] values of Maybe String Nothing -> String -> IO String forall a. String -> IO a die (String -> IO String) -> String -> IO String forall a b. (a -> b) -> a -> b $ String "Cannot determine the path to " String -> ShowS forall a. Semigroup a => a -> a -> a <> String subject String -> ShowS forall a. Semigroup a => a -> a -> a <> String ". Running 'cabal path' did not return a value for '" String -> ShowS forall a. Semigroup a => a -> a -> a <> String key String -> ShowS forall a. Semigroup a => a -> a -> a <> String "'." Just String path -> String -> IO String canonicalizePath String path String ghc <- String -> String -> IO String getPath String "'ghc'" String "compiler-path" String ghcVersion <- ShowS strip ShowS -> IO String -> IO String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> [String] -> String -> IO String readProcess String ghc [String "--numeric-version"] String "" let ghcPkg :: FilePath ghcPkg :: String ghcPkg = ShowS takeDirectory String ghc String -> ShowS </> String "ghc-pkg-" String -> ShowS forall a. Semigroup a => a -> a -> a <> String ghcVersion #ifdef mingw32_HOST_OS <.> "exe" #endif String -> IO Bool doesFileExist String ghcPkg IO Bool -> (Bool -> IO ()) -> IO () forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Bool True -> IO () forall (m :: * -> *). Monad m => m () pass Bool False -> String -> IO () forall a. String -> IO a die (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ String "Cannot determine the path to 'ghc-pkg' from '" String -> ShowS forall a. Semigroup a => a -> a -> a <> String ghc String -> ShowS forall a. Semigroup a => a -> a -> a <> String "'. File '" String -> ShowS forall a. Semigroup a => a -> a -> a <> String ghcPkg String -> ShowS forall a. Semigroup a => a -> a -> a <> String "' does not exist." String abi <- ShowS strip ShowS -> IO String -> IO String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> [String] -> String -> IO String readProcess String ghcPkg [String "--no-user-package-db", String "field", String "base", String "abi", String "--simple-output"] String "" String cache_home <- String -> String -> IO String getPath String "Cabal's cache directory" String "cache-home" let cache :: String cache = String cache_home String -> ShowS </> String "doctest" String -> ShowS </> String "ghc-" String -> ShowS forall a. Semigroup a => a -> a -> a <> String ghcVersion String -> ShowS forall a. Semigroup a => a -> a -> a <> String "-" String -> ShowS forall a. Semigroup a => a -> a -> a <> String abi Bool -> String -> IO () createDirectoryIfMissing Bool True String cache Paths -> IO Paths forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Paths { String ghc :: String ghc :: String ghc , String ghcPkg :: String ghcPkg :: String ghcPkg , String cache :: String cache :: String cache } where parseFields :: String -> [(String, FilePath)] parseFields :: String -> [(String, String)] parseFields = (String -> (String, String)) -> [String] -> [(String, String)] forall a b. (a -> b) -> [a] -> [b] map String -> (String, String) parseField ([String] -> [(String, String)]) -> (String -> [String]) -> String -> [(String, String)] forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [String] lines parseField :: String -> (String, FilePath) parseField :: String -> (String, String) parseField String input = case (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char ':') String input of (String key, Char ':' : String value) -> (String key, (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile Char -> Bool isSpace String value) (String key, String _) -> (String key, String "") die :: String -> IO a die :: forall a. String -> IO a die String message = do Handle -> String -> IO () hPutStrLn Handle stderr String "Error: [cabal-doctest]" Handle -> String -> IO () hPutStrLn Handle stderr String message IO a forall a. IO a exitFailure strip :: String -> String strip :: ShowS strip = ShowS forall a. [a] -> [a] reverse ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile Char -> Bool isSpace ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS forall a. [a] -> [a] reverse ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile Char -> Bool isSpace parseVersion :: String -> Maybe Version parseVersion :: String -> Maybe Version parseVersion = String -> [(String, Version)] -> Maybe Version forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup String "" ([(String, Version)] -> Maybe Version) -> (String -> [(String, Version)]) -> String -> Maybe Version forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Version, String) -> (String, Version)) -> [(Version, String)] -> [(String, Version)] forall a b. (a -> b) -> [a] -> [b] map (Version, String) -> (String, Version) forall a b. (a, b) -> (b, a) swap ([(Version, String)] -> [(String, Version)]) -> (String -> [(Version, String)]) -> String -> [(String, Version)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ReadP Version -> String -> [(Version, String)] forall a. ReadP a -> ReadS a readP_to_S ReadP Version Version.parseVersion