uu-parsinglib 2.5.5.1 → 2.5.5.2

raw patch · 5 files changed

+58/−2 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Text/ParserCombinators/UU/BasicInstances.hs +9/−1
• src/Text/ParserCombinators/UU/CHANGELOG.hs +4/−0
• src/Text/ParserCombinators/UU/Core.hs +23/−0
• src/Text/ParserCombinators/UU/Derived.hs +21/−0
• uu-parsinglib.cabal +1/−1

@@ -26,9 +26,10 @@  show (Deleted  t pos expecting) = "-- >    Deleted  " ++  t ++ " at position " ++ show pos ++  show_expecting  expecting   show (DeletedAtEnd t)           = "-- >    The token " ++ t ++ " was not consumed by the parsing process." +show_errors :: (Show a) => [a] -> IO () show_errors = sequence_ . (map (putStrLn . show)) -+show_expecting :: [String] -> String show_expecting [a]    = " expecting " ++ a show_expecting (a:as) = " expecting one of [" ++ a ++ concat (map (", " ++) as) ++ "]" show_expecting []     = " expecting nothing"@@ -38,6 +39,7 @@                              ,  pos      :: loc                              ,  deleteOk :: !Bool} +listToStr :: [t] -> loc -> Str t loc listToStr ls initloc = Str   ls  []  initloc  True  type Parser a = P (Str Char (Int,Int)) a @@ -115,12 +117,18 @@           Just rest -> show_tokens ("Accepting token: " ++ show as ++"\n")                         (Step l (k as (Str rest msgs (advance pos as) True))) +pToken :: (Provides state (Token a) token) => [a] -> P state token pToken     as   =   pTokenCost as 5 pTokenCost as c =   if null as then error "call to pToken with empty token"                     else pSymExt (length as) Nothing (Token as c)                     where length [] = Zero                           length (_:as) = Succ (length as) +show_tokens :: a -> b -> b show_tokens m v = {-  trace m  -} v++show_munch :: a -> b -> b show_munch  m v = {-  trace m  -} v++show_symbol :: a -> b -> b show_symbol m v = {-  trace m  -} v

@@ -1,4 +1,8 @@ -- | This module just contains the CHANGELOG+-- Version 2.5.5.2+--+--      *  type signatures were added to make Haddock happy+-- -- Version 2.5.5.1 -- --      *  type signatures were added to make the library GHC 7 ready.

@@ -101,9 +101,12 @@ instance Show (P st a) where   show (P _ nt n e) = "P _ " ++ maybe "Nothing" (const "(Just _)") nt ++ " (" ++ show n ++ ") " ++ maybe "Nothing" (const "(Just _)") e +getOneP :: P a b -> Maybe (P a b) getOneP (P _ (Just _)  Zero _ )    =  error "The element is a special parser which cannot be combined" getOneP (P _ Nothing   l    _ )    =  Nothing getOneP (P _ onep      l    ep )   =  Just( P (mkParser onep Nothing)  onep l Nothing)++getZeroP :: P t a -> Maybe (P st a) getZeroP (P _ _ l Nothing)         =  Nothing getZeroP (P _ _ l pe)              =  Just (P (mkParser Nothing pe) Nothing l pe) -- TODO check for erroneous parsers @@ -114,6 +117,8 @@ mkParser np@(Just nt) ne@(Just a)  =  (nt <|> pure a)   -- combine creates the non-empty parser +combine :: (Alternative f) => Maybe t1 -> Maybe t2 -> t -> Maybe t3+        -> (t1 -> t -> f a) -> (t2 -> t3 -> f a) -> Maybe (f a) combine Nothing   Nothing  _  _     _   _   = Nothing      -- this Parser always fails combine (Just p)  Nothing  aq _     op1 op2 = Just (p `op1` aq)  combine (Just p)  (Just v) aq nq    op1 op2 = case nq of@@ -218,8 +223,13 @@ -- %%%%%%%%%%%%% Monads      %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +unParser_h :: P b a -> (a -> b -> Steps r) -> b -> Steps r unParser_h (P (T  h   _  _ ) _ _ _ )  =  h++unParser_f :: P b a -> (b -> Steps r) -> b -> Steps (a, r) unParser_f (P (T  _   f  _ ) _ _ _ )  =  f++unParser_r :: P b a -> (b -> Steps r) -> b -> Steps r unParser_r (P (T  _   _  r ) _ _ _ )  =  r            -- !! do not move the P constructor behind choices/patern matches@@ -394,10 +404,16 @@       End_h  ::                 ([a] , [a]     ->  Steps r)    ->  Steps   (a,r)       -> Steps   (a, r)       End_f  ::                 [Steps   a]    ->  Steps   a                           -> Steps   a +succeedAlways :: Steps a succeedAlways = let steps = Step 0 steps in steps++failAlways :: Steps a failAlways  =  Fail [] [const (0, failAlways)]++noAlts :: Steps a noAlts      =  Fail [] [] +has_success :: Steps t -> Bool has_success (Step _ _) = True has_success _        = False  @@ -415,8 +431,10 @@  push        :: v -> Steps   r -> Steps   (v, r) push v      =  Apply (\ r -> (v, r))+ apply       :: Steps (b -> a, (b, r)) -> Steps (a, r) apply       =  Apply (\(b2a, ~(b, r)) -> (b2a b, r)) + pushapply   :: (b -> a) -> Steps (b, r) -> Steps (a, r) pushapply f = Apply (\ (b, r) -> (f b, r))  @@ -431,6 +449,7 @@ norm     (Apply f (End_h  _    _  ))   =   error "Apply before End_h" norm     steps                         =   steps +applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)] applyFail f  = map (\ g -> \ ex -> let (c, l) =  g ex in  (c, f l))  -- | The function @best@ compares two streams@@ -485,6 +504,7 @@ traverse n (End_h ((a, lf))    r)  v c =  traverse n (lf a `best` removeEnd_h r) v c traverse n (End_f (l      :_)  r)  v c =  traverse n (l `best` r) v c +show' :: (Show a, Show b, Show c) => a -> b -> c -> String show' n v c = "n: " ++ show n ++ " v: " ++ show v ++ " c: " ++ show c  @@ -550,12 +570,15 @@ nat_min (Succ ll)  (Succ rr) n  = if n > 1000 then error "problem with comparing lengths"                                    else trace' ("Succ in nat_min " ++ show n ++ "\n")         (let (v, b) = nat_min ll  rr (n+1) in (Succ v, b)) +nat_add :: Nat -> Nat -> Nat nat_add Infinite  _ = trace' "Infinite in add\n" Infinite nat_add Zero      r = trace' "Zero in add\n"     r nat_add (Succ l)  r = trace' "Succ in add\n"     (Succ (nat_add l r)) +get_length :: P a b -> Nat get_length (P _ _  l _) = l +trace' :: a -> b -> b trace' m v = {-  trace m  -} v   

