1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns, TupleSections #-}
module Postdelay.TimeSpec.Utils where
import Control.Applicative
import Control.Monad
import Control.Lens
import Data.Time
import Data.Time.Lens
import Data.Time.Zones
import Data.Functor
import Data.AdditiveGroup
import Text.Megaparsec
import Text.Megaparsec.Prim (MonadParsec)
import qualified Text.Megaparsec.Lexer as L
type StringParser s m = (MonadParsec Dec s m, Token s ~ Char)
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
signed, optSigned :: (StringParser s m, AdditiveGroup n) => m n -> m n
signed = (<*>) (lexeme sign)
optSigned = (<*>) (option id $ lexeme sign)
sign :: (StringParser s m, AdditiveGroup n) => m (n -> n)
sign = label "sign" $ choice [ char '+' $> id
, char '-' $> negateV
]
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)
|
