asn1-parse 0.8.1 → 0.9.5

raw patch · 2 files changed

Files

Data/ASN1/Parse.hs +56/−18
asn1-parse.cabal +6/−9

Data/ASN1/Parse.hs view

@@ -7,11 +7,13 @@ -- -- A parser combinator for ASN1 Stream. {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-} module Data.ASN1.Parse     ( ParseASN1     -- * run     , runParseASN1State     , runParseASN1+    , throwParseError     -- * combinators     , onNextContainer     , onNextContainerMaybe@@ -26,20 +28,56 @@  import Data.ASN1.Types import Data.ASN1.Stream-import Control.Monad.State-import Control.Monad.Error-import Control.Applicative (Applicative, (<$>))+import Control.Applicative+import Control.Arrow (first)+import Control.Monad (liftM2)+#if MIN_VERSION_base(4,9,0)+import Control.Monad.Fail+#endif --- | Parse ASN1 Monad-newtype ParseASN1 a = P { runP :: ErrorT String (State [ASN1]) a }-    deriving (Functor, Applicative, Monad, MonadError String, MonadState [ASN1])+newtype ParseASN1 a = P { runP :: [ASN1] -> Either String (a, [ASN1]) } +instance Functor ParseASN1 where+    fmap f m = P (either Left (Right . first f) . runP m)+instance Applicative ParseASN1 where+    pure a = P $ \s -> Right (a, s)+    (<*>) mf ma = P $ \s ->+        case runP mf s of+            Left err      -> Left err+            Right (f, s2) ->+                case runP ma s2 of+                    Left err      -> Left err+                    Right (a, s3) -> Right (f a, s3)+instance Monad ParseASN1 where+    return a    = pure a+    (>>=) m1 m2 = P $ \s ->+        case runP m1 s of+            Left err      -> Left err+            Right (a, s2) -> runP (m2 a) s2+instance Alternative ParseASN1 where+    empty = P $ \_ -> Left "empty Alternative"+    (<|>) m1 m2 = P $ \s ->+        case runP m1 s of+            Left _        -> runP m2 s+            Right (a, s2) -> Right (a, s2)+#if MIN_VERSION_base(4,9,0)+instance MonadFail ParseASN1 where+    fail = throwParseError+#endif++get :: ParseASN1 [ASN1]+get = P $ \stream -> Right (stream, stream)++put :: [ASN1] -> ParseASN1 ()+put stream = P $ \_ -> Right ((), stream)++-- | throw a parse error+throwParseError :: String -> ParseASN1 a+throwParseError s = P $ \_ -> Left s+ -- | run the parse monad over a stream and returns the result and the remaining ASN1 Stream. runParseASN1State :: ParseASN1 a -> [ASN1] -> Either String (a,[ASN1])-runParseASN1State f s =-    case runState (runErrorT (runP f)) s of-        (Left err, _) -> Left err-        (Right r, l)  -> Right (r,l)+runParseASN1State f s = runP f s  -- | run the parse monad over a stream and returns the result. --@@ -47,17 +85,17 @@ -- an error will be raised. runParseASN1 :: ParseASN1 a -> [ASN1] -> Either String a runParseASN1 f s =-    case runParseASN1State f s of+    case runP f s of         Left err      -> Left err         Right (o, []) -> Right o-        Right (_, er) -> throwError ("runParseASN1: remaining state " ++ show er)+        Right (_, er) -> Left ("runParseASN1: remaining state " ++ show er)  -- | get next object getObject :: ASN1Object a => ParseASN1 a getObject = do     l <- get     case fromASN1 l of-        Left err     -> throwError err+        Left err     -> throwParseError err         Right (a,l2) -> put l2 >> return a  -- | get next element from the stream@@ -65,7 +103,7 @@ getNext = do     list <- get     case list of-        []    -> throwError "empty"+        []    -> throwParseError "empty"         (h:l) -> put l >> return h  -- | get many elements until there's nothing left@@ -93,15 +131,15 @@ getNextContainer ty = do     list <- get     case list of-        []                    -> throwError "empty"+        []                    -> throwParseError "empty"         (h:l) | h == Start ty -> do let (l1, l2) = getConstructedEnd 0 l                                     put l2 >> return l1-              | otherwise     -> throwError "not an expected container"+              | otherwise     -> throwParseError "not an expected container"   -- | run a function of the next elements of a container of specified type onNextContainer :: ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a-onNextContainer ty f = getNextContainer ty >>= either throwError return . runParseASN1 f+onNextContainer ty f = getNextContainer ty >>= either throwParseError return . runParseASN1 f  -- | just like getNextContainer, except it doesn't throw an error if the container doesn't exists. getNextContainerMaybe :: ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])@@ -118,7 +156,7 @@ onNextContainerMaybe ty f = do     n <- getNextContainerMaybe ty     case n of-        Just l  -> either throwError (return . Just) $ runParseASN1 f l+        Just l  -> either throwParseError (return . Just) $ runParseASN1 f l         Nothing -> return Nothing  -- | returns if there's more elements in the stream.

asn1-parse.cabal view

@@ -1,5 +1,5 @@ Name:                asn1-parse-Version:             0.8.1+Version:             0.9.5 Description:         Simple monadic parser for ASN1 stream types, when ASN1 pattern matching is not convenient. License:             BSD3 License-file:        LICENSE@@ -11,20 +11,17 @@ Category:            Data stability:           experimental Cabal-Version:       >=1.6-Homepage:            http://github.com/vincenthz/hs-asn1+Homepage:            https://github.com/vincenthz/hs-asn1  Library   Build-Depends:     base >= 3 && < 5                    , bytestring-                   , text >= 0.11-                   , mtl-                   , time-                   , asn1-types >= 0.2 && < 0.3-                   , asn1-encoding >= 0.8-+                   , asn1-types >= 0.3 && < 0.4+                   , asn1-encoding >= 0.9   Exposed-modules:   Data.ASN1.Parse   ghc-options:       -Wall  source-repository head   type:     git-  location: git://github.com/vincenthz/hs-asn1+  location: https://github.com/vincenthz/hs-asn1+  subdir:   parse