diff --git a/README.md b/README.md index 8c839d2..726e91c 100644 --- a/README.md +++ b/README.md @@ -27,3 +27,8 @@ Benchmark results: But if you really really really need backtracking, then you can just inject attoparsec parser into a scanner: http://hackage.haskell.org/package/scanner-attoparsec + +# MicroHs + +The library should compile and work with MicroHs. +To run the test suite: `mhs -icompat -iportable_hspec -ilib -r spec/spec.hs` diff --git a/compat/Data/ByteString/Lazy_.hs b/compat/Data/ByteString/Lazy_.hs new file mode 100644 index 0000000..8654fa9 --- /dev/null +++ b/compat/Data/ByteString/Lazy_.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE CPP #-} + +module Data.ByteString.Lazy_ +( ByteString +, toChunks +, fromChunks +) where + +#ifdef __MHS__ +import qualified Data.ByteString as Strict + +newtype ByteString = ByteString [Strict.ByteString] + +toChunks :: ByteString -> [Strict.ByteString] +toChunks (ByteString chunks) = chunks + +fromChunks :: [Strict.ByteString] -> ByteString +fromChunks = ByteString +#else +import "bytestring" Data.ByteString.Lazy +#endif diff --git a/compat/GHC/Base.hs b/compat/GHC/Base.hs new file mode 100644 index 0000000..102f089 --- /dev/null +++ b/compat/GHC/Base.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE CPP #-} + +module GHC.Base +( unsafeChr +) where + +#ifdef __MHS__ +import Data.Char +unsafeChr :: Int -> Char +unsafeChr = chr +#else +import "base" GHC.Base +#endif diff --git a/lib/Scanner.hs b/lib/Scanner.hs index 7cfd18f..f1e0012 100644 --- a/lib/Scanner.hs +++ b/lib/Scanner.hs @@ -42,8 +42,8 @@ import Data.Word import qualified Data.Char as Char import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy as Lazy.ByteString +import qualified Data.ByteString.Lazy_ as Lazy (ByteString) +import qualified Data.ByteString.Lazy_ as Lazy.ByteString import Control.Monad import GHC.Base (unsafeChr) diff --git a/lib/Scanner/Internal.hs b/lib/Scanner/Internal.hs index b2fb829..dd41490 100644 --- a/lib/Scanner/Internal.hs +++ b/lib/Scanner/Internal.hs @@ -66,11 +66,13 @@ instance Monad Scanner where run s1 bs $ \bs' a -> run (s2 a) bs' next +#ifndef __MHS__ #if !(MIN_VERSION_base(4,13,0)) {-# INLINE fail #-} fail err = Scanner $ \bs _ -> Fail bs err #endif +#endif instance MonadFail Scanner where {-# INLINE fail #-} @@ -87,6 +89,7 @@ anyWord8 = Scanner $ \bs next -> Just (c, bs') -> next bs' c _ -> More $ \bs' -> slowPath bs' next where + slowPath :: ByteString -> Next Word8 r -> Result r slowPath bs next = case ByteString.uncons bs of Just (c, bs') -> next bs' c @@ -174,6 +177,7 @@ lookAhead = Scanner $ \bs next -> Just (c, _) -> next bs (Just c) _ -> More $ \bs' -> slowPath bs' next where + slowPath :: ByteString -> Next (Maybe Word8) r -> Result r slowPath bs next = case ByteString.uncons bs of Just (c, _) -> next bs (Just c) diff --git a/portable_hspec/Test/Hspec.hs b/portable_hspec/Test/Hspec.hs new file mode 100644 index 0000000..e92119b --- /dev/null +++ b/portable_hspec/Test/Hspec.hs @@ -0,0 +1,55 @@ +-- | Portable drop-in replacement of hspec that works both with GHC and MicroHs +module Test.Hspec +( Spec +, hspec +, describe +, it +, shouldBe +, shouldThrow +, shouldSatisfy +, context +) where + +import Data.IORef +import Control.Monad +import Control.Exception +import Control.Monad.IO.Class + +type Spec = IO () + +hspec :: Monad m => m a -> m a +hspec m = m + +context :: MonadIO m => String -> m a -> m a +context name m = do + liftIO $ putStrLn "............." + liftIO $ putStrLn name + m + +describe :: MonadIO m => String -> m a -> m a +describe name m = do + liftIO $ putStrLn "-------------" + liftIO $ putStrLn name + m + +it :: MonadIO m => String -> m a -> m a +it name m = do + liftIO $ putStrLn name + m + +shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m () +shouldBe a b = unless (a == b) $ do + liftIO $ putStrLn $ "FAILED: expected " ++ show b ++ ", but got " ++ show a + +shouldSatisfy :: (MonadIO m, Show a) => a -> (a -> Bool) -> m () +shouldSatisfy a f = unless (f a) $ do + liftIO $ putStrLn $ "FAILED: result does't satisfy the condition: " ++ show a + +shouldThrow :: Exception e => IO a -> (e -> Bool) -> IO () +shouldThrow m f = do + me <- try m + case me of + Right _ -> putStrLn "FAILED: expected to throw" + Left e -> do + unless (f e) $ do + putStrLn $ "FAILED: exception doesn't satisfy the condition " ++ show e diff --git a/scanner.cabal b/scanner.cabal index 6f17d15..1133cba 100644 --- a/scanner.cabal +++ b/scanner.cabal @@ -23,6 +23,8 @@ library Scanner.Internal other-modules: Prelude Data.Either + Data.ByteString.Lazy_ + GHC.Base Scanner.OctetPredicates build-depends: base <5 , fail @@ -41,6 +43,7 @@ test-suite spec , scanner other-modules: Prelude Data.Either + Data.ByteString.Lazy_ default-language: Haskell2010 benchmark bench diff --git a/spec/spec.hs b/spec/spec.hs index 1786429..fb2f628 100644 --- a/spec/spec.hs +++ b/spec/spec.hs @@ -10,7 +10,7 @@ import Scanner import Prelude hiding (take, takeWhile) import Data.Either import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Lazy as Lazy.ByteString +import qualified Data.ByteString.Lazy_ as Lazy.ByteString import Test.Hspec main :: IO ()