diff options
Diffstat (limited to 'lib/Postdelay/TimeSpec/Utils.hs')
-rw-r--r-- | lib/Postdelay/TimeSpec/Utils.hs | 22 |
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 | ||
3 | module Postdelay.TimeSpec.Utils where | 3 | module Postdelay.TimeSpec.Utils where |
4 | 4 | ||
@@ -21,8 +21,9 @@ import qualified Text.Megaparsec.Lexer as L | |||
21 | type StringParser s m = (MonadParsec Dec s m, Token s ~ Char) | 21 | type StringParser s m = (MonadParsec Dec s m, Token s ~ Char) |
22 | 22 | ||
23 | 23 | ||
24 | spaceConsumer :: StringParser s m => m () | 24 | spaceConsumer, spaces :: StringParser s m => m () |
25 | spaceConsumer = L.space (void spaceChar) empty empty | 25 | spaceConsumer = L.space (void spaceChar) empty empty |
26 | spaces = void $ lexeme spaceChar | ||
26 | 27 | ||
27 | lexeme :: StringParser s m => m a -> m a | 28 | lexeme :: StringParser s m => m a -> m a |
28 | lexeme = L.lexeme spaceConsumer | 29 | lexeme = L.lexeme spaceConsumer |
@@ -38,3 +39,20 @@ sign = label "sign" $ choice [ char '+' $> id | |||
38 | 39 | ||
39 | fromDigit :: Num n => Char -> n | 40 | fromDigit :: Num n => Char -> n |
40 | fromDigit c = fromIntegral $ fromEnum c - fromEnum '0' | 41 | fromDigit c = fromIntegral $ fromEnum c - fromEnum '0' |
42 | |||
43 | mkGramSepBy :: MonadParsec e s m => m a -> [m b] -> m [b] | ||
44 | mkGramSepBy 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) | ||