diff options
Diffstat (limited to 'lib/Postdelay/TimeSpec')
| -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) | ||
