packages feed

trifecta (empty) → 0.1

raw patch · 10 files changed

+625/−0 lines, 10 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, fingertree, hashable, intern, parallel, parsec, reducers, semigroupoids, semigroups, text, text-icu, utf8-string, wl-pprint-extras

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2011 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ Text/Trifecta/Cursor.hs view
@@ -0,0 +1,34 @@+module Text.Trifecta.Cursor +  ( Cursor(..)+  ) where++import Data.Hashable+import Data.Monoid+import Data.Sequence+import Data.Interned+import Data.Semigroup+import Data.Foldable++import Text.Trifecta.Delta++data Cursor = Cursor +  { cursorBytes   :: {-# UNPACK #-} !Int+  , cursorDelta   :: !Delta+  , cursorSeqHash :: {-# UNPACK #-} !Int+  , cursorSeq     :: !(Seq Id)+  } deriving Show+++instance Eq Cursor where+  Cursor _ _ h k == Cursor _ _ h' k' = h == h' && k == k'++instance Hashable Cursor where+  hash (Cursor _ _ _ s) = hash (toList s)+    +instance Monoid Cursor where+  mempty = Cursor 0 mempty 0 mempty+  Cursor s d l q `mappend` Cursor s' d' l' q' = Cursor (s + s') (d <> d') (l + l') (q <> q')++instance Semigroup Cursor where+  Cursor s d l q <> Cursor s' d' l' q' = Cursor (s + s') (d <> d') (l + l') (q <> q')+
+ Text/Trifecta/Delta.hs view
@@ -0,0 +1,73 @@+module Text.Trifecta.Delta +  ( Delta(..) +  , HasDelta(..)+  , nextTab+  ) where++import Data.Monoid+import Data.Semigroup+import Data.Hashable+import Data.Word+import Data.Foldable+import Data.ByteString+import Text.Trifecta.Path++data Delta+  = Directed                 !Path -- ^ the sequence of #line directives since the start of the file+              {-# UNPACK #-} !Int  -- ^ the number of lines since the last line directive+              {-# UNPACK #-} !Int  -- ^ the number of characters since the last newline+              {-# UNPACK #-} !Int  -- ^ the number of bytes since the last newline+  | Lines     {-# UNPACK #-} !Int  -- ^ the number of newlines contained+              {-# UNPACK #-} !Int  -- ^ the number of characters since the last newline+              {-# UNPACK #-} !Int  -- ^ the number of bytes since the last newline+  | Tab       {-# UNPACK #-} !Int  -- ^ the number of characters before the tab+              {-# UNPACK #-} !Int  -- ^ the number of characters after the tab+              {-# UNPACK #-} !Int  -- ^ the number of bytes in this range+  | Columns   {-# UNPACK #-} !Int  -- ^ the number of characters+              {-# UNPACK #-} !Int  -- ^ the number of bytes+  deriving Show++instance Hashable Delta where+  hash (Columns c a)      = 0 `hashWithSalt` c `hashWithSalt` a+  hash (Tab x y a)        = 1 `hashWithSalt` x `hashWithSalt` y `hashWithSalt` a+  hash (Lines l c a)      = 2 `hashWithSalt` l `hashWithSalt` c `hashWithSalt` a+  hash (Directed p l c a) = 3 `hashWithSalt` p `hashWithSalt` l `hashWithSalt` c `hashWithSalt` a++instance Monoid Delta where+  mempty = Columns 0 0+  mappend = (<>)++instance Semigroup Delta where+  Columns c a      <> Columns d b         = Columns (c + d) (a + b)+  Columns c a      <> Tab x y b           = Tab (c + x) y (a + b)+  Lines l c a      <> Columns d b         = Lines l (c + d) (a + b)+  Lines l _ _      <> Lines m d b         = Lines (l + m) d b+  Lines l c a      <> Tab x y b           = Lines l (nextTab (c + x) + y) (a + b)+  Tab x y a        <> Columns d b         = Tab x (y + d) (a + b)+  Tab x y a        <> Tab x' y' b         = Tab x (nextTab (y + x') + y') (a + b) +  Directed p l _ a <> Lines m d b         = Directed p (l + m) d (a + b)+  Directed p l c a <> Columns d b         = Directed p l (c + d) (a + b)+  Directed p l c a <> Tab x y b           = Directed p l (nextTab (c + x) + y) (a + b)+  Directed p l _ _ <> Directed p' l' c' b = Directed (appendPath p l p') l' c' b+  _                <> t                   = t+  +nextTab :: Int -> Int+nextTab x = x + (8 - mod x 8)++class HasDelta t where+  delta :: t -> Delta++instance HasDelta Char where+  delta '\t' = Tab 0 0 1+  delta '\n' = Lines 1 0 0+  delta _    = Columns 1 1++instance HasDelta Word8 where+  delta 9  = Tab 0 0 1+  delta 10 = Lines 1 0 0+  delta n | n <= 0x7f              = Columns 1 1+          | n >= 0xc0 && n <= 0xf4 = Columns 1 1+          | otherwise              = Columns 0 1++instance HasDelta ByteString where+  delta = foldMap delta . unpack
+ Text/Trifecta/Hunk.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances #-}+module Text.Trifecta.Hunk +  ( Hunk(..)+  ) where++import Data.ByteString+import Data.FingerTree+import Data.Function (on)+import Data.Hashable+import Data.Interned+import Data.Text as Text+import Data.Text.ICU.Convert+import GHC.IO+import Text.Trifecta.Delta+import Text.PrettyPrint.Leijen.Extras++data Hunk = Hunk {-# UNPACK #-} !Id !Delta {-# UNPACK #-} !ByteString++-- assuming utf8 encoding+prettyByteString :: ByteString -> Doc e+prettyByteString bs = string (Text.unpack (toUnicode (unsafeDupablePerformIO (open "UTF8" Nothing)) bs))++instance Pretty Hunk where+  pretty (Hunk _ _ bs) = prettyByteString bs++instance Show Hunk where+  showsPrec _ h = displayS (renderPretty 0.9 80 (pretty h))+++instance Eq Hunk where+  (==) = (==) `on` identity++instance Hashable Hunk where+  hash = hash . identity++instance Ord Hunk where+  compare = compare `on` identity++instance HasDelta Hunk where+  delta (Hunk _ d _) = d++instance Interned Hunk where+  type Uninterned Hunk = ByteString+  data Description Hunk = Describe {-# UNPACK #-} !ByteString deriving (Eq)+  describe = Describe+  identify i bs = Hunk i (delta bs) bs+  identity (Hunk i _ _) = i+  cache = hunkCache++instance Uninternable Hunk where+  unintern (Hunk _ _ bs) = bs++instance Hashable (Description Hunk) where+  hash (Describe bs) = hash bs++hunkCache :: Cache Hunk+hunkCache = mkCache +{-# NOINLINE hunkCache #-}++instance Measured Delta Hunk where+  measure = delta
+ Text/Trifecta/It.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Text.Trifecta.It +  ( It(..)+  , getRope+  , getMeasure+  , getEof+  ) where++import Control.Applicative+import Control.Monad+import Data.Semigroup+import Data.Monoid+import Data.Word+import Data.FingerTree as FingerTree+import Data.Functor.Bind+import Data.Functor.Plus+import Text.Trifecta.Cursor+import Text.Trifecta.Rope as Rope+import Text.Trifecta.Delta+import Text.Parsec.Prim hiding ((<|>))++data It a +  = Done !Rope !Bool a+  | Fail !Rope !Bool String+  | Cont (Rope -> Bool -> It a)+  +instance Show a => Show (It a) where+  showsPrec d (Done r b a) = showParen (d > 10) $ +    showString "Done " . showsPrec 11 r . showChar ' ' . showsPrec 11 b . showChar ' ' . showsPrec 11 a+  showsPrec d (Fail r b s) = showParen (d > 10) $+    showString "Fail " . showsPrec 11 r . showChar ' ' . showsPrec 11 b . showChar ' ' . showsPrec 11 s+  showsPrec d (Cont k) = showParen (d > 10) $ showString "Cont ..."++instance Functor It where+  fmap f (Done r b a) = Done r b (f a)+  fmap _ (Fail r b s) = Fail r b s+  fmap f (Cont k) = Cont (\r b -> fmap f (k r b))++instance Apply It where+  (<.>) = (<*>) ++instance Applicative It where+  pure = Done mempty False+  (<*>) = ap++instance Alt It where+  Fail r b _ <!> Cont k = k r b+  Fail r b _ <!> Done _ _ a = Done r b a+  Fail r b _ <!> Fail _ _ s = Fail r b s+  m <!> _ = m++instance Alternative It where+  (<|>) = (<!>)+  empty = fail "empty"++instance Bind It where+  (>>-) = (>>=)++instance Monad It where+  return = Done mempty False+  Done (Rope _ t) False a >>= f | FingerTree.null t = f a+  Done h e a >>= f = case f a of+    Done _ _ b -> Done h e b+    Fail _ _ s -> Fail h e s+    Cont k     -> k h e+  Fail r b s >>= _ = Fail r b s+  Cont k >>= f     = Cont $ \h e -> k h e >>= f+  fail = Fail mempty False++instance MonadPlus It where+  mplus = (<!>) +  mzero = fail "mzero"++getRope :: It Rope+getRope = Cont $ \r e -> Done r e r++getMeasure :: It Cursor+getMeasure = Cont $ \r e -> Done r e (measure r)++getEof :: It Bool+getEof = Cont $ \ r e -> Done r e e ++instance Stream Cursor It Char where+  uncons (Cursor b d _ _) = (getWord8 b >>= go) <|> return Nothing where+    go c | c <= 0x7f = do+        Cursor _ _ i t <- getMeasure+        return $ Just (toEnum (fromEnum c), Cursor (b + 1) (d <> delta c) i t)+         | otherwise = error "TODO"+    -- TODO: finish these++getWord8 :: Int -> It Word8+getWord8 n = Cont go where+  go h eof +    | n < Rope.lastNewline h eof = Done h eof $ indexByte n h+    | eof                        = Fail h True "Unexpected EOF"+    | otherwise                  = Cont $ \h' -> go (h <> h')
+ Text/Trifecta/Path.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances, BangPatterns #-}+module Text.Trifecta.Path+  ( FileName+  , Path(..), History(..)+  , startPath+  , snocPath+  , path+  , appendPath+  , prettyPathWith+  ) where++import Data.Hashable+import Data.Interned+import Data.Interned.String+import Data.Semigroup+import Text.PrettyPrint.Leijen.Extras++type FileName = InternedString++data Path = Path {-# UNPACK #-} !Id !History !MaybeFileName {-# UNPACK #-} !Int [Int]++prettyPathWith :: (Doc e -> Doc e) -> Path -> Int -> Doc e +prettyPathWith wrapDir = go where+  go (Path _ h mf l flags) delta +     = addHistory +     $ wrapDir $ hsep $ text "#" : pretty (l + delta) : addFile (map pretty flags) where+    addHistory = case h of+      Continue p d -> above (prettyPathWith wrapDir p d)+      Complete -> id+    addFile = case mf of+      JustFileName f -> (:) (dquotes (pretty (unintern f)))+      NothingFileName -> id++instance Pretty Path where+  pretty p = prettyPathWith id p 0++instance Show Path where+  showsPrec _ p = displayS (renderPretty 0.9 80 (pretty p))++data History = Continue !Path {-# UNPACK #-} !Int | Complete+data MaybeFileName = JustFileName !FileName | NothingFileName deriving Eq++startPath :: FileName -> Path +startPath !n = path Complete (JustFileName n) 0 []++snocPath :: Path -> Int -> MaybeFileName -> Int -> [Int] -> Path+snocPath d l jf l' flags = path (Continue d l) jf l' flags++-- does case analysis to ensure the Maybe carries a fully evaluated argument+path :: History -> MaybeFileName -> Int -> [Int] -> Path+path !h !mf l flags = intern (UPath h mf l flags)++appendPath :: Path -> Int -> Path -> Path+appendPath p dl (Path _ Complete          mf l flags) = snocPath p dl mf l flags+appendPath p dl (Path _ (Continue p' dl') mf l flags) = snocPath (appendPath p dl p') dl' mf l flags++instance Semigroup Path where+  p <> p' = appendPath p 0 p'++data UninternedPath = UPath !History !MaybeFileName {-# UNPACK #-} !Int [Int]+data DHistory = DContinue {-# UNPACK #-} !Id {-# UNPACK #-} !Int | DComplete deriving Eq++instance Hashable DHistory where+  hash (DContinue x y) = y `hashWithSalt` x+  hash DComplete       = 0++instance Hashable Path where+  hash = hash . identity++instance Interned Path where+  type Uninterned Path = UninternedPath+  data Description Path = DPath !(Maybe Id) {-# UNPACK #-} !Int [Int] !DHistory deriving Eq+  describe (UPath h mf l flags) = DPath mi l flags $ case h of+    Continue p dl -> DContinue (identity p) dl+    Complete      -> DComplete +    where +      mi = case mf of +        JustFileName f -> Just (identity f)+        NothingFileName -> Nothing+                     +  identify i (UPath h mf l flags) = Path i h mf l flags+  identity (Path i _ _ _ _) = i+  cache = pathCache++instance Uninternable Path where+  unintern (Path _ h mf l flags) = UPath h mf l flags++instance Hashable (Description Path) where+  hash (DPath mi l flags dh) = l `hashWithSalt` mi `hashWithSalt` flags `hashWithSalt` dh++pathCache :: Cache Path+pathCache = mkCache+{-# NOINLINE pathCache #-}
+ Text/Trifecta/Rope.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}+module Text.Trifecta.Rope+  ( Strand(..)+  , Rope(..)+  , indexByte+  , size+  , lastNewline+  ) where++import Data.Sequence as Seq+import Data.Interned+import Data.Hashable+import Data.Monoid+import Data.Semigroup+import Data.ByteString as Strict+import Data.FingerTree as FingerTree+import Data.Word+import Data.Foldable (toList)+import Text.Trifecta.Hunk+import Text.Trifecta.Path+import Text.Trifecta.Cursor+import Text.Trifecta.Delta++data Strand+  = HunkStrand !Hunk+  | PathStrand !Path++instance Show Strand where+  showsPrec d (HunkStrand h) = showsPrec d h+  showsPrec d (PathStrand p) = showsPrec d p++-- measure twice, cut once+instance Measured Cursor Strand where+  measure (HunkStrand s) = Cursor (Strict.length (unintern s)) (delta s) i (Seq.singleton i) where i = 42 + (identity s * 2)+  measure (PathStrand p) = Cursor 0 (Directed p 0 0 0) i (Seq.singleton i)   where i = 42 + (identity p * 2 + 1)++data Rope = Rope +  { _ropeId  :: {-# UNPACK #-} !Id+  , ropeTree :: !(FingerTree Cursor Strand)+  }++size :: Rope -> Int+size = cursorBytes . measure++instance Measured Cursor Rope where+  measure (Rope _ t) = measure t++instance Show Rope where+  showsPrec d (Rope _ r) = showsPrec d (toList r)++lastNewline :: Rope -> Bool -> Int+lastNewline t True  = size t+lastNewline t False = case d of+	Columns _ _       -> 0+        Tab _ _ _         -> 0+        Lines _ _ b'      -> b - b'+        Directed _ _ _ b' -> b - b'+  where Cursor b d _ _ = measure t++indexByte :: Int -> Rope -> Word8+indexByte i (Rope _ t) = Strict.index a $ i - cursorBytes (measure l) where+   (l, r) = FingerTree.split (\b -> cursorBytes b > i) t+   HunkStrand (Hunk _ _ a) FingerTree.:< _ = FingerTree.viewl r++instance Monoid Rope where+  mempty = intern mempty+  mappend x y = intern (unintern x `mappend` unintern y)++instance Semigroup Rope where+  x <> y = intern (unintern x `mappend` unintern y)++instance Interned Rope where+  type Uninterned Rope = FingerTree Cursor Strand+  data Description Rope = DR {-# UNPACK #-} !Int !(Seq Id) deriving Eq+  describe t = DR h i where Cursor _ _ h i = measure t+  identify = Rope+  identity (Rope i _) = i+  cache = ropeCache++instance Hashable (Description Rope) where+  hash (DR i s) = hashWithSalt i (toList s) ++instance Uninternable Rope where+  unintern (Rope _ r) = r++ropeCache :: Cache Rope+ropeCache = mkCache+{-# NOINLINE ropeCache #-}
+ Text/Trifecta/Supply.hs view
@@ -0,0 +1,95 @@+module Text.Trifecta.Supply +  ( Supply(..)+  , EOF(..)+  , supplyEOF+  , supplyRope+  , supplyStrand+  , supplyHunk+  , supplyPath+  , supplyByteString+  ) where++import Text.Trifecta.Path+import Text.Trifecta.Rope+import Text.Trifecta.Hunk+import Text.Trifecta.It+import Data.Interned+import Data.Monoid+import Data.Semigroup+import Data.Foldable+import Data.Word+import Data.Semigroup.Foldable+import Data.List.NonEmpty+import Data.FingerTree as FingerTree+import Data.ByteString as Strict+import Data.ByteString.UTF8 as UTF8+import Control.Parallel.Strategies hiding (Done)++-- enumerators for our iteratee++class Supply t where+  supply :: t -> It a -> It a +  supplyList :: [t] -> It a -> It a +  supplyList = Prelude.foldr (\t b -> b . supply t) id++data EOF = EOF++instance Supply EOF where+  supply _ = supplyEOF++supplyEOF :: It a -> It a+supplyEOF (Cont k)     = k mempty True+supplyEOF (Done r _ a) = Done r True a+supplyEOF (Fail r _ a) = Fail r True a++supplyRope :: Rope -> It a -> It a+supplyRope new (Done old _ a) = Done (old <> new) False a+supplyRope new (Fail old _ a) = Fail (old <> new) False a+supplyRope new (Cont k) = k new False++supplyStrand :: Strand -> It a -> It a +supplyStrand = supplyRope . intern . FingerTree.singleton++supplyHunk :: Hunk -> It a -> It a+supplyHunk = supplyStrand . HunkStrand++supplyPath :: Path -> It a -> It a+supplyPath = supplyStrand . PathStrand++supplyByteString :: ByteString -> It a -> It a +supplyByteString bs = supplyHunk (intern bs)++instance Supply Word8 where+  supply = supplyByteString . Strict.singleton+  supplyList = supplyByteString . Strict.pack++instance Supply Char where+  supply c | fromEnum c <= 0x7f = supplyByteString $ Strict.singleton $ toEnum $ fromEnum c+           | otherwise = error "TODO"+        -- TODO: more+  supplyList = supplyByteString . UTF8.fromString++instance Supply a => Supply [a] where+  supply = supplyList++instance Supply ByteString where+  supply = supplyByteString+  supplyList = supplyList . Prelude.map (HunkStrand . intern)++instance Supply Hunk where+  supply = supplyHunk+  supplyList = supplyList . Prelude.map HunkStrand++instance Supply Path where+  supply = supplyPath+  supplyList [] = id+  supplyList (x:xs) = supplyPath $ fold1 (x:|xs)++instance Supply Strand where+  supply = supplyStrand+  supplyList xs = supplyRope (intern (FingerTree.fromList xs')) where+     !xs' = withStrategy (evalList rseq) xs++instance Supply Rope where+  supply = supplyRope+  supplyList = supplyRope . fold
+ trifecta.cabal view
@@ -0,0 +1,48 @@+name:          trifecta+category:      Text, Parsing+version:       0.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     experimental+homepage:      http://github.com/ekmett/trifecta/+copyright:     Copyright (C) 2011 Edward A. Kmett+synopsis:      Parser combinators with slicing and diagnostic support+description:   Parser combinators with slicing and diagnostic support+build-type:    Simple  ++source-repository head+  type: git+  location: git://github.com/ekmett/trifecta.git++library+  build-depends: +    base             >= 4        && < 5, +    containers       >= 0.3      && < 0.5,+    intern           >= 0.5      && < 0.6,+    hashable         >= 1.1.2.1  && < 1.2,+    bytestring       >= 0.9.1    && < 0.10,+    text             >= 0.11.1.5 && < 0.12,+    text-icu         >= 0.6.3.4  && < 0.7,+    wl-pprint-extras >= 1.2      && < 1.3,+    semigroups       >= 0.7.1    && < 0.8, +    fingertree       >= 0.0.1    && < 0.1,+    reducers         >= 0.1      && < 0.2,+    parsec           >= 3.1.1    && < 3.2,+    utf8-string      >= 0.3.6    && < 0.4,+    semigroupoids    >= 1.2.4    && < 1.3,+    parallel         >= 3.1.0.1  && < 3.2++  ghc-options: -Wall++  exposed-modules:+    Text.Trifecta.Path+    Text.Trifecta.Delta+    Text.Trifecta.Cursor+    Text.Trifecta.Rope+    Text.Trifecta.Hunk+    Text.Trifecta.It+    Text.Trifecta.Supply+