@@ -167,6 +167,7 @@    fmap f (Opt           p)    = Opt         (f p)    fmap f (Never         p)    = Never       (f p) +canBeEmpty :: Freq t -> Bool canBeEmpty (AtLeast _    p)  = False canBeEmpty (AtMost  _    p)  = True canBeEmpty (Between n m  p)  = if n==0 then error "wrong use of Between" else False -- safety check@@ -196,6 +197,7 @@                             then foldr (<|>) units palts                             else foldr1 (<|>) palts +toParserSep :: [Freq (P st (b -> b))] -> P st a -> P st b -> P st b toParserSep alts sep  units  =  let palts = [p <*> toParser  (map (fmap (sep *>)) ps) units | (p,ps) <- split alts id]                                 in if   and (map canBeEmpty alts)                                     then foldr  (<|>) units palts@@ -212,6 +214,9 @@              , map (fmap (mapFst <$>)) pp ++  map (fmap (mapSnd <$>)) qp              , \f (x, y) -> qunp (punp f x) y              )++pSem :: t -> MergeSpec (t1, t2, t -> t3 -> t4)+          -> MergeSpec (t1, t2, (t4 -> t5) -> t3 -> t5) f `pSem` MergeSpec (units, alts, unp) = MergeSpec  (units, alts, \ g arg -> g ( unp f arg))  pMerge ::  c -> MergeSpec (d, [Freq (P st (d -> d))], c -> d -> e) -> P st e@@ -220,21 +225,37 @@ pMergeSep ::  (c, P st a)  -> MergeSpec (d, [Freq (P st (d -> d))], c -> d -> e) -> P st e (sem, sep) `pMergeSep` MergeSpec (units, alts, unp) =  unp sem <$> toParserSep alts sep (pure units) +pBetween :: Int -> Int -> P t t1 -> MergeSpec ([a], [Freq (P t ([t1] -> [t1]))], a1 -> a1) pBetween  n m p = must_be_non_empty "pOpt"  p                   (if m <n || m <= 0 then         (MergeSpec ([]       ,[                           ], id))                    else if n==0 then              (MergeSpec ([]       ,[AtMost  m     ((:)   <$> p)], id))                    else                           (MergeSpec ([]       ,[Between n m   ((:)   <$> p)], id)))++pAtMost :: Int -> P t t1 -> MergeSpec ([a], [Freq (P t ([t1] -> [t1]))], a1 -> a1) pAtMost   n   p = must_be_non_empty "pOpt"  p                  (if n <= 0         then         (MergeSpec ([]       ,[                           ], id))                                     else         (MergeSpec ([]       ,[AtMost  n     ((:)   <$> p)], id)))++pAtLeast :: Int -> P t t1 -> MergeSpec ([a], [Freq (P t ([t1] -> [t1]))], a1 -> a1) pAtLeast  n   p = must_be_non_empty "pOpt"  p                  (if n <= 0         then         (MergeSpec ([]       ,[Many          ((:)   <$> p)], id))                                     else         (MergeSpec ([]       ,[AtLeast n     ((:)   <$> p)], id)))++pMany :: P t t1 -> MergeSpec ([a], [Freq (P t ([t1] -> [t1]))], a1 -> a1) pMany p        = must_be_non_empty "pMany" p     (MergeSpec ([]       ,[Many          ((:)   <$> p)], id))++pOpt :: P t t1 -> t11 -> MergeSpec (t11, [Freq (P t (b -> t1))], a -> a) pOpt  p v      = must_be_non_empty "pOpt"  p     (MergeSpec (v        ,[Opt           (const <$> p)], id))++pSome :: P t t1 -> MergeSpec ([a], [Freq (P t ([t1] -> [t1]))], a1 -> a1) pSome p        = must_be_non_empty "pSome" p     (MergeSpec ([]       ,[AtLeast 1     ((:)   <$> p)], id))++pOne :: P t t1 -> MergeSpec (a, [Freq (P t (b -> t1))], a1 -> a1) pOne  p        = must_be_non_empty "pOne"  p     (MergeSpec (undefined,[One           (const <$> p)], id)) +mapFst :: (t -> t2) -> (t, t1) -> (t2, t1) mapFst f (a, b) = (f a, b)++mapSnd :: (t1 -> t2) -> (t, t1) -> (t, t2) mapSnd f (a, b) = (a, f b) 

@@ -1,5 +1,5 @@ Name:                uu-parsinglib-Version:             2.5.5.1+Version:             2.5.5.2 Build-Type:          Simple License:             MIT Copyright:           S Doaitse Swierstra