Establish framework

5 files changed, 183 insertions, 359 deletions

diff --git a/lib/Postdelay/Scan.hs b/lib/Postdelay/Scan.hs
index 2f0a78a..888a237 100644
--- a/lib/Postdelay/Scan.hs
+++ b/lib/Postdelay/Scan.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, FlexibleContexts, RecordWildCards, ViewPatterns, TupleSections #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, FlexibleContexts, RecordWildCards, ViewPatterns, TupleSections, RankNTypes #-}
 
 module Postdelay.Scan
   ( scan
@@ -7,20 +7,18 @@ module Postdelay.Scan
   ) where
 
 import Postdelay.Types
-import Postdelay.Utils
 import Postdelay.TimeSpec
 
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Except
+import Control.Monad.Catch
 import Control.Monad.Reader
 import Control.Monad.List
 import Control.Exception.Base
+import Control.Lens
 
-import Text.Parsec.Char
-import Text.Parsec.Prim
-import Text.Parsec.Combinator
-import Text.Parsec.Error (ParseError(..))
+import qualified Text.Parsec as P
+import Text.Megaparsec
 import Text.ParserCombinators.Parsec.Rfc2822
 import Codec.MIME.Decode (decodeWords)
 
@@ -40,17 +38,20 @@ import System.Time (CalendarTime(..))
 
 import Debug.Trace
 
+instance Exception P.ParseError
 
-scan :: (MonadIO m, MonadError ParseError m) => String -> m (Maybe Delay)
-scan = fmap getOption . extractDelay <=< either throwError return . parse message ""
 
-extractDelay :: forall m. (MonadIO m, MonadError ParseError m) => Message -> m (Option Delay)
+scan :: (MonadIO m, MonadThrow m) => String -> m (Maybe Delay)
+scan = fmap getOption . extractDelay <=< either throwM return . P.parse message ""
+
+extractDelay :: forall m. (MonadIO m, MonadThrow m) => Message -> m (Option Delay)
 extractDelay (Message headers _) = do
-  zones <- zoneHeaders
-  let (baseTime, dateTz) = maximumBy (comparing fst) dateHeaders
-      tz = foldr' (flip (<>)) (Left dateTz) zones
-  foldMap pure <$> mapM (flip runReaderT TimeCtx{..} . parseDelay) delayHeaders
+  tz <- foldr' (flip (<>)) (Left dateTz) <$> zoneHeaders
+  let apply f = Until (baseTime & localT tz %~ appEndo f)
+  fmap apply . foldMap pure <$> mapM parseDelay delayHeaders
   where
+    (baseTime, dateTz) = maximumBy (comparing fst) dateHeaders
+
     delayHeaders :: [Field]
     delayHeaders = do
       (OptionalField field content) <- headers
@@ -67,7 +68,11 @@ extractDelay (Message headers _) = do
     zoneHeaders = runListT $ do
       (OptionalField field content) <- ListT $ return headers
       guard $ CI.mk field == "X-Timezone"
-      Right r <- runParserT (spaces *> pTimeZone <* spaces <* eof) () field content
+      Right r <- runParserT (spaceConsumer *> lexeme pTimeZone <* eof) field content
       return r
-    parseDelay :: Field -> ReaderT TimeCtx m Delay
-    parseDelay (OptionalField field content) = either throwError return =<< runParserT (Until <$> pTimeSpec) () field content
+    parseDelay :: Field -> m (Endo LocalTime)
+    parseDelay (OptionalField field content) = either throwM return =<< runParserT (spaceConsumer *> lexeme pTimeSpec <* eof) field content
+
+localT :: Either TimeZone TZ -> Iso' UTCTime LocalTime
+localT (Left tz) = iso (utcToLocalTime tz) (localTimeToUTC tz)
+localT (Right tz) = iso (utcToLocalTimeTZ tz) (localTimeToUTCTZ tz)
diff --git a/lib/Postdelay/TimeSpec.hs b/lib/Postdelay/TimeSpec.hs
index 676dabf..5c41180 100644
--- a/lib/Postdelay/TimeSpec.hs
+++ b/lib/Postdelay/TimeSpec.hs
@@ -1,335 +1,29 @@
-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns, ConstraintKinds, TupleSections, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns, ConstraintKinds, TupleSections, RecordWildCards, TypeFamilies #-}
 
 module Postdelay.TimeSpec
   ( pTimeSpec
   , pTimeZone
-  , TimeCtx(..)
+  
+  , spaceConsumer, lexeme
   ) where
 
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Reader.Class
-import Control.Monad.Error.Class
+import Postdelay.TimeSpec.Utils
+import Postdelay.TimeSpec.Units
 
