Skip to content
Snippets Groups Projects
Commit 25e445e7 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Don't use Data.Char.isSymbol as it doesn't exist in base-1.0

This is an alternative fix to creating a Distribution.Compat.Char
parent 300e6859
No related branches found
No related tags found
No related merge requests found
...@@ -86,7 +86,6 @@ Library ...@@ -86,7 +86,6 @@ Library
Other-Modules: Other-Modules:
Distribution.GetOpt, Distribution.GetOpt,
Distribution.Compat.TempFile Distribution.Compat.TempFile
Distribution.Compat.Char
Distribution.Compat.Exception Distribution.Compat.Exception
Distribution.Simple.GHC.Makefile Distribution.Simple.GHC.Makefile
......
...@@ -72,7 +72,7 @@ import Distribution.Simple.Utils (intercalate, lowercase) ...@@ -72,7 +72,7 @@ import Distribution.Simple.Utils (intercalate, lowercase)
import Language.Haskell.Extension (Extension) import Language.Haskell.Extension (Extension)
import Text.PrettyPrint.HughesPJ hiding (braces) import Text.PrettyPrint.HughesPJ hiding (braces)
import Data.Char (isSpace, isUpper, toLower, isAlphaNum, isSymbol, isDigit) import Data.Char (isSpace, isUpper, toLower, isAlphaNum, isDigit)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten) import Data.Tree as Tree (Tree(..), flatten)
import System.FilePath (normalise) import System.FilePath (normalise)
...@@ -546,7 +546,7 @@ parseBuildToolName = do ns <- sepBy1 component (ReadP.char '-') ...@@ -546,7 +546,7 @@ parseBuildToolName = do ns <- sepBy1 component (ReadP.char '-')
return (intercalate "-" ns) return (intercalate "-" ns)
where component = do where component = do
cs <- munch1 (\c -> isAlphaNum c cs <- munch1 (\c -> isAlphaNum c
|| isSymbol c || c == '+'
|| c == '_' || c == '_'
&& c /= '-') && c /= '-')
if all isDigit cs then pfail else return cs if all isDigit cs then pfail else return cs
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment