diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ + +Copyright (c) 2013, Hans Höglund +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 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 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. + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/sparse.cabal b/sparse.cabal new file mode 100644 --- /dev/null +++ b/sparse.cabal @@ -0,0 +1,32 @@ + +name: sparse +version: 0.5 +cabal-version: >= 1.10 +author: Hans Hoglund +maintainer: Hans Hoglund +license: BSD3 +license-file: COPYING +synopsis: Lightweight parsing library based on partial functions. +category: +tested-with: GHC +build-type: Simple + +description: + To be written. + +source-repository head + type: git + location: git://github.com/hanshoglund/sparse.git + +library + build-depends: + base >= 4 && < 5, + nats, + semigroups, + pointed, + monadplus + + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: + Data.Sparse diff --git a/src/Data/Sparse.hs b/src/Data/Sparse.hs new file mode 100644 --- /dev/null +++ b/src/Data/Sparse.hs @@ -0,0 +1,215 @@ + +{-# LANGUAGE GeneralizedNewtypeDeriving, + OverloadedStrings, + TypeOperators, + DeriveFunctor, + DeriveFoldable, + FlexibleInstances + #-} + + +------------------------------------------------------------------------------------- +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (GNTD, DeriveFunctor, OverloadedStrings) +-- +-- Lightweight parsing library based on partial functions. +-- +------------------------------------------------------------------------------------- + +module Data.Sparse ( + -- * Sparse + SparseT, + Sparse, + asSparse, + + -- * Running + runSparseT, + runSparseT', + runSparse, + runSparse', + + -- * Primitives + headP, + splitP, + + -- * Basic parsers + char, + charIs, + string, + stringIs, + + -- * Combinators + optionally, + optionallyMaybe, + Data.Sparse.optional, + between, + skipMany1, + skipMany, + many1, + sepBy, + sepBy1, + sepEndBy1, + sepEndBy, + endBy1, + endBy, + count +) where + +import Data.String +import Data.Semigroup +import Data.Foldable(Foldable) +import Control.Applicative +import Control.Monad.Plus + +-- TODO +instance Semigroup (Partial a b) where (<>) = mplus + + + + + + +newtype a ?-> b = PartialP { getPartialP :: a -> Maybe (a, b) } + +instance Functor ((?->) r) where + fmap f (PartialP g) = PartialP (fmap (fmap f) . g) + +instance Monad ((?->) r) where + return x = PartialP (\a -> Just (a, x)) + PartialP f >>= k = PartialP $ \r -> (f r >>= \(r1, x) -> getPartialP (k x) r1) + +instance MonadPlus ((?->) r) where + mzero = PartialP (const Nothing) + PartialP f `mplus` PartialP g = PartialP $ \x -> f x `mplus` g x + +instance Applicative ((?->) r) where + pure = return + (<*>) = ap + +instance Alternative ((?->) r) where + empty = mzero + (<|>) = mplus + +instance Semigroup ((?->) a b) where + (<>) = mplus + +instance Monoid ((?->) a b) where + mempty = mzero + mappend = mplus + + +---------- + +newtype SparseT a b = SparseT { getSparseT :: a ?-> b } + deriving (Semigroup, Monoid, Functor, Applicative, Alternative, Monad, MonadPlus) + +instance IsString (SparseT String String) where + fromString = string + +type Sparse = SparseT String + +runSparseT :: SparseT a b -> a -> Maybe b +runSparseT = fmap (fmap snd) . runSparseT' + +runSparseT' :: SparseT a b -> a -> Maybe (a, b) +runSparseT' = getPartialP . getSparseT + +runSparse :: Sparse a -> String -> Maybe a +runSparse = runSparseT + +runSparse' :: Sparse a -> String -> Maybe (String, a) +runSparse' = runSparseT' + +---------- + +-- | Consumes one input element. +-- +-- Fails if the predicate fails, or if there is no more input. +-- +headP = SparseT . PartialP . headP' + +-- | Consume one or more input elements. +-- +-- The given function receives the /entire/ remaining input, and must return +-- the number of consumed elements. +-- +-- Fails if the predicate return 0 or less, or if there is no more input. +-- +splitP = SparseT . PartialP . splitP' + +headP' :: (a -> Bool) -> [a] -> Maybe ([a], a) +headP' p [] = Nothing +headP' p (x:xs) = if not (p x) then Nothing else Just (xs, x) + +splitP' :: ([a] -> Int) -> [a] -> Maybe ([a], [a]) +splitP' p [] = Nothing +splitP' p ys = let n = p ys in if n < 1 then Nothing else Just (drop n ys, take n ys) + +---------- + +char :: Char -> Sparse Char +char c = charIs (== c) + +charIs :: (Char -> Bool) -> Sparse Char +charIs p = headP p + +string :: String -> Sparse String +string s = stringIs (length s) (== s) + +stringIs :: Int -> (String -> Bool) -> Sparse String +stringIs n p = splitP (\xs -> if p (take n xs) then n else 0) + +asSparse = id +asSparse :: Sparse a -> Sparse a + +---------- + +optionally x p = p <|> return x +optionallyMaybe p = optionally Nothing (liftM Just p) +optional p = do{ p; return ()} <|> return () +between open close p + = do{ open; x <- p; close; return x } +skipMany1 p = do{ p; skipMany p } +skipMany p = scan + where + scan = do{ p; scan } <|> return () +many1 p = do{ x <- p; xs <- many p; return (x:xs) } +sepBy p sep = sepBy1 p sep <|> return [] +sepBy1 p sep = do{ x <- p + ; xs <- many (sep >> p) + ; return (x:xs) + } +sepEndBy1 p sep = do{ x <- p + ; do{ sep + ; xs <- sepEndBy p sep + ; return (x:xs) + } + <|> return [x] + } +sepEndBy p sep = sepEndBy1 p sep <|> return [] +endBy1 p sep = many1 (do{ x <- p; sep; return x }) +endBy p sep = many (do{ x <- p; sep; return x }) +count n p | n <= 0 = return [] + | otherwise = sequence (replicate n p) + +---------- + + +-- test :: Sparse [String] +test = asSparse $ string "hans" >> many1 (string ";") + + + + +single x = [x] +list z f xs = case xs of + [] -> z + ys -> f ys + +[a,b,c,d,e,f,g,x,y,z,m,n,o,p,q,r] = undefined