Return Either instead of error

6 files changed, 61 insertions, 50 deletions

diff --git a/base32-bytestring.cabal b/base32-bytestring.cabal
index 1925b62..d314bbd 100644
--- a/base32-bytestring.cabal
+++ b/base32-bytestring.cabal
@@ -46,7 +46,7 @@ library
 
 test-suite spec
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings
+  default-extensions:
   type:                exitcode-stdio-1.0
   hs-source-dirs:      tests
   main-is:             Spec.hs
diff --git a/src/Data/ByteString/Base32.hs b/src/Data/ByteString/Base32.hs
index efc5951..79939d1 100644
--- a/src/Data/ByteString/Base32.hs
+++ b/src/Data/ByteString/Base32.hs
@@ -57,10 +57,10 @@ decTable = BS.pack $ L.map decW5 [minBound .. maxBound]
 
 -- | Decode a base32 encoded bytestring. This functions is
 -- case-insensitive and do not require correct padding.
-decode :: Base32 -> ByteString
+decode :: Base32 -> Either String ByteString
 decode = pack5 decTable
 
 -- | The same as 'decode' but with additional leniency: decodeLenient
 -- will skip non-alphabet characters.
-decodeLenient :: Base32 -> ByteString
+decodeLenient :: Base32 -> Either String ByteString
 decodeLenient = pack5Lenient decTable
\ No newline at end of file
diff --git a/src/Data/ByteString/Base32/Hex.hs b/src/Data/ByteString/Base32/Hex.hs
index c38c2da..d866570 100644
--- a/src/Data/ByteString/Base32/Hex.hs
+++ b/src/Data/ByteString/Base32/Hex.hs
@@ -55,10 +55,10 @@ decTable = BS.pack $ L.map decW5 [minBound .. maxBound]
 
 -- | Decode a base32hex encoded bytestring. This functions is
 -- case-insensitive and do not requires correct padding.
-decode :: Base32Hex -> ByteString
+decode :: Base32Hex -> Either String ByteString
 decode = pack5 decTable
 
 -- | The same as 'decode' but with additional leniency: decodeLenient
 -- will skip non-alphabet characters.
-decodeLenient :: Base32Hex -> ByteString
+decodeLenient :: Base32Hex -> Either String ByteString
 decodeLenient = pack5Lenient decTable
\ No newline at end of file
diff --git a/src/Data/ByteString/Base32/Internal.hs b/src/Data/ByteString/Base32/Internal.hs
index 5902f60..78b1146 100644
--- a/src/Data/ByteString/Base32/Internal.hs
+++ b/src/Data/ByteString/Base32/Internal.hs
@@ -22,6 +22,7 @@ module Data.ByteString.Base32.Internal
        , invIx
        ) where
 
+import Control.Exception hiding (mask)
 import Data.Bits.Extras
 import Data.ByteString as BS
 import Data.ByteString.Internal as BS
@@ -151,9 +152,17 @@ unpack5 (PS fptr off len) bs
 invIx :: Word5
 invIx = 255
 
-pack5Ptr :: Ptr Word5 -> ByteString -> ByteString
+type Result = Either String
+
+cleanup :: IO a -> Result a
+cleanup io = unsafePerformIO $
+    catch (io >>= evaluate >>= return . Right) handler
+  where
+    handler (ErrorCall msg) = return (Left msg)
+
+pack5Ptr :: Ptr Word5 -> ByteString -> Result ByteString
 pack5Ptr !tbl bs @ (PS fptr off sz) =
-  unsafePerformIO $ do
+  cleanup $ do
     let packedSize = dstSize $ BS.length bs
     BS.createAndTrim packedSize $ \ dst -> do
         withForeignPtr fptr $ \ ptr -> do
@@ -162,7 +171,7 @@ pack5Ptr !tbl bs @ (PS fptr off sz) =
   where
     lookupTable :: Word8 -> Word5
     lookupTable ix
