summaryrefslogtreecommitdiff
path: root/lib/Postdelay/TimeSpec/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Postdelay/TimeSpec/Utils.hs')
-rw-r--r--lib/Postdelay/TimeSpec/Utils.hs22
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 @@
1{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} 1{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns, TupleSections #-}
2 2
3module Postdelay.TimeSpec.Utils where 3module Postdelay.TimeSpec.Utils where
4 4
@@ -21,8 +21,9 @@ import qualified Text.Megaparsec.Lexer as L
21type StringParser s m = (MonadParsec Dec s m, Token s ~ Char) 21type StringParser s m = (MonadParsec Dec s m, Token s ~ Char)
22 22
23 23
24spaceConsumer :: StringParser s m => m () 24spaceConsumer, spaces :: StringParser s m => m ()
25spaceConsumer = L.space (void spaceChar) empty empty 25spaceConsumer = L.space (void spaceChar) empty empty
26spaces = void $ lexeme spaceChar
26 27
27lexeme :: StringParser s m => m a -> m a 28lexeme :: StringParser s m => m a -> m a
28lexeme = L.lexeme spaceConsumer 29lexeme = L.lexeme spaceConsumer
@@ -38,3 +39,20 @@ sign = label "sign" $ choice [ char '+' $> id
38 39
39fromDigit :: Num n => Char -> n 40fromDigit :: Num n => Char -> n
40fromDigit c = fromIntegral $ fromEnum c - fromEnum '0' 41fromDigit c = fromIntegral $ fromEnum c - fromEnum '0'
42
43mkGramSepBy :: MonadParsec e s m => m a -> [m b] -> m [b]
44mkGramSepBy sep ps = map snd <$> mkGramSepBy' sep (zip [0..] ps)
45 where
46 mkGramSepBy' _ [] = empty
47 mkGramSepBy' _ [(n, x)] = pure . (n, ) <$> x
48 mkGramSepBy' sep ps = do
49 head@(n, _) <- choice $ map (\(n, p) -> (n, ) <$> p) ps
50 let ps' = filter (\(i, _) -> i /= n) ps
51 tail <- option [] . try $ sep *> mkGramSepBy' sep ps'
52 return $ insert head tail
53
54 insert :: forall a. (Integer, a) -> [(Integer, a)] -> [(Integer, a)]
55 insert x@(fst -> a) [] = [x]
56 insert x@(fst -> a) (y@(fst -> b):ds)
57 | a <= b = x:y:ds
58 | otherwise = y:(insert x ds)