    {-# 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