{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns #-}
module Distribution.Utils.Generic (
withFileContents,
writeFileAtomic,
fromUTF8BS,
fromUTF8LBS,
toUTF8BS,
toUTF8LBS,
validateUTF8,
readUTF8File,
withUTF8FileContents,
writeUTF8File,
ignoreBOM,
normaliseLineEndings,
dropWhileEndLE,
takeWhileEndLE,
equating,
comparing,
isInfixOf,
intercalate,
lowercase,
isAscii,
isAsciiAlpha,
isAsciiAlphaNum,
listUnion,
listUnionRight,
ordNub,
ordNubBy,
ordNubRight,
safeTail,
unintersperse,
wrapText,
wrapLine,
unfoldrM,
spanMaybe,
breakMaybe,
isAbsoluteOnAnyPlatform,
isRelativeOnAnyPlatform,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.String
import Data.Bits ((.&.), (.|.), shiftL)
import Data.List
( isInfixOf )
import Data.Ord
( comparing )
import qualified Data.ByteString.Lazy as BS
import qualified Data.Set as Set
import qualified Data.ByteString as SBS
import System.Directory
( removeFile, renameFile )
import System.FilePath
( (<.>), splitFileName )
import System.IO
( withFile, withBinaryFile
, openBinaryTempFileWithDefaultPermissions
, IOMode(ReadMode), hGetContents, hClose )
import qualified Control.Exception as Exception
wrapText :: String -> String
wrapText :: String -> String
wrapText = [String] -> String
unlines
([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n"
([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords
([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [[String]]
wrapLine 79
([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
wrapLine :: Int -> [String] -> [[String]]
wrapLine :: Int -> [String] -> [[String]]
wrapLine width :: Int
width = Int -> [String] -> [String] -> [[String]]
wrap 0 []
where wrap :: Int -> [String] -> [String] -> [[String]]
wrap :: Int -> [String] -> [String] -> [[String]]
wrap 0 [] (w :: String
w:ws :: [String]
ws)
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
= Int -> [String] -> [String] -> [[String]]
wrap (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w) [String
w] [String]
ws
wrap col :: Int
col line :: [String]
line (w :: String
w:ws :: [String]
ws)
| Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
= [String] -> [String]
forall a. [a] -> [a]
reverse [String]
line [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: Int -> [String] -> [String] -> [[String]]
wrap 0 [] (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ws)
wrap col :: Int
col line :: [String]
line (w :: String
w:ws :: [String]
ws)
= let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
in Int -> [String] -> [String] -> [[String]]
wrap Int
col' (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
line) [String]
ws
wrap _ [] [] = []
wrap _ line :: [String]
line [] = [[String] -> [String]
forall a. [a] -> [a]
reverse [String]
line]
withFileContents :: FilePath -> (String -> NoCallStackIO a) -> NoCallStackIO a
withFileContents :: String -> (String -> NoCallStackIO a) -> NoCallStackIO a
withFileContents name :: String
name action :: String -> NoCallStackIO a
action =
String -> IOMode -> (Handle -> NoCallStackIO a) -> NoCallStackIO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
ReadMode
(\hnd :: Handle
hnd -> Handle -> IO String
hGetContents Handle
hnd IO String -> (String -> NoCallStackIO a) -> NoCallStackIO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> NoCallStackIO a
action)
writeFileAtomic :: FilePath -> BS.ByteString -> NoCallStackIO ()
writeFileAtomic :: String -> ByteString -> NoCallStackIO ()
writeFileAtomic targetPath :: String
targetPath content :: ByteString
content = do
let (targetDir :: String
targetDir, targetFile :: String
targetFile) = String -> (String, String)
splitFileName String
targetPath
IO (String, Handle)
-> ((String, Handle) -> NoCallStackIO ())
-> ((String, Handle) -> NoCallStackIO ())
-> NoCallStackIO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError
(String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions String
targetDir (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
targetFile String -> String -> String
<.> "tmp")
(\(tmpPath :: String
tmpPath, handle :: Handle
handle) -> Handle -> NoCallStackIO ()
hClose Handle
handle NoCallStackIO () -> NoCallStackIO () -> NoCallStackIO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> NoCallStackIO ()
removeFile String
tmpPath)
(\(tmpPath :: String
tmpPath, handle :: Handle
handle) -> do
Handle -> ByteString -> NoCallStackIO ()
BS.hPut Handle
handle ByteString
content
Handle -> NoCallStackIO ()
hClose Handle
handle
String -> String -> NoCallStackIO ()
renameFile String
tmpPath String
targetPath)
fromUTF8BS :: SBS.ByteString -> String
fromUTF8BS :: ByteString -> String
fromUTF8BS = [Word8] -> String
decodeStringUtf8 ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
SBS.unpack
fromUTF8LBS :: BS.ByteString -> String
fromUTF8LBS :: ByteString -> String
fromUTF8LBS = [Word8] -> String
decodeStringUtf8 ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
toUTF8BS :: String -> SBS.ByteString
toUTF8BS :: String -> ByteString
toUTF8BS = [Word8] -> ByteString
SBS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
encodeStringUtf8
toUTF8LBS :: String -> BS.ByteString
toUTF8LBS :: String -> ByteString
toUTF8LBS = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
encodeStringUtf8
validateUTF8 :: SBS.ByteString -> Maybe Int
validateUTF8 :: ByteString -> Maybe Int
validateUTF8 = Int -> ByteString -> Maybe Int
go 0 where
go :: Int -> ByteString -> Maybe Int
go off :: Int
off bs :: ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
SBS.uncons ByteString
bs of
Nothing -> Maybe Int
forall a. Maybe a
Nothing
Just (c :: Word8
c, bs' :: ByteString
bs')
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x7F -> Int -> ByteString -> Maybe Int
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ByteString
bs'
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xBF -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDF -> Int -> Word8 -> ByteString -> Maybe Int
twoBytes Int
off Word8
c ByteString
bs'
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xEF -> Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes Int
off 3 0x800 ByteString
bs' (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF)
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xF7 -> Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes Int
off 4 0x10000 ByteString
bs' (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x7)
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFB -> Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes Int
off 5 0x200000 ByteString
bs' (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3)
| Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFD -> Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes Int
off 6 0x4000000 ByteString
bs' (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1)
| Bool
otherwise -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
twoBytes :: Int -> Word8 -> ByteString -> Maybe Int
twoBytes off :: Int
off c0 :: Word8
c0 bs :: ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
SBS.uncons ByteString
bs of
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
Just (c1 :: Word8
c1, bs' :: ByteString
bs')
| Word8
c1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xC0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x80 ->
if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (0x80 :: Int)
then Int -> ByteString -> Maybe Int
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) ByteString
bs'
else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
| Bool
otherwise -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
where
d :: Int
d = (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1F) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3F)
moreBytes :: Int -> Int -> Int -> SBS.ByteString -> Int -> Maybe Int
moreBytes :: Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes off :: Int
off 1 overlong :: Int
overlong cs' :: ByteString
cs' acc :: Int
acc
| Int
overlong Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
acc, Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10FFFF, Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0xD800 Bool -> Bool -> Bool
|| 0xDFFF Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
acc
= Int -> ByteString -> Maybe Int
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ByteString
cs'
| Bool
otherwise
= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
moreBytes off :: Int
off byteCount :: Int
byteCount overlong :: Int
overlong bs :: ByteString
bs acc :: Int
acc = case ByteString -> Maybe (Word8, ByteString)
SBS.uncons ByteString
bs of
Just (cn :: Word8
cn, bs' :: ByteString
bs') | Word8
cn Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xC0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x80 ->
Int -> Int -> Int -> ByteString -> Int -> Maybe Int
moreBytes (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) (Int
byteCountInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Int
overlong ByteString
bs' ((Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cn Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x3F)
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off
ignoreBOM :: String -> String
ignoreBOM :: String -> String
ignoreBOM ('\xFEFF':string :: String
string) = String
string
ignoreBOM string :: String
string = String
string
readUTF8File :: FilePath -> NoCallStackIO String
readUTF8File :: String -> IO String
readUTF8File f :: String
f = (String -> String
ignoreBOM (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8LBS) (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
f
withUTF8FileContents :: FilePath -> (String -> IO a) -> IO a
withUTF8FileContents :: String -> (String -> IO a) -> IO a
withUTF8FileContents name :: String
name action :: String -> IO a
action =
String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
name IOMode
ReadMode
(\hnd :: Handle
hnd -> Handle -> IO ByteString
BS.hGetContents Handle
hnd IO ByteString -> (ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO a
String -> IO a
action (String -> IO a) -> (ByteString -> String) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
ignoreBOM (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8LBS)
writeUTF8File :: FilePath -> String -> NoCallStackIO ()
writeUTF8File :: String -> String -> NoCallStackIO ()
writeUTF8File path :: String
path = String -> ByteString -> NoCallStackIO ()
writeFileAtomic String
path (ByteString -> NoCallStackIO ())
-> (String -> ByteString) -> String -> NoCallStackIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
encodeStringUtf8
normaliseLineEndings :: String -> String
normaliseLineEndings :: String -> String
normaliseLineEndings [] = []
normaliseLineEndings ('\r':'\n':s :: String
s) = '\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
normaliseLineEndings String
s
normaliseLineEndings ('\r':s :: String
s) = '\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
normaliseLineEndings String
s
normaliseLineEndings ( c :: Char
c :s :: String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
normaliseLineEndings String
s
dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
dropWhileEndLE p :: a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: a
x r :: [a]
r -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
r Bool -> Bool -> Bool
&& a -> Bool
p a
x then [] else a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r) []
takeWhileEndLE :: (a -> Bool) -> [a] -> [a]
takeWhileEndLE :: (a -> Bool) -> [a] -> [a]
takeWhileEndLE p :: a -> Bool
p = ([a], Bool) -> [a]
forall a b. (a, b) -> a
fst (([a], Bool) -> [a]) -> ([a] -> ([a], Bool)) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], Bool) -> ([a], Bool))
-> ([a], Bool) -> [a] -> ([a], Bool)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], Bool) -> ([a], Bool)
go ([], Bool
False)
where
go :: a -> ([a], Bool) -> ([a], Bool)
go x :: a
x (rest :: [a]
rest, done :: Bool
done)
| Bool -> Bool
not Bool
done Bool -> Bool -> Bool
&& a -> Bool
p a
x = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest, Bool
False)
| Bool
otherwise = ([a]
rest, Bool
True)
ordNub :: Ord a => [a] -> [a]
ordNub :: [a] -> [a]
ordNub = (a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubBy a -> a
forall a. a -> a
id
ordNubBy :: Ord b => (a -> b) -> [a] -> [a]
ordNubBy :: (a -> b) -> [a] -> [a]
ordNubBy f :: a -> b
f l :: [a]
l = Set b -> [a] -> [a]
go Set b
forall a. Set a
Set.empty [a]
l
where
go :: Set b -> [a] -> [a]
go !Set b
_ [] = []
go !Set b
s (x :: a
x:xs :: [a]
xs)
| b
y b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set b
s = Set b -> [a] -> [a]
go Set b
s [a]
xs
| Bool
otherwise = let !s' :: Set b
s' = b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
y Set b
s
in a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set b -> [a] -> [a]
go Set b
s' [a]
xs
where
y :: b
y = a -> b
f a
x
listUnion :: (Ord a) => [a] -> [a] -> [a]
listUnion :: [a] -> [a] -> [a]
listUnion a :: [a]
a b :: [a]
b = [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. Ord a => [a] -> [a]
ordNub ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
aSet) [a]
b)
where
aSet :: Set a
aSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
a
ordNubRight :: (Ord a) => [a] -> [a]
ordNubRight :: [a] -> [a]
ordNubRight = ([a], Set a) -> [a]
forall a b. (a, b) -> a
fst (([a], Set a) -> [a]) -> ([a] -> ([a], Set a)) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], Set a) -> ([a], Set a))
-> ([a], Set a) -> [a] -> ([a], Set a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], Set a) -> ([a], Set a)
forall a. Ord a => a -> ([a], Set a) -> ([a], Set a)
go ([], Set a
forall a. Set a
Set.empty)
where
go :: a -> ([a], Set a) -> ([a], Set a)
go x :: a
x p :: ([a], Set a)
p@(l :: [a]
l, s :: Set a
s) = if a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s then ([a], Set a)
p
else (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s)
listUnionRight :: (Ord a) => [a] -> [a] -> [a]
listUnionRight :: [a] -> [a] -> [a]
listUnionRight a :: [a]
a b :: [a]
b = [a] -> [a]
forall a. Ord a => [a] -> [a]
ordNubRight ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
bSet) [a]
a) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b
where
bSet :: Set a
bSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
b
safeTail :: [a] -> [a]
safeTail :: [a] -> [a]
safeTail [] = []
safeTail (_:xs :: [a]
xs) = [a]
xs
equating :: Eq a => (b -> a) -> b -> b -> Bool
equating :: (b -> a) -> b -> b -> Bool
equating p :: b -> a
p x :: b
x y :: b
y = b -> a
p b
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== b -> a
p b
y
lowercase :: String -> String
lowercase :: String -> String
lowercase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
isAscii :: Char -> Bool
isAscii :: Char -> Bool
isAscii c :: Char
c = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80
isAsciiAlpha :: Char -> Bool
isAsciiAlpha :: Char -> Bool
isAsciiAlpha c :: Char
c = ('a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z')
Bool -> Bool -> Bool
|| ('A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z')
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum c :: Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c
unintersperse :: Char -> String -> [String]
unintersperse :: Char -> String -> [String]
unintersperse mark :: Char
mark = (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (String, String)
unintersperse1 where
unintersperse1 :: String -> Maybe (String, String)
unintersperse1 str :: String
str
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str = Maybe (String, String)
forall a. Maybe a
Nothing
| Bool
otherwise =
let (this :: String
this, rest :: String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
mark) String
str in
(String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
this, String -> String
forall a. [a] -> [a]
safeTail String
rest)
breakMaybe :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakMaybe :: (a -> Maybe b) -> [a] -> ([a], Maybe (b, [a]))
breakMaybe f :: a -> Maybe b
f = ([a] -> [a]) -> [a] -> ([a], Maybe (b, [a]))
forall c. ([a] -> c) -> [a] -> (c, Maybe (b, [a]))
go [a] -> [a]
forall a. a -> a
id where
go :: ([a] -> c) -> [a] -> (c, Maybe (b, [a]))
go ![a] -> c
acc [] = ([a] -> c
acc [], Maybe (b, [a])
forall a. Maybe a
Nothing)
go ![a] -> c
acc (x :: a
x:xs :: [a]
xs) = case a -> Maybe b
f a
x of
Nothing -> ([a] -> c) -> [a] -> (c, Maybe (b, [a]))
go ([a] -> c
acc ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs
Just b :: b
b -> ([a] -> c
acc [], (b, [a]) -> Maybe (b, [a])
forall a. a -> Maybe a
Just (b
b, [a]
xs))
spanMaybe :: (a -> Maybe b) -> [a] -> ([b],[a])
spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe _ xs :: [a]
xs@[] = ([], [a]
xs)
spanMaybe p :: a -> Maybe b
p xs :: [a]
xs@(x :: a
x:xs' :: [a]
xs') = case a -> Maybe b
p a
x of
Just y :: b
y -> let (ys :: [b]
ys, zs :: [a]
zs) = (a -> Maybe b) -> [a] -> ([b], [a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe a -> Maybe b
p [a]
xs' in (b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys, [a]
zs)
Nothing -> ([], [a]
xs)
unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM :: (b -> m (Maybe (a, b))) -> b -> m [a]
unfoldrM f :: b -> m (Maybe (a, b))
f = b -> m [a]
go where
go :: b -> m [a]
go b :: b
b = do
Maybe (a, b)
m <- b -> m (Maybe (a, b))
f b
b
case Maybe (a, b)
m of
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (a :: a
a, b' :: b
b') -> ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (b -> m [a]
go b
b')
isAbsoluteOnAnyPlatform :: FilePath -> Bool
isAbsoluteOnAnyPlatform :: String -> Bool
isAbsoluteOnAnyPlatform (drive :: Char
drive:':':'\\':_) = Char -> Bool
isAlpha Char
drive
isAbsoluteOnAnyPlatform ('\\':'\\':_) = Bool
True
isAbsoluteOnAnyPlatform ('/':_) = Bool
True
isAbsoluteOnAnyPlatform _ = Bool
False
isRelativeOnAnyPlatform :: FilePath -> Bool
isRelativeOnAnyPlatform :: String -> Bool
isRelativeOnAnyPlatform = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isAbsoluteOnAnyPlatform