Refined framework

1 files changed, 20 insertions, 2 deletions

diff --git a/lib/Postdelay/TimeSpec/Utils.hs b/lib/Postdelay/TimeSpec/Utils.hs
index 83a271d..54b85f7 100644
--- a/lib/Postdelay/TimeSpec/Utils.hs
+++ b/lib/Postdelay/TimeSpec/Utils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns #-}
+{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns, TupleSections #-}
 
 module Postdelay.TimeSpec.Utils where
 
@@ -21,8 +21,9 @@ import qualified Text.Megaparsec.Lexer as L
 type StringParser s m = (MonadParsec Dec s m, Token s ~ Char)
 
   
-spaceConsumer :: StringParser s m => m ()
+spaceConsumer, spaces :: StringParser s m => m ()
 spaceConsumer = L.space (void spaceChar) empty empty
+spaces = void $ lexeme spaceChar
 
 lexeme :: StringParser s m => m a -> m a
 lexeme = L.lexeme spaceConsumer
@@ -38,3 +39,20 @@ sign = label "sign" $ choice [ char '+' $> id
 
 fromDigit :: Num n => Char -> n
 fromDigit c = fromIntegral $ fromEnum c - fromEnum '0'
+
+mkGramSepBy :: MonadParsec e s m => m a -> [m b] -> m [b]
+mkGramSepBy sep ps = map snd <$> mkGramSepBy' sep (zip [0..] ps)
+  where
+    mkGramSepBy' _ [] = empty
+    mkGramSepBy' _ [(n, x)] = pure . (n, ) <$> x
+    mkGramSepBy' sep ps = do
+      head@(n, _) <- choice $ map (\(n, p) -> (n, ) <$> p) ps
+      let ps' = filter (\(i, _) -> i /= n) ps
+      tail <- option [] . try $ sep *> mkGramSepBy' sep ps'
+      return $ insert head tail
+
+    insert :: forall a. (Integer, a) -> [(Integer, a)] -> [(Integer, a)]
+    insert x@(fst -> a) [] = [x]
+    insert x@(fst -> a) (y@(fst -> b):ds)
+      | a <= b = x:y:ds
+      | otherwise = y:(insert x ds)