-import Text.Parsec.Char hiding (digit)
-import qualified Text.Parsec.Char as Parsec (digit)
-import Text.Parsec.Prim
-import Text.Parsec.Combinator
-import Text.Parsec.Error (ParseError(..))
-import Text.Read (readMaybe)
+import Text.Megaparsec
+
+import Control.Monad.IO.Class
+import Control.Applicative
 
-import Data.CaseInsensitive (CI)
-import qualified Data.CaseInsensitive as CI
+import Data.Semigroup
+import Data.Monoid (Endo(..))
 
 import Data.Time
-import Data.Time.Calendar.WeekDate
 import Data.Time.Zones
-import Data.Function
-import Data.Maybe
-import Data.Foldable
-import Data.Ord
-import Data.List
-import Data.Tuple
-import Data.Bool
-
-import Control.Exception (IOException)
-
-import Debug.Trace
-
-
-type MonadTP m = (MonadIO m, MonadReader TimeCtx m)
-
-data TimeCtx = TimeCtx
-               { baseTime :: UTCTime
-               , tz :: Either TimeZone TZ
-               }
-
-
-spaced :: Stream s m Char => ParsecT s u m a -> ParsecT s u m a
-spaced p = spaces *> p <* spaces
-
-string' :: Stream s m Char => String -> ParsecT s u m String
-string' = mapM $ satisfy . ((==) `on` CI.mk)
-
-choice' :: (Stream s m t, Foldable f) => f (ParsecT s u m a) -> ParsecT s u m a
-choice' (toList -> f)
-  | [p]    <- f = p
-  | (p:ps) <- f = try p <|> choice' ps
-  | otherwise   = mzero
-
-strChoice' :: Stream s m Char => [String] -> ParsecT s u m String
-strChoice' = choice' . map string' . sortBy (comparing $ Down . length)
-
-natural :: (Stream s m Char, Num a) => ParsecT s u m a
-natural = foldl' (\init last -> init * 10 + last) 0 <$> many1 digit
-
-decimal :: (Stream s m Char, Num a, Fractional a) => ParsecT s u m a
-decimal = do
-  w <- foldl' (\init last -> init * 10 + last) 0 <$> many1 digit
-  f <- option 0 $ do
-    char '.'
-    foldr' (\head tail -> head + tail / 10) 0 <$> many1 digit
-  return $ w + f / 10
-  
-digit :: (Stream s m Char, Num a) => ParsecT s u m a
-digit = fromIntegral . (\c -> fromEnum c - fromEnum '0') <$> Parsec.digit
-
-ensure :: MonadPlus m => (a -> Bool) -> a -> m a
-ensure p x = bool (const mzero) return (p x) $ x
-
-
-pTimeSpec :: MonadTP m => ParsecT String () m UTCTime
-pTimeSpec = choice' [ flip addUTCTime <$> spaced pSpecBase <*> spaced pSpecOffset <?> "Absolute time + offset"
-                    , flip addUTCTime <$> asks baseTime <*> spaced pSpecOffset <?> "Time offset"
-                    , spaced pSpecBase <?> "Absolute time"
-                    ]
-            <* eof <?> "Time specification"
-
-pSpecBase :: forall m. MonadTP m => ParsecT String () m UTCTime
-pSpecBase = choice'
-  [ utcTime <$> spaced pDate <*> spaced pTime
-  , flip utcTime <$> spaced pTime <*> spaced pDate
-  , do
-      proto@(UTCTime{..}) <- utcTime <$> (utctDay <$> asks baseTime) <*> spaced pTime
-      now <- asks baseTime
-      return $ if proto < now
-               then UTCTime (succ utctDay) utctDayTime
-               else proto
-  , utcTime <$> spaced pDate <*> ((dayFractionToTimeOfDay 0, ) <$> asks tz) 
-  , spaced (string' "now") *> asks baseTime
-  ] <?> "Base specification"
-  where
-    utcTime :: Day -> (TimeOfDay, Either TimeZone TZ) -> UTCTime
-    utcTime d (t, Right tz) = localTimeToUTCTZ tz (LocalTime d t)
-    utcTime d (t, Left  tz) = localTimeToUTC   tz (LocalTime d t)
-
-pSpecOffset :: MonadTP m => ParsecT String () m NominalDiffTime
-pSpecOffset = (+) <$> pSpecOffset' <*> option 0 (try (many $ space <|> char ',' <|> char ';') >> pSpecOffset)
-  where
-    pSpecOffset' = option id (spaced pSign) <*> ((*) <$> spaced pNumber <*> spaced pSpecOffsetConst) <?> "Time offset"
-    pNumber = fromInteger <$> natural <?> "Offset multiplier"
-
-pSign :: MonadTP m => ParsecT String () m (NominalDiffTime -> NominalDiffTime)
-pSign = choice [ id     <$ char '+'
-               , negate <$ char '-'
-               ] <?> "Offset sign"
-
-pSpecOffsetConst :: MonadTP m => ParsecT String () m NominalDiffTime
-pSpecOffsetConst = choice' [ 1e-12           <$ strChoice' [ "ps"
-                                                           , "picosecond"
-                                                           , "picoseconds"
-                                                           ]
-                           , 1e-9            <$ strChoice' [ "ns"
-                                                           , "nanosecond"
-                                                           , "nanoseconds"
-                                                           ]
-                           , 1e-6            <$ strChoice' [ "us", "µs"
-                                                           , "microsecond"
-                                                           , "microseconds"
-                                                           ]
-                           , 1e-3            <$ strChoice' [ "ms"
-                                                           , "millisecond"
-                                                           , "milliseconds"
-                                                           ]
-                           , 1e-2            <$ strChoice' [ "ds"
-                                                           , "decisecond"
-                                                           , "deciseconds"
-                                                           ]
-                           , 1e-1            <$ strChoice' [ "cs"
-                                                           , "centisecond"
-                                                           , "centiseconds"
-                                                           ]
-                           , 1               <$ strChoice' [ "s"
-                                                           , "second"
-                                                           , "seconds"
-                                                           ]
-                           , 60              <$ strChoice' [ "min"
-                                                           , "minute"
-                                                           , "minutes"
-                                                           ]
-                           , 3600            <$ strChoice' [ "h"
-                                                           , "hour"
-                                                           , "hours"
-                                                           ]
-                           , 24 * 3600       <$ strChoice' [ "d"
-                                                           , "day"
-                                                           , "days"
-                                                           ]
-                           , 7 * 24 * 3600   <$ strChoice' [ "week"
-                                                           , "weeks"
-                                                           ]
-                           , 30 * 24 * 3600  <$ strChoice' [ "month"
-                                                           , "months"
-                                                           ]
-                           , 365 * 24 * 3600 <$ strChoice' [ "year"
-                                                           , "years"
-                                                           ]
-                           ] <?> "Offset unit"
-
-pDate :: MonadTP m => ParsecT String () m Day
-pDate = choice' [ do
-                    (m, d) <- choice' [ do
-                                          m <- spaced pMonthName
-                                          d <- spaced natural
-                                          optional . spaced $ char ','
-                                          return (m, d)
-                                      , fmap swap . (,) <$> spaced natural <*> spaced pMonthName
-                                      ]
-                    y <- spaced natural
-                    fromGregorian' y m d
-                , do
-                    now <- asks baseTime
-                    (m, d) <- choice' [ (,) <$> spaced pMonthName <*> spaced natural
-                                      , fmap swap . (,) <$> spaced natural <*> spaced pMonthName
-                                      ]
-                    let
-                      (y, _, _) = toGregorian $ utctDay now
-                    proto <- fromGregorian' y m d
-                    if proto < utctDay now
-                      then fromGregorian' (y + 1) m d
-                      else return proto
-                , do
-                    now <- asks baseTime
-                    optional $ spaces *> pNext <* many1 space
-                    d <- spaced pWeekdayName
-                    let
-                      (y, w, _) = toWeekDate $ utctDay now
-                    proto <- fromWeekDate' y w d
-                    if proto < utctDay now
-                      then maybe (fromWeekDate' (y + 1) 1 d) return $ fromWeekDateValid y (w + 1) d
-                      else return proto
-                , do
-                    spaced $ string' "today"
-                    utctDay <$> asks baseTime
-                , do
-                    spaced $ string' "tomorrow"
-                    succ . utctDay <$> asks baseTime
-                , do
-                    y <- natural
-                    char '-'
-                    m <- natural
-                    char '-'
-                    d <- natural
-                    fromGregorian' y m d
-                , do
-                    d <- natural
-                    char '.'
-                    m <- natural
-                    char '.'
-                    y <- natural
-                    fromGregorian' y m d
-                , do
-                    m <- natural
-                    char '/'
-                    d <- natural
-                    char '/'
-                    y <- natural
-                    fromGregorian' y m d
-                , do
-                    ds <- many1 digit
-                    when (length ds < 5) $ fail "Insufficient digits to interpret as concatenated date"
-                    let
-                      d2 : d1 : m2 : m1 : ys = reverse ds
-                      d = 10 * d1 + d2
-                      m = 10 * m1 + m2
-                      y = foldl' (\init last -> init * 10 + last) 0 . map fromIntegral $ reverse ys
-                    fromGregorian' y m d
-                , do
-                    pNext
-                    many1 space
-                    fmap utctDay . addUTCTime <$> pSpecOffsetConst <*> asks baseTime
-               ] <?> "Day specification"
-  where
-    fromGregorian' y m d = maybe (fail "Invalid gregorian date") return $ fromGregorianValid y m d
-    fromWeekDate' y w d = maybe (fail "Invalid iso8601 date") return $ fromWeekDateValid y w d
-    pNext = string' "next"
-
-pMonthName :: MonadTP m => ParsecT String () m Int
-pMonthName = choice' (zipWith (<$) [1..] [ strChoice' [ "January", "Jan" ]
-                                         , strChoice' [ "Febuary", "Feb" ]
-                                         , strChoice' [ "March", "Mar" ]
-                                         , strChoice' [ "April", "Apr" ]
-                                         , strChoice' [ "May" ]
-                                         , strChoice' [ "June", "Jun" ]
-                                         , strChoice' [ "July", "Jul" ]
-                                         , strChoice' [ "August", "Aug" ]
-                                         , strChoice' [ "September", "Sep" ]
-                                         , strChoice' [ "October", "Oct" ]
-                                         , strChoice' [ "November", "Nov" ]
-                                         , strChoice' [ "December", "Dec" ]
-                                         ]) <?> "Month name"
-
-pWeekdayName :: MonadTP m => ParsecT String () m Int
-pWeekdayName = choice' (zipWith (<$) [1..] [ strChoice' [ "Monday", "Mon" ]
-                                           , strChoice' [ "Tuesday", "Tue" ]
-                                           , strChoice' [ "Wednesday", "Wed" ]
-                                           , strChoice' [ "Thursday", "Thu" ]
-                                           , strChoice' [ "Friday", "Fri" ]
-                                           , strChoice' [ "Saturday", "Sat" ]
-                                           , strChoice' [ "Sunday", "Sun" ]
-                                           ])
-
-pTime :: MonadTP m => ParsecT String () m (TimeOfDay, Either TimeZone TZ)
-pTime = choice' [ (,) <$> spaced pTimeBase <*> spaced pTimeZone
-                , (,) <$> spaced pTimeBase <*> asks tz
-                ] <?> "Time of day and timezone specification"
-
-data AMPM = AM | PM
-  deriving (Eq, Ord, Enum)
 
