{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- Module: Options.Util
-- License: MIT
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 = id
#endif

validFieldName :: String -> Bool
validFieldName = valid where
        valid s = case s of
                [] -> False
                c : cs -> validFirst c && all validGeneral cs
        validFirst c = c == '_' || (isLetter c && not (isUpper c))
        validGeneral c = isAlphaNum c || c == '_' || c == '\''

validShortFlag :: Char -> Bool
validShortFlag = isAlphaNum

validLongFlag :: String -> Bool
validLongFlag = valid where
        valid s = case s of
                [] -> False
                c : cs -> validFirst c && all validGeneral cs
        validFirst = isAlphaNum
        validGeneral c = isAlphaNum c || c == '-' || c == '_'

hasDuplicates :: Ord a => [a] -> Bool
hasDuplicates xs = Set.size (Set.fromList xs) /= length xs

mapEither :: (a -> Either err b) -> [a] -> Either err [b]
mapEither fn = loop [] where
        loop acc [] = Right (reverse acc)
        loop acc (a:as) = case fn a of
                Left err -> Left err
                Right b -> loop (b:acc) as