-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.Internal
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Internal utilities used by Distribution.Simple.Program.*.
module Distribution.Simple.Program.Internal
  ( stripExtractVersion
  ) where

import Distribution.Compat.Prelude
import Distribution.Utils.Generic (safeTail)
import Prelude ()

-- | Extract the version number from the output of 'strip --version'.
--
-- Invoking "strip --version" gives very inconsistent results. We ignore
-- everything in parentheses (see #2497), look for the first word that starts
-- with a number, and try parsing out the first two components of it. Non-GNU
-- 'strip' doesn't appear to have a version flag.
stripExtractVersion :: String -> String
stripExtractVersion :: String -> String
stripExtractVersion String
str =
  let numeric :: String -> Bool
numeric String
"" = Bool
False
      numeric (Char
x : String
_) = Char -> Bool
isDigit Char
x

      -- Filter out everything in parentheses.
      filterPar' :: Int -> [String] -> [String]
      filterPar' :: Int -> [String] -> [String]
filterPar' Int
_ [] = []
      filterPar' Int
n (String
x : [String]
xs)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = Int -> [String] -> [String]
filterPar' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((String -> String
forall a. [a] -> [a]
safeTail String
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& String
")" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
x = Int -> [String] -> [String]
filterPar' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String]
xs
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> [String] -> [String]
filterPar' Int
n [String]
xs
        | Bool
otherwise = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [String] -> [String]
filterPar' Int
n [String]
xs

      filterPar :: [String] -> [String]
filterPar = Int -> [String] -> [String]
filterPar' Int
0
   in case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
numeric) ([String] -> [String]
filterPar ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
str) of
        (String
ver : [String]
_) ->
          -- take the first two version components
          let isDot :: Char -> Bool
isDot = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
              (String
major, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDot String
ver
              minor :: String
minor = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDot String
rest)
           in String
major String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
minor
        [String]
_ -> String
""