refactor

Commands/Web.hs

@@ -45,7 +45,6 @@ import Commands.Histogram
 import Commands.Print
 import Commands.Register
 import Ledger
-import Ledger.IO (readLedger)
 import Options hiding (value)
 #ifdef MAKE
 import Paths_hledger_make (getDataFileName)

hledger-lib/Ledger/Dates.hs

@@ -117,13 +117,19 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
       span (y,m,"")              = (startofmonth day, nextmonth day) where day = fromGregorian (read y) (read m) 1
       span (y,m,d)               = (day, nextday day) where day = fromGregorian (read y) (read m) (read d)
 
+showDay :: Day -> String
+showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day
+
 -- | Convert a smart date string to an explicit yyyy\/mm\/dd string using
 -- the provided reference date.
 fixSmartDateStr :: Day -> String -> String
-fixSmartDateStr t s = printf "%04d/%02d/%02d" y m d
-    where
-      (y,m,d) = toGregorian $ fixSmartDate t sdate
-      sdate = fromparse $ parsewith smartdate $ lowercase s
+fixSmartDateStr t s = either parseerror id $ fixSmartDateStrEither t s
+
+-- | A safe version of fixSmartDateStr.
+fixSmartDateStrEither :: Day -> String -> Either ParseError String
+fixSmartDateStrEither t s = case parsewith smartdate (lowercase s) of
+                              Right sd -> Right $ showDay $ fixSmartDate t sd
+                              Left e -> Left e
 
 -- | Convert a SmartDate to an absolute date using the provided reference date.
 fixSmartDate :: Day -> SmartDate -> Day

hledger-lib/Ledger/Utils.hs

@@ -248,7 +248,13 @@ parseWithCtx :: b -> GenParser Char b a -> String -> Either ParseError a
 parseWithCtx ctx p = runParser p ctx ""
 
 fromparse :: Either ParseError a -> a
-fromparse = either (\e -> error $ "parse error at "++ show e) id
+fromparse = either parseerror id
+
+parseerror e = error $ showParseError e
+
+showParseError e = "parse error at " ++ show e
+
+showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e)
 
 nonspace :: GenParser Char st Char
 nonspace = satisfy (not . isSpace)