2 files changed, 32 insertions, 18 deletions

diff --git a/lib/Postdelay/TimeSpec/Units.hs b/lib/Postdelay/TimeSpec/Units.hs
index 330997a..0062460 100644
--- a/lib/Postdelay/TimeSpec/Units.hs
+++ b/lib/Postdelay/TimeSpec/Units.hs
@@ -1,19 +1,21 @@
-{-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, RankNTypes, DataKinds, ViewPatterns, ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell, GADTs, RankNTypes, DataKinds, ViewPatterns, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, UndecidableInstances, TypeFamilies #-}
 
 module Postdelay.TimeSpec.Units
   ( Time
   
-  , Second, Minute, Hour
-  , Day, Week, Month, Year
+  , Second(..), Minute(..), Hour(..)
+  , Day(..), Week(..), Month(..), Year(..)
 
   , timeLength
 
+  , module Data.Metrology
   , module Data.Units.SI.Prefixes
   ) where
 
 import Postdelay.TimeSpec.Utils
 
 import Control.Applicative
+import Control.Monad
 
 import Data.Metrology
 import Data.Metrology.TH
@@ -42,9 +44,6 @@ 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
   (^+^) = (+)
@@ -57,16 +56,16 @@ instance HasResolution p => VectorSpace (Fixed p) where
 
 
 timeLength :: StringParser s m => m Time
-timeLength = (*^) <$> lexeme rational <*> timeUnit
+timeLength = (*^) <$> lexeme rational <*> timeUnit <?> "Length of time"
 
 rational :: forall s m n. (StringParser s m, Fractional n, Num n) => m n
-rational = combine <$> some digitChar <*> option [] (char '.' *> many digitChar)
+rational = combine <$> some digitChar <*> option [] (char '.' *> many digitChar) <?> "Decimal number"
   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'
+    asN c = fromIntegral $ fromEnum c - fromEnum '0'
 
 timeUnit :: StringParser s m => m Time
 timeUnit = label "Unit of time" . choice $
@@ -95,15 +94,28 @@ timeUnit = label "Unit of time" . choice $
            , 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" ]
+           , option 1 siPrefix <**> choice [ (% Second) <$ string "s"
+                                           , (% Hour  ) <$ string "h"
+                                           , (% Day   ) <$ string "d"
+                                           , (% Year  ) <$ choice [ string "a", string' "yr", string' "yrs" ]
+                                           ]
            ]
 
+
+data Prefix where
+  Prefix :: forall p. ParseablePrefix p => p -> Prefix
+
+class UnitPrefix a => ParseablePrefix a where
+  parser :: StringParser s m => a -> m ()
+
+instance {-# OVERLAPPABLE #-} (UnitPrefix a, Show a) => ParseablePrefix a where
+  parser = void . string . show
+
+instance ParseablePrefix Micro where
+  parser _ = void $ choice [ string "µ", string "u" ]
+
 siPrefix :: (StringParser s m, Fractional n) => m n
-siPrefix = label "SI prefix" . choice $ map (\(Prefix p) -> multiplier p <$ string (show p))
+siPrefix = label "SI prefix" . choice $ map (\(Prefix p) -> multiplier p <$ parser 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
diff --git a/lib/Postdelay/TimeSpec/Utils.hs b/lib/Postdelay/TimeSpec/Utils.hs
index e4ba732..85ac299 100644
--- a/lib/Postdelay/TimeSpec/Utils.hs
+++ b/lib/Postdelay/TimeSpec/Utils.hs
@@ -7,8 +7,10 @@ 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
@@ -30,6 +32,6 @@ signed = (<*>) (lexeme sign)
 optSigned = (<*>) (option id $ lexeme sign)
 
 sign :: (StringParser s m, AdditiveGroup n) => m (n -> n)
-sign = choice [ id <$ char '+'
-              , negateV <$ char '-'
-              ]
+sign = label "sign" $ choice [ char '+' $> id
+                             , char '-' $> negateV
+                             ]