sparse (empty) → 0.5
raw patch · 4 files changed
+277/−0 lines, 4 filesdep +basedep +monadplusdep +natssetup-changed
Dependencies added: base, monadplus, nats, pointed, semigroups
Files
- COPYING +26/−0
- Setup.lhs +4/−0
- sparse.cabal +32/−0
- src/Data/Sparse.hs +215/−0
+ COPYING view
@@ -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 <organization> 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 <COPYRIGHT HOLDER> 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.+
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ sparse.cabal view
@@ -0,0 +1,32 @@++name: sparse+version: 0.5+cabal-version: >= 1.10+author: Hans Hoglund+maintainer: Hans Hoglund <hans@hanshoglund.se>+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
+ src/Data/Sparse.hs view
@@ -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