-        | x == invIx = error $ "base32: decode: invalid character" ++ show ix
+        | x == invIx = error $ show (w2c ix) ++ " is not base32 character"
         | otherwise  = x
       where x = inlinePerformIO (peekByteOff tbl (fromIntegral ix))
     {-# INLINE lookupTable #-}
@@ -221,7 +230,7 @@ pack5Ptr !tbl bs @ (PS fptr off sz) =
 
 type DecTable = ByteString
 
-pack5 :: DecTable -> ByteString -> ByteString
+pack5 :: DecTable -> ByteString -> Result ByteString
 pack5 (PS fptr off len) bs
   | len /= 256
   = error $ "base32: pack5: invalid lookup table size " ++ show len
@@ -238,7 +247,7 @@ isInAlphabet :: Ptr Word5 -> Word8 -> Bool
 isInAlphabet !tbl !ix =
   inlinePerformIO (peekByteOff tbl (fromIntegral ix)) /= invIx
 
-pack5Lenient :: DecTable -> ByteString -> ByteString
+pack5Lenient :: DecTable -> ByteString -> Either String ByteString
 pack5Lenient tbl @ (PS fptr _ _) bs =
   unsafePerformIO $ do
     withForeignPtr fptr $ \ !tbl_ptr -> do
diff --git a/tests/Data/ByteString/Base32/HexSpec.hs b/tests/Data/ByteString/Base32/HexSpec.hs
index 2cdadef..7cddb69 100644
--- a/tests/Data/ByteString/Base32/HexSpec.hs
+++ b/tests/Data/ByteString/Base32/HexSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS -fno-warn-orphans #-}
 module Data.ByteString.Base32.HexSpec ( spec ) where
 
@@ -28,19 +29,19 @@ spec = do
 
   describe "decode" $ do
     it "conform rfc examples" $ do
-      decode ""         `shouldBe` ""
-      decode "CO======" `shouldBe` "f"
-      decode "CPNG====" `shouldBe` "fo"
-      decode "CPNMU===" `shouldBe` "foo"
-      decode "CPNMUOG=" `shouldBe` "foob"
-      decode "CPNMUOJ1" `shouldBe` "fooba"
-      decode "CPNMUOJ1E8======" `shouldBe` "foobar"
+      decode ""         `shouldBe` Right ""
+      decode "CO======" `shouldBe` Right "f"
+      decode "CPNG====" `shouldBe` Right "fo"
+      decode "CPNMU===" `shouldBe` Right "foo"
+      decode "CPNMUOG=" `shouldBe` Right "foob"
+      decode "CPNMUOJ1" `shouldBe` Right "fooba"
+      decode "CPNMUOJ1E8======" `shouldBe` Right "foobar"
 
     it "inverse for encode" $ property $ \bs ->
-      decode (encode bs) == bs
+      decode (encode bs) == Right bs
 
     it "case insensitive" $ property $ \bs ->
-      decode (BC.map toLower (encode bs)) == bs
+      decode (BC.map toLower (encode bs)) == Right bs
 
     it "fail gracefully if encoded data contains non alphabet chars" $ do
       evaluate (decode "#=======")         `shouldThrow` anyErrorCall
@@ -48,20 +49,20 @@ spec = do
 
   describe "decodeLenient" $ do
     it "conform RFC examples" $ do
-      decode ""         `shouldBe` ""
-      decode "CO======" `shouldBe` "f"
-      decode "CPNG====" `shouldBe` "fo"
-      decode "CPNMU===" `shouldBe` "foo"
-      decode "CPNMUOG=" `shouldBe` "foob"
-      decode "CPNMUOJ1" `shouldBe` "fooba"
-      decode "CPNMUOJ1E8======" `shouldBe` "foobar"
+      decode ""         `shouldBe` Right ""
+      decode "CO======" `shouldBe` Right "f"
+      decode "CPNG====" `shouldBe` Right "fo"
+      decode "CPNMU===" `shouldBe` Right "foo"
+      decode "CPNMUOG=" `shouldBe` Right "foob"
+      decode "CPNMUOJ1" `shouldBe` Right "fooba"
+      decode "CPNMUOJ1E8======" `shouldBe` Right "foobar"
 
     it "inverse for encode" $ property $ \bs ->
-      decodeLenient (encode bs) == bs
+      decodeLenient (encode bs) == Right bs
 
     it "case insensitive" $ property $ \bs ->
-      decodeLenient (BC.map toLower (encode bs)) == bs
+      decodeLenient (BC.map toLower (encode bs)) == Right bs
 
     it "skip non alphabet chars" $ do
-      decodeLenient "|"   `shouldBe` ""
-      decodeLenient "C|O" `shouldBe` "f"
+      decodeLenient "|"   `shouldBe` Right ""
+      decodeLenient "C|O" `shouldBe` Right "f"
diff --git a/tests/Data/ByteString/Base32Spec.hs b/tests/Data/ByteString/Base32Spec.hs
index 148539a..4cec8f9 100644
--- a/tests/Data/ByteString/Base32Spec.hs
+++ b/tests/Data/ByteString/Base32Spec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS -fno-warn-orphans #-}
 module Data.ByteString.Base32Spec (spec) where
 
@@ -34,19 +35,19 @@ spec = do
 
   describe "decode" $ do
     it "conform RFC examples" $ do
-      decode ""                 `shouldBe` ""
-      decode "MY======"         `shouldBe` "f"
-      decode "MZXQ===="         `shouldBe` "fo"
-      decode  "MZXW6==="        `shouldBe` "foo"
-      decode "MZXW6YQ="         `shouldBe` "foob"
-      decode "MZXW6YTB"         `shouldBe` "fooba"
-      decode "MZXW6YTBOI======" `shouldBe` "foobar"
+      decode ""                 `shouldBe` Right ""
+      decode "MY======"         `shouldBe` Right "f"
+      decode "MZXQ===="         `shouldBe` Right "fo"
+      decode  "MZXW6==="        `shouldBe` Right "foo"
+      decode "MZXW6YQ="         `shouldBe` Right "foob"
+      decode "MZXW6YTB"         `shouldBe` Right "fooba"
+      decode "MZXW6YTBOI======" `shouldBe` Right "foobar"
 
     it "inverse for encode" $ property $ \bs ->
-      decode (encode bs) == bs
+      decode (encode bs) == Right bs
 
     it "case insensitive" $ property $ \bs ->
-      decode (BC.map toLower (encode bs)) == bs
+      decode (BC.map toLower (encode bs)) == Right bs
 
     it "fail gracefully if encoded data contains non alphabet chars" $ do
       evaluate (decode "0=======")         `shouldThrow` anyErrorCall
@@ -54,20 +55,20 @@ spec = do
 
   describe "decodeLenient" $ do
     it "conform RFC examples" $ do
-      decodeLenient ""                 `shouldBe` ""
-      decodeLenient "MY======"         `shouldBe` "f"
-      decodeLenient "MZXQ===="         `shouldBe` "fo"
-      decodeLenient  "MZXW6==="        `shouldBe` "foo"
-      decodeLenient "MZXW6YQ="         `shouldBe` "foob"
-      decodeLenient "MZXW6YTB"         `shouldBe` "fooba"
-      decodeLenient "MZXW6YTBOI======" `shouldBe` "foobar"
+      decodeLenient ""                 `shouldBe` Right ""
+      decodeLenient "MY======"         `shouldBe` Right "f"
+      decodeLenient "MZXQ===="         `shouldBe` Right "fo"
+      decodeLenient  "MZXW6==="        `shouldBe` Right "foo"
+      decodeLenient "MZXW6YQ="         `shouldBe` Right "foob"
+      decodeLenient "MZXW6YTB"         `shouldBe` Right "fooba"
+      decodeLenient "MZXW6YTBOI======" `shouldBe` Right "foobar"
 
     it "inverse for encode" $ property $ \bs ->
-      decodeLenient (encode bs) == bs
+      decodeLenient (encode bs) == Right bs
 
     it "case insensitive" $ property $ \bs ->
-      decodeLenient (BC.map toLower (encode bs)) == bs
+      decodeLenient (BC.map toLower (encode bs)) == Right bs
 
     it "skip non alphabet chars" $ do
-      decodeLenient "|"   `shouldBe` ""
-      decodeLenient "M|Y" `shouldBe` "f"
+      decodeLenient "|"   `shouldBe` Right ""
+      decodeLenient "M|Y" `shouldBe` Right "f"