-pTimeBase :: MonadTP m => ParsecT String () m TimeOfDay
-pTimeBase = choice' [ do
-                        h <- pHour12
-                        m <- option 0 $ char ':' >> pMinute
-                        s <- option 0 $ char ':' >> pSecond
-                        amPM <- spaced pAMPM
-                        let h' = h + fromEnum amPM * 12
-                        return $ TimeOfDay h' m s
-                    , do
-                        h <- pHour
-                        m <- option 0 $ char ':' >> pMinute
-                        s <- option 0 $ char ':' >> pSecond
-                        return $ TimeOfDay h m s
-                    , do
-                        h <- ensure (<= 24) =<< (\d u -> 10 * d + u) <$> digit <*> digit
-                        m <- option 0 $ ensure (< 60) =<< (\d u -> 10 * d + u) <$> digit <*> digit
-                        s <- option 0 $ pSecond
-                        return $ TimeOfDay h m s
-                    , TimeOfDay 0 0 0 <$ string' "midnight"
-                    , TimeOfDay 12 0 0 <$ string' "noon"
-                    , TimeOfDay 16 0 0 <$ string' "teatime"
-                    ] <?> "Time of day specification"
-  where
-    pAMPM = choice [ AM <$ string' "AM"
-                   , PM <$ string' "PM"
-                   ]
-    pHour12 = (`rem` 12) <$> (ensure (<= 12) =<< natural)
 
