From c3bec2a3de7931db0f8c467a92295d4dc0e896cb Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 27 Nov 2008 06:48:46 +0000
Subject: [PATCH] options cleanup

---
 Ledger/Dates.hs | 11 ++++----
 Options.hs      | 74 ++++++-------------------------------------------
 2 files changed, 15 insertions(+), 70 deletions(-)

diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs
index c2fb3909e..b9943ca47 100644
--- a/Ledger/Dates.hs
+++ b/Ledger/Dates.hs
@@ -53,8 +53,10 @@ elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
 dayToUTC :: Day -> UTCTime
 dayToUTC d = localTimeToUTC utc (LocalTime d midnight)
 
--- | Convert a smart date string to a date span using the provided date as
--- reference point.
+-- | Convert a period expression to a date span using the provided reference date.
+spanFromPeriodExpr refdate = spanFromSmartDateString refdate
+
+-- | Convert a smart date string to a date span using the provided reference date.
 spanFromSmartDateString :: Day -> String -> DateSpan
 spanFromSmartDateString refdate s = DateSpan (Just b) (Just e)
     where
@@ -88,15 +90,14 @@ spanFromSmartDateString refdate s = DateSpan (Just b) (Just e)
       span (y,m,d)               = (day, nextday day) where day = fromGregorian (read y) (read m) (read d)
 
 -- | Convert a smart date string to an explicit yyyy/mm/dd string using
--- the provided date as reference point.
+-- 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 $ map toLower s
 
--- | Convert a SmartDate to an absolute date using the provided date as
--- reference point.
+-- | Convert a SmartDate to an absolute date using the provided reference date.
 fixSmartDate :: Day -> SmartDate -> Day
 fixSmartDate refdate sdate = fix sdate
     where
diff --git a/Options.hs b/Options.hs
index da6ea6c9f..dea2bf7b5 100644
--- a/Options.hs
+++ b/Options.hs
@@ -126,76 +126,26 @@ dateSpanFromOpts refdate opts
       parse s = parsedate $ printf "%04s/%02s/%02s" y m d
           where (y,m,d) = fromparse $ parsewith smartdate $ s
 
-spanFromPeriodExpr refdate = spanFromSmartDateString refdate
-
--- | Get the value of the begin date option, if any.
-beginDateFromOpts :: [Opt] -> Maybe Day
-beginDateFromOpts opts =
-    if null beginopts 
-    then Nothing
-    else Just $ parsedate $ printf "%04s/%02s/%02s" y m d
-    where
-      beginopts = concatMap getbegindate opts
-      getbegindate (Begin s) = [s]
-      getbegindate _ = []
-      defaultdate = ""
-      (y,m,d) = fromparse $ parsewith smartdate $ last beginopts
-
--- | Get the value of the end date option, if any.
-endDateFromOpts :: [Opt] -> Maybe Day
-endDateFromOpts opts =
-    if null endopts 
-    then Nothing
-    else Just $ parsedate $ printf "%04s/%02s/%02s" y m d
-    where
-      endopts = concatMap getenddate opts
-      getenddate (End s) = [s]
-      getenddate _ = []
-      defaultdate = ""
-      (y,m,d) = fromparse $ parsewith smartdate $ last endopts
-
--- | Get the value of the period option, if any.
-periodFromOpts :: [Opt] -> Maybe String
-periodFromOpts opts =
-    if null periodopts 
-    then Nothing
-    else Just $ head periodopts
-    where
-      periodopts = concatMap getperiod opts
-      getperiod (Period s) = [s]
-      getperiod _ = []
-
--- | Get the value of the depth option, if any.
+-- | Get the value of the (first) depth option, if any.
 depthFromOpts :: [Opt] -> Maybe Int
-depthFromOpts opts =
-    case depthopts of
-      (x:_) -> Just $ read x
-      _     -> Nothing
+depthFromOpts opts = listtomaybeint $ optValuesForConstructor Depth opts
     where
-      depthopts = concatMap getdepth opts
-      getdepth (Depth s) = [s]
-      getdepth _ = []
+      listtomaybeint [] = Nothing
+      listtomaybeint vs = Just $ read $ head vs
 
--- | Get the value of the display option, if any.
+-- | Get the value of the (first) display option, if any.
 displayFromOpts :: [Opt] -> Maybe String
-displayFromOpts opts =
-    case displayopts of
-      (s:_) -> Just s
-      _     -> Nothing
+displayFromOpts opts = listtomaybe $ optValuesForConstructor Display opts
     where
-      displayopts = concatMap getdisplay opts
-      getdisplay (Display s) = [s]
-      getdisplay _ = []
+      listtomaybe [] = Nothing
+      listtomaybe vs = Just $ head vs
 
 -- | Get the ledger file path from options, an environment variable, or a default
 ledgerFilePathFromOpts :: [Opt] -> IO String
 ledgerFilePathFromOpts opts = do
   envordefault <- getEnv fileenvvar `catch` \_ -> return defaultfile
-  paths <- mapM tildeExpand $ [envordefault] ++ (concatMap getfile opts)
+  paths <- mapM tildeExpand $ [envordefault] ++ optValuesForConstructor File opts
   return $ last paths
-    where
-      getfile (File s) = [s]
-      getfile _ = []
 
 -- | Expand ~ in a file path (does not handle ~name).
 tildeExpand :: FilePath -> IO FilePath
@@ -221,9 +171,3 @@ parseAccountDescriptionArgs opts args = (as, ds')
           negchar
               | OptionsAnywhere `elem` opts = '^'
               | otherwise = '-'
-
-testoptions order cmdline = putStr $ 
-    case getOpt order options cmdline of
-      (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n
-      (o,_,errs) -> concat errs ++ usage
-