module Bio.GFF3.Escape ( unEscapeByteString
                       , escapeByteString, escapeAllBut, escapeAllOf
                       )
    where

import Control.Monad.Error
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy as LBSW
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Char
import Data.Word

-- (Un)Escaping

unEscapeByteString :: (Error e, MonadError e m) => LBS.ByteString -> m LBS.ByteString
unEscapeByteString bstr = case LBS.split '%' bstr of
                            [] -> return LBS.empty
                            [_] -> return bstr
                            (bstr0:brest) -> foldM unEscapeOneSplit bstr0 brest
    where unEscapeOneSplit leftBStr nextBStr
              = do (x1, next1) <- maybe shortEscape return $ LBS.uncons nextBStr
                   (x2, rest) <- maybe shortEscape return $ LBS.uncons next1
                   xch <- unescapeChar x1 x2
                   return $ leftBStr `LBS.append` LBS.singleton xch `LBS.append` rest
          unescapeChar x1 x2
              | isHexDigit x1 && isHexDigit x2 = return $ chr (digitToInt x1 * 16 + digitToInt x2)
              | otherwise = throwError $ strMsg $ "Bad %-escape, " ++ show ['%',x1,x2]
          shortEscape = throwError $ strMsg $ "Bad %-escape, too short"

escapeByteString :: (Char -> Bool) -> LBS.ByteString -> LBS.ByteString
escapeByteString isNotEscaped bstr 
    = case LBS.span isNotEscaped bstr of
        (leftStr, rightStr) -> case LBSW.uncons rightStr of
                                 Nothing -> leftStr
                                 Just (escch, rest) -> leftStr `LBS.append` escapeWord8 escch `LBS.append` escapeByteString isNotEscaped rest

escapeWord8 :: Word8 -> LBS.ByteString
escapeWord8 wch = case (fromIntegral wch) `quotRem` 16 of
                    (lch, rch) -> LBS.pack ['%',intToDigit lch, intToDigit rch]
                                 
escapeTable :: Bool -> [Char] -> UArray Char Bool
escapeTable def exc = runSTUArray $ do starr <- newArray (minBound, maxBound) def
                                       mapM_ (\ch -> writeArray starr ch $ not def) exc
                                       return starr

escapeAllBut :: String -> LBS.ByteString -> LBS.ByteString
escapeAllBut notEscaped = escapeByteString isNotEscaped
    where isNotEscaped ch = table ! ch
          table = escapeTable False notEscaped

escapeAllOf :: String -> LBS.ByteString -> LBS.ByteString
escapeAllOf allEscaped = escapeByteString isNotEscaped
    where isNotEscaped ch = table ! ch
          table = escapeTable True allEscaped