appar-0.1.4/0000755000000000000000000000000011627116714011013 5ustar0000000000000000appar-0.1.4/appar.cabal0000644000000000000000000000173511627116714013110 0ustar0000000000000000Name: appar Version: 0.1.4 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: A simple applicative parser Description: A simple applicative parser in Parsec style Category: Parsing Cabal-Version: >= 1.6 Build-Type: Simple Extra-Source-Files: README library if impl(ghc >= 6.12) GHC-Options: -Wall -fno-warn-unused-do-bind else GHC-Options: -Wall Exposed-Modules: Text.Appar.String Text.Appar.ByteString Text.Appar.LazyByteString Other-Modules: Text.Appar.Input Text.Appar.Parser Build-Depends: base >= 4 && < 5, bytestring Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/appar.git appar-0.1.4/LICENSE0000644000000000000000000000276511627116714012032 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. appar-0.1.4/README0000644000000000000000000000043011627116714011670 0ustar0000000000000000This is subset of Parsec. Parsec 3 provides features which Parsec 2 does not provide: - Applicative style - ByteString as input But Haskell Platform includes Parsec 2, not Parsec 3. Installing Parsec 3 to Haskell Platform environment makes it mess. So, I have implemented this. appar-0.1.4/Setup.hs0000644000000000000000000000005611627116714012450 0ustar0000000000000000import Distribution.Simple main = defaultMain appar-0.1.4/Text/0000755000000000000000000000000011627116714011737 5ustar0000000000000000appar-0.1.4/Text/Appar/0000755000000000000000000000000011627116714013002 5ustar0000000000000000appar-0.1.4/Text/Appar/ByteString.hs0000644000000000000000000000120511627116714015426 0ustar0000000000000000{-| Simple 'Applicative' parser whose input is strict 'ByteString'. The usage is the same as parsec. Parsec 3 provides features which Parsec 2 does not provide: * 'Applicative' style * 'ByteString' as input But Haskell Platform includes Parsec 2, not Parsec 3. Installing Parsec 3 to Haskell Platform environment makes it mess. So, this library was implemented. -} module Text.Appar.ByteString ( -- * Documentation -- ** Parser type Parser , module Text.Appar.Parser ) where import Data.ByteString.Char8 (ByteString) import Text.Appar.Parser {-| Parser synonym for strict 'ByteString'. -} type Parser = MkParser ByteString appar-0.1.4/Text/Appar/Input.hs0000644000000000000000000000154111627116714014436 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Text.Appar.Input where import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L ---------------------------------------------------------------- {-| The class for parser input. -} class Eq inp => Input inp where -- | The head function for input car :: inp -> Char -- | The tail function for input cdr :: inp -> inp -- | The end of input nil :: inp -- | The function to check the end of input isNil :: inp -> Bool instance Input S.ByteString where car = S.head cdr = S.tail nil = S.empty isNil = S.null instance Input L.ByteString where car = L.head cdr = L.tail nil = L.empty isNil = L.null instance Input String where car = head cdr = tail isNil = null nil = "" appar-0.1.4/Text/Appar/LazyByteString.hs0000644000000000000000000000121411627116714016266 0ustar0000000000000000{-| Simple 'Applicative' parser whose input is lazy 'ByteString'. The usage is the same as parsec. Parsec 3 provides features which Parsec 2 does not provide: * 'Applicative' style * 'ByteString' as input But Haskell Platform includes Parsec 2, not Parsec 3. Installing Parsec 3 to Haskell Platform environment makes it mess. So, this library was implemented. -} module Text.Appar.LazyByteString ( -- * Documentation -- ** Parser type Parser , module Text.Appar.Parser ) where import Data.ByteString.Lazy.Char8 (ByteString) import Text.Appar.Parser {-| Parser synonym for strict 'ByteString'. -} type Parser = MkParser ByteString appar-0.1.4/Text/Appar/Parser.hs0000644000000000000000000001367011627116714014601 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| This is subset of Parsec. Parsec 3 provides features which Parsec 2 does not provide: * Applicative style * ByteString as input But Haskell Platform includes Parsec 2, not Parsec 3. Installing Parsec 3 to Haskell Platform environment makes it mess. So, this library was implemented. -} module Text.Appar.Parser ( -- ** Running parser parse -- ** 'Char' parsers , char , anyChar , oneOf , noneOf , alphaNum , digit , hexDigit , space -- ** 'String' parser , string -- ** Parser combinators , try , choice , option , skipMany , skipSome , sepBy1 , manyTill -- ** 'Applicative' parser combinators , (<$>) , (<$) , (<*>) , (*>) , (<*) , (<**>) , (<|>) , some , many , pure -- ** Internals , MkParser(..) , Input(..) , satisfy ) where import Control.Applicative import Control.Monad import Data.Char import Text.Appar.Input ---------------------------------------------------------------- data MkParser inp a = P { -- | Getting the internal parser. runParser :: inp -> (Maybe a, inp) } ---------------------------------------------------------------- instance Functor (MkParser inp) where f `fmap` p = return f <*> p instance Applicative (MkParser inp) where pure = return (<*>) = ap instance Alternative (MkParser inp) where empty = mzero (<|>) = mplus instance Monad (MkParser inp) where return a = P $ \bs -> (Just a, bs) p >>= f = P $ \bs -> case runParser p bs of (Nothing, bs') -> (Nothing, bs') (Just a, bs') -> runParser (f a) bs' fail _ = P $ \bs -> (Nothing, bs) instance MonadPlus (MkParser inp) where mzero = P $ \bs -> (Nothing, bs) p `mplus` q = P $ \bs -> case runParser p bs of (Nothing, bs') -> runParser q bs' (Just a, bs') -> (Just a, bs') ---------------------------------------------------------------- {-| Run a parser. -} parse :: Input inp => MkParser inp a -> inp -> Maybe a parse p bs = fst (runParser p bs) ---------------------------------------------------------------- {-| The parser @satisfy f@ succeeds for any character for which the supplied function @f@ returns 'True'. Returns the character that is actually parsed. -} satisfy :: Input inp => (Char -> Bool) -> MkParser inp Char satisfy predicate = P sat where sat bs | isNil bs = (Nothing, nil) | predicate b = (Just b, bs') | otherwise = (Nothing, bs) where b = car bs bs' = cdr bs ---------------------------------------------------------------- {-| The parser try p behaves like parser p, except that it pretends that it hasn't consumed any input when an error occurs. -} try :: MkParser inp a -> MkParser inp a try p = P $ \bs -> case runParser p bs of (Nothing, _ ) -> (Nothing, bs) (Just a, bs') -> (Just a, bs') ---------------------------------------------------------------- {-| @char c@ parses a single character @c@. Returns the parsed character. -} char :: Input inp => Char -> MkParser inp Char char c = satisfy (c ==) {-| @string s@ parses a sequence of characters given by @s@. Returns the parsed string -} string :: Input inp => String -> MkParser inp String string [] = pure "" string (c:cs) = (:) <$> char c <*> string cs ---------------------------------------------------------------- {-| This parser succeeds for any character. Returns the parsed character. -} anyChar :: Input inp => MkParser inp Char anyChar = satisfy (const True) {-| @oneOf cs@ succeeds if the current character is in the supplied list of characters @cs@. Returns the parsed character. -} oneOf :: Input inp => String -> MkParser inp Char oneOf cs = satisfy (`elem` cs) {-| As the dual of 'oneOf', @noneOf cs@ succeeds if the current character /not/ in the supplied list of characters @cs@. Returns the parsed character. -} noneOf :: Input inp => String -> MkParser inp Char noneOf cs = satisfy (`notElem` cs) {-| Parses a letter or digit (a character between \'0\' and \'9\'). Returns the parsed character. -} alphaNum :: Input inp => MkParser inp Char alphaNum = satisfy isAlphaNum {-| Parses a digit. Returns the parsed character. -} digit :: Input inp => MkParser inp Char digit = satisfy isDigit {-| Parses a hexadecimal digit (a digit or a letter between \'a\' and \'f\' or \'A\' and \'F\'). Returns the parsed character. -} hexDigit :: Input inp => MkParser inp Char hexDigit = satisfy isHexDigit {-| Parses a white space character (any character which satisfies 'isSpace') Returns the parsed character. -} space :: Input inp => MkParser inp Char space = satisfy isSpace ---------------------------------------------------------------- {-| @choice ps@ tries to apply the parsers in the list @ps@ in order, until one of them succeeds. Returns the value of the succeeding parser. -} choice :: [MkParser inp a] -> MkParser inp a choice = foldr (<|>) mzero {-| @option x p@ tries to apply parser @p@. If @p@ fails without consuming input, it returns the value @x@, otherwise the value returned by @p@. -} option :: a -> MkParser inp a -> MkParser inp a option x p = p <|> pure x {-| @skipMany p@ applies the parser @p@ /zero/ or more times, skipping its result. -} skipMany :: MkParser inp a -> MkParser inp () skipMany p = () <$ many p {-| @skipSome p@ applies the parser @p@ /one/ or more times, skipping its result. -} skipSome :: MkParser inp a -> MkParser inp () skipSome p = () <$ some p {-| @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated by @sep@. Returns a list of values returned by @p@. -} sepBy1 :: MkParser inp a -> MkParser inp b -> MkParser inp [a] sepBy1 p sep = (:) <$> p <*> many (sep *> p) {-| @manyTill p end@ applies parser @p@ /zero/ or more times until parser @end@ succeeds. Returns the list of values returned by @p@. -} manyTill :: MkParser inp a -> MkParser inp b -> MkParser inp [a] manyTill p end = scan where scan = [] <$ end <|> (:) <$> p <*> scan appar-0.1.4/Text/Appar/String.hs0000644000000000000000000000107511627116714014607 0ustar0000000000000000{-| Simple 'Applicative' parser whose input is 'String'. The usage is the same as parsec. Parsec 3 provides features which Parsec 2 does not provide: * 'Applicative' style * 'ByteString' as input But Haskell Platform includes Parsec 2, not Parsec 3. Installing Parsec 3 to Haskell Platform environment makes it mess. So, this library was implemented. -} module Text.Appar.String ( -- * Documentation -- ** Parser type Parser , module Text.Appar.Parser ) where import Text.Appar.Parser {-| Parser synonym for 'String'. -} type Parser = MkParser String