{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Options.Util where
import Data.Char (isAlphaNum, isLetter, isUpper)
import qualified Data.Set as Set
#if defined(OPTIONS_ENCODING_UTF8)
import Data.Char (chr)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import qualified Data.ByteString.Char8 as Char8
import Foreign
import Foreign.C
#endif
stringToGhc704 :: String -> String
#if defined(OPTIONS_ENCODING_UTF8)
stringToGhc704 = decodeUtf8 . Char8.pack
decodeUtf8 :: Char8.ByteString -> String
decodeUtf8 bytes = map (chr . fromIntegral) word32s where
word32s = unsafePerformIO (unsafeUseAsCStringLen bytes io)
io (bytesPtr, len) = allocaArray len $ \wordsPtr -> do
nWords <- c_decodeString (castPtr bytesPtr) wordsPtr (fromIntegral len)
peekArray (fromIntegral nWords) wordsPtr
foreign import ccall unsafe "hsoptions_decode_string"
c_decodeString :: Ptr Word8 -> Ptr Word32 -> CInt -> IO CInt
#else
stringToGhc704 :: String -> String
stringToGhc704 = String -> String
forall a. a -> a
id
#endif
validFieldName :: String -> Bool
validFieldName :: String -> Bool
validFieldName = String -> Bool
valid where
valid :: String -> Bool
valid s :: String
s = case String
s of
[] -> Bool
False
c :: Char
c : cs :: String
cs -> Char -> Bool
validFirst Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validGeneral String
cs
validFirst :: Char -> Bool
validFirst c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| (Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isUpper Char
c))
validGeneral :: Char -> Bool
validGeneral c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''
validShortFlag :: Char -> Bool
validShortFlag :: Char -> Bool
validShortFlag = Char -> Bool
isAlphaNum
validLongFlag :: String -> Bool
validLongFlag :: String -> Bool
validLongFlag = String -> Bool
valid where
valid :: String -> Bool
valid s :: String
s = case String
s of
[] -> Bool
False
c :: Char
c : cs :: String
cs -> Char -> Bool
validFirst Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validGeneral String
cs
validFirst :: Char -> Bool
validFirst = Char -> Bool
isAlphaNum
validGeneral :: Char -> Bool
validGeneral c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
hasDuplicates :: Ord a => [a] -> Bool
hasDuplicates :: [a] -> Bool
hasDuplicates xs :: [a]
xs = Set a -> Int
forall a. Set a -> Int
Set.size ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
mapEither :: (a -> Either err b) -> [a] -> Either err [b]
mapEither :: (a -> Either err b) -> [a] -> Either err [b]
mapEither fn :: a -> Either err b
fn = [b] -> [a] -> Either err [b]
loop [] where
loop :: [b] -> [a] -> Either err [b]
loop acc :: [b]
acc [] = [b] -> Either err [b]
forall a b. b -> Either a b
Right ([b] -> [b]
forall a. [a] -> [a]
reverse [b]
acc)
loop acc :: [b]
acc (a :: a
a:as :: [a]
as) = case a -> Either err b
fn a
a of
Left err :: err
err -> err -> Either err [b]
forall a b. a -> Either a b
Left err
err
Right b :: b
b -> [b] -> [a] -> Either err [b]
loop (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
acc) [a]
as