-    pHour = (`rem` 24) <$> (ensure (<= 24) =<< natural)
-    pMinute = ensure (< 60) =<< natural
-    pSecond = decimal
+pTimeSpec :: StringParser s m => m (Endo LocalTime)
+pTimeSpec = empty
 
-pTimeZone :: MonadIO m => ParsecT String () m (Either TimeZone TZ)
-pTimeZone = choice' [ do
-                        sgn <- choice [ id <$ char '+'
-                                      , negate <$ char '-'
-                                      ]
-                        hs <- (\d u -> 10 * d + u) <$> digit <*> digit
-                        ms <- option 0 $ (\d u -> 10 * d + u) <$> digit <*> digit
-                        return . Left . minutesToTimeZone $ hs * 60 + ms
-                    , do
-                        let
-                          ident = (++) <$> many1 alphaNum <*> option "" ((:) <$> oneOf "_-/.+" <*> ident)
-                        n <- ident
-                        tz <- liftIO $ do
-                          let
-                            fbHandler :: IO a -> (IOException -> IO a)
-                            fbHandler fb _ = fb
-                          foldl (\fb a -> a `catchError` fbHandler fb) (return Nothing)
-                            [ Just <$> loadSystemTZ n
-                            , Just <$> loadTZFromDB n
-                            ]
-                        case tz of
-                          Nothing   -> fail $ "Could not resolve timezone: " ++ n
-                          (Just tz) -> return $ Right tz
-                    ]
+pTimeZone :: (StringParser s m, MonadIO m) => m (Either TimeZone TZ)
+pTimeZone = empty
diff --git a/lib/Postdelay/TimeSpec/Units.hs b/lib/Postdelay/TimeSpec/Units.hs
new file mode 100644
index 0000000..330997a
--- /dev/null
+++ b/lib/Postdelay/TimeSpec/Units.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, RankNTypes, DataKinds, ViewPatterns, ScopedTypeVariables #-}
+
+module Postdelay.TimeSpec.Units
+  ( Time
+  
+  , Second, Minute, Hour
+  , Day, Week, Month, Year
+
+  , timeLength
+
+  , module Data.Units.SI.Prefixes
+  ) where
+
+import Postdelay.TimeSpec.Utils
+
+import Control.Applicative
+
+import Data.Metrology
+import Data.Metrology.TH
+import Data.Metrology.SI.Mono ()
+
+import Data.Units.SI
+import Data.Units.SI.Prefixes
+import Data.Units.SI.Parser
+import qualified Data.Dimensions.SI as D
+
+import Data.Foldable
+import Data.Function
+import Data.VectorSpace
+
+import Data.Fixed (Fixed, HasResolution)
+import qualified Data.Fixed as Fixed
+
+
+import Text.Megaparsec
+  
+
+declareDerivedUnit "Day"   [t| Hour |] 24     Nothing
+declareDerivedUnit "Week"  [t| Day  |] 7      Nothing
+declareDerivedUnit "Month" [t| Day  |] 30     Nothing
+declareDerivedUnit "Year"  [t| Day  |] 365.25 Nothing
+
+type Time = MkQu_DLN D.Time DefaultLCSU Fixed.Pico
+
+data Prefix where
+  Prefix :: forall p. (UnitPrefix p, Show p) => p -> Prefix
+
+instance HasResolution p => AdditiveGroup (Fixed p) where
+  zeroV = 0
+  (^+^) = (+)
+  negateV = negate
+  (^-^) = (-)
+
+instance HasResolution p => VectorSpace (Fixed p) where
+  type Scalar (Fixed p) = Fixed p
+  (*^) = (*)
+
+
+timeLength :: StringParser s m => m Time
+timeLength = (*^) <$> lexeme rational <*> timeUnit
+
+rational :: forall s m n. (StringParser s m, Fractional n, Num n) => m n
+rational = combine <$> some digitChar <*> option [] (char '.' *> many digitChar)
+  where
+    combine :: [Char] -> [Char] -> n
+    combine (map asN -> whole) (map asN -> fractional)
+      = foldl' (\i l -> i * 10 + l) 0 whole + (foldr' (\h t -> h + t / 10) 0 fractional) / 10
+    asN :: Char -> n
+    asN c = fromIntegral $ ((-) `on` fromEnum) c '0'
+
+timeUnit :: StringParser s m => m Time
+timeUnit = label "Unit of time" . choice $
+           [ 1 % Second <$ choice [ string' "seconds"
+                                  , string' "second"
+                                  , string' "secs"
+                                  , string' "sec"
+                                  ]
+           , 1 % Minute <$ choice [ string' "minutes"
+                                  , string' "minute"
+                                  , string' "mins"
+                                  , string' "min"
+                                  ]
+           , 1 % Hour   <$ choice [ string' "hours"
+                                  , string' "hour"
+                                  ]
+           , 1 % Day    <$ choice [ string' "days"
+                                  , string' "day"
+                                  ]
+           , 1 % Week   <$ choice [ string' "weeks"
+                                  , string' "week"
+                                  ]
+           , 1 % Month  <$ choice [ string' "months"
+                                  , string' "month"
+                                  ]
+           , 1 % Year   <$ choice [ string' "years"
+                                  , string' "year"
+                                  ]
+           ] ++
+           [ (% Second) <$> option 1 siPrefix <* string "s"
+           , (% Hour) <$> option 1 siPrefix <* string "h"
+           , (% Day) <$> option 1 siPrefix <* string "d"
+           , (% Year) <$> option 1 siPrefix <* choice [ string "a", string "yr", string "yrs" ]
+           ]
+
+siPrefix :: (StringParser s m, Fractional n) => m n
+siPrefix = label "SI prefix" . choice $ map (\(Prefix p) -> multiplier p <$ string (show p))
+           [ Prefix Deca, Prefix Hecto, Prefix Kilo, Prefix Mega, Prefix Giga
+           , Prefix Tera, Prefix Peta, Prefix Exa, Prefix Zetta, Prefix Yotta
+           , Prefix Deci, Prefix Centi, Prefix Milli, Prefix Micro, Prefix Nano
+           , Prefix Pico, Prefix Femto, Prefix Atto, Prefix Zepto, Prefix Yocto
+           ]
diff --git a/lib/Postdelay/TimeSpec/Utils.hs b/lib/Postdelay/TimeSpec/Utils.hs
new file mode 100644
index 0000000..e4ba732
--- /dev/null
+++ b/lib/Postdelay/TimeSpec/Utils.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE RankNTypes, ConstraintKinds, TypeFamilies, FlexibleContexts, ScopedTypeVariables, ViewPatterns #-}
+
+module Postdelay.TimeSpec.Utils where
+
+import Control.Applicative
+import Control.Monad
+import Control.Lens
+
+import Data.Time
+import Data.Time.Zones
+
+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 :: StringParser s m => m ()
+spaceConsumer = L.space (void spaceChar) empty empty
+
+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 = choice [ id <$ char '+'
+              , negateV <$ char '-'
+              ]
diff --git a/lib/Postdelay/Utils.hs b/lib/Postdelay/Utils.hs
deleted file mode 100644
index d716b4d..0000000
--- a/lib/Postdelay/Utils.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-
-module Postdelay.Utils
-  ( hoistParsecT
-  ) where
-
-import Control.Monad.Error.Class
-
-import Data.Functor
-import Data.Either
-
-import Data.Functor.Identity
-import Text.Parsec.Prim
-import Text.Parsec.Error
-
-hoistParsecT :: (Monad m, Stream s Identity t, Stream s m t) => ParsecT s u Identity a -> ParsecT s u m a
-hoistParsecT p = do
-  st <- getParserState
-  let res = runParser p' undefined "" undefined
-      p' = setParserState st >> ((,) <$> getState <*> p)
-  either (fail . show) (\(st', res) -> putState st' $> res) $ res