diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013, Omari Norman
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Omari Norman nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/dapi.cabal b/dapi.cabal
new file mode 100644
--- /dev/null
+++ b/dapi.cabal
@@ -0,0 +1,41 @@
+-- Initial dapi.cabal generated by cabal init.  For further documentation, 
+-- see http://haskell.org/cabal/users-guide/
+
+name:                dapi
+version:             0.2.0.0
+synopsis:            Prints a series of dates
+description:
+  dapi prints a series of dates to the console. You can filter the
+  dates based on multiple criteria, such as day of the week, day,
+  month, and more. Slightly more information is at the homepage link
+  given below.
+
+homepage:            http://massysett.github.com/dapi
+license:             BSD3
+license-file:        LICENSE
+author:              Omari Norman
+maintainer:          omari@smileystation.com
+copyright:           2013 Omari Norman
+category:            Console
+build-type:          Simple
+cabal-version:       >=1.8
+
+source-repository head
+    type: git
+    location: git://github.com/massysett/dapi.git
+
+executable dapi
+  main-is: dapi.hs
+  ghc-options: -Wall
+  build-depends:
+      base ==4.6.*
+    , parsec == 3.1.*
+    , text ==0.11.*
+    , containers ==0.5.*
+    , transformers ==0.3.*
+    , time ==1.4.*
+    , explicit-exception ==0.1.*
+    , prednote ==0.6.*
+    , multiarg ==0.12.*
+    , old-locale ==1.0.*
+    , rainbow ==0.2.*
diff --git a/dapi.hs b/dapi.hs
new file mode 100644
--- /dev/null
+++ b/dapi.hs
@@ -0,0 +1,1139 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import Control.Applicative
+  ( many, (<$), (<|>), some, (<$>),
+    (<*>), (<*), optional )
+
+import Control.Monad (guard, (>=>), when)
+import qualified Control.Monad.Exception.Synchronous as Ex
+import qualified Data.Time as T
+import Data.Time.Calendar.WeekDate (toWeekDate)
+import Data.Functor.Identity (Identity)
+import Data.Char (toLower)
+import Data.Either (partitionEithers)
+import Data.List (foldl', unfoldr)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (mconcat)
+import qualified Data.Text as X
+import Data.Text (Text)
+import qualified Data.Prednote.Expressions as Exp
+import qualified Data.Prednote.Pdct as Pd
+import Data.Prednote.Pdct ((|||))
+import Text.Parsec (char)
+import qualified Text.Parsec as P
+import Text.Parsec ((<?>))
+import qualified System.Console.MultiArg as MA
+import qualified System.IO as IO
+import qualified System.Exit as Exit
+import qualified System.Console.Rainbow as R
+import System.Locale (defaultTimeLocale)
+
+------------------------------------------------------------
+------------------------------------------------------------
+-- BEGIN CONFIGURABLE OPTIONS
+------------------------------------------------------------
+------------------------------------------------------------
+
+-- | Put the options you would like to use by default in this record.
+myOpts :: Opts
+myOpts = Opts
+  { oWeekStart = Sun
+  , oBase = False
+  , oFormat = "%Y-%m-%d"
+  , oExprDesc = Exp.RPN
+  , oShowExpression = False
+  , oVerboseFilter = False
+  , oColorToFile = False
+  }
+
+
+-- | How much to indent each level when verbosely evaluating which
+-- days to include.
+indentAmt :: Int
+indentAmt = 2
+
+-- | What indentation level to start at when verbosely evaluating
+-- which days to include.
+startLvl :: Int
+startLvl = 0
+
+------------------------------------------------------------
+-- END Configurable Options
+------------------------------------------------------------
+
+help :: String -> String
+help pn = unlines
+  [ "usage: " ++ pn ++ " [options] RANGE..."
+  , ""
+  , "Options:"
+  , ""
+  , "--current, -C DATE_SPEC"
+  , "  Set current date, used for relative dates"
+  , "--week-start, -W DAY_OF_WEEK"
+  , "  The first day of the week is the specified day"
+  , "--format, -F FORMAT_SRING"
+  , "  Formats dates, see strftime(3)"
+  , "--base0"
+  , "  Centuries, decades, and millennia begin with years that end in 0"
+  , "--base1"
+  , "  Centuries, decades, and millennia begin with years that end in 1"
+  , ""
+  , "--infix, -I - use infix operators"
+  , "--rpn, -R - use RPN operators"
+  , ""
+  , "--show-expression, -S - show filtering expression (toggle)"
+  , "--verbose-filter, -V - filter days verbosely (toggle)"
+  , "--color-to-file, -T - use colors when stdout is not a terminal"
+  , "                  (toggle)"
+  , ""
+  , "Predicates:"
+  , "  relative dates are interpreted relative to the current date"
+  , ""
+  , "--date, -t COMPARER DATE_SPEC"
+  , "  date falls in this range"
+  , "--weekday, -w COMPARER DAY_OF_WEEK"
+  , "  day of week falls in this range"
+  , "--day, -d COMPARER DAY_OR_LAST"
+  , "  day falls in given range"
+  , "--year, -y COMPARER YEAR"
+  , "  year falls in given range"
+  , "--month, m COMPARER MONTH"
+  , "  month falls in given range"
+  , "--ends, -e"
+  , "  first or last day"
+  , "--first, -f"
+  , "  First day"
+  , "--last, -l"
+  , "  Last day (may predate first day)"
+  , "--count, -c DIGITS"
+  , "  every nth day (index of day modulus the given number"
+  , "  equals zero)"
+  , ""
+  , "Operators"
+  , "--and, -a, --or, -o, --not, -n"
+  , "--open, -(, --close, -) - open or close parenthesis"
+  , "  (error with RPN)"
+  ]
+
+
+newtype Lower = Lower String
+  deriving (Show, Eq)
+
+instance Monad m => P.Stream Lower m Char where
+  uncons (Lower x) = return $ case x of
+    [] -> Nothing
+    c:xs -> Just (toLower c, Lower xs)
+
+type Parser = P.ParsecT Lower () Identity
+
+matchDayOfWeek :: String -> Maybe DayOfWeek
+matchDayOfWeek s = lookup s
+  [ ("sun", Sun), ("mon", Mon), ("tue", Tue)
+  , ("wed", Wed), ("thu", Thu)
+  , ("fri", Fri), ("sat", Sat) ]
+
+--
+-- Date types - beginning with most primitive
+--
+
+data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
+  deriving (Eq, Show)
+
+digitToInt :: Integral i => Digit -> i
+digitToInt d = case d of
+  { D0 -> 0; D1 -> 1; D2 -> 2; D3 -> 3; D4 -> 4; D5 -> 5;
+    D6 -> 6; D7 -> 7; D8 -> 8; D9 -> 9 }
+
+digitsToInt :: Integral i => [Digit] -> i
+digitsToInt = foldl' f 0 . zip [ (0 :: Int) ..] . reverse
+  where
+    f tot (places, d) = tot + ((10 ^ places) * digitToInt d)
+
+data Day = Day [Digit]
+  deriving (Eq, Show)
+
+data Sign
+  = Plus
+  | Minus
+  deriving (Eq, Show)
+
+data Month = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep
+  | Oct | Nov | Dec
+  deriving (Eq, Show, Ord, Enum, Bounded)
+
+data AbsYear = AbsYear [Digit]
+  deriving (Eq, Show)
+
+data LastDay = LastDay
+  deriving (Eq, Show)
+
+data DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat
+  deriving (Eq, Show, Ord, Enum, Bounded)
+
+-- | The command line can contain dates or, alternatively, a single
+-- range. A DateSpec represents one of the two dates if the user chose
+-- to use dates.
+data DateSpec = DateSpec (Either Absolute Relative)
+  deriving (Eq, Show)
+
+dayDateSpec
+  :: DayOfWeek -> T.Day -> DateSpec -> Maybe T.Day
+dayDateSpec dow d (DateSpec ds) = case ds of
+  Left ab -> dayAbsolute ab
+  Right rel -> Just $ dayRelative dow d rel
+
+--
+-- Absolute dates
+--
+
+data DayOrLast = DayOrLast (Either Day LastDay)
+  deriving (Eq, Show)
+
+-- | A single absolute date. Can be derived without any relative date
+-- information.
+data Absolute = Absolute AbsYear Month DayOrLast
+  deriving (Eq, Show)
+
+dayAbsolute :: Absolute -> Maybe T.Day
+dayAbsolute (Absolute (AbsYear yds) m (DayOrLast dl)) =
+  let yr = digitsToInt yds
+      mo = monthToInt m
+      da = case dl of
+        Left (Day d) -> digitsToInt d
+        Right _ -> T.gregorianMonthLength yr mo
+  in T.fromGregorianValid yr mo da
+
+--
+-- Relative dates
+--
+data ModArith = ModArith Sign [Digit]
+  deriving (Eq, Show)
+
+nModArith :: Integral i => ModArith -> i
+nModArith (ModArith s ds) = flipSign (digitsToInt ds)
+  where
+    flipSign = case s of { Plus -> id; Minus -> negate }
+ 
+data RelDay = Today | Yesterday | Tomorrow
+  deriving (Eq, Show)
+
+relDayToInt :: Integral i => RelDay -> i
+relDayToInt d = case d of
+  Today -> 0
+  Yesterday -> (-1)
+  Tomorrow -> 1
+
+dayRelDay :: RelDay -> T.Day -> T.Day
+dayRelDay r = T.addDays (relDayToInt r)
+
+data RelDayOfWeek = RelDayOfWeek Mod DayOfWeek
+  deriving (Eq, Show)
+
+dayRelDayOfWeek :: DayOfWeek -> T.Day -> RelDayOfWeek -> T.Day
+dayRelDayOfWeek weekStart d (RelDayOfWeek m tgt) =
+  let r = findDayInWeek weekStart tgt d
+  in T.addDays (nMod m * 7) r
+
+
+-- | Given a DayOfWeek indicating the start of a week, a DayOfWeek
+-- indicating the day you want, and a Day, returns the Day that is in
+-- the same week as the given Day and that is in the same week as the
+-- given Day.
+findDayInWeek
+
+  :: DayOfWeek
+  -- ^ The week starts on this day
+
+  -> DayOfWeek
+  -- ^ The day that you want to find
+
+  -> T.Day
+  -- ^ Find the day that is in the same week as this day
+
+  -> T.Day
+
+findDayInWeek start t d =
+  let days = listStartingWith (Proxy :: Proxy DayOfWeek) start
+      idxs = zip days [0..]
+      dowToday = let (_, _, dow) = toWeekDate d
+                 in intToDayOfWeek dow
+      getIdx = fromMaybe (error "findDayInWeek: index not found")
+               . flip lookup idxs
+      idxToday = getIdx dowToday 
+      idxTgt = getIdx t
+      nDays = idxTgt - idxToday
+  in T.addDays nDays d
+          
+
+data Proxy a = Proxy
+
+-- | List all items in an enumeration, starting with the given item.
+listStartingWith
+  :: (Enum a, Bounded a, Eq a)
+  => Proxy a
+  -> a
+  -> [a]
+listStartingWith p s = unfoldr f (l, s)
+  where
+    l = enumLength p
+    f (nLeft, idx) =
+      if nLeft <= 0
+      then Nothing
+      else let nextIdx = if idx == maxBound
+                         then minBound
+                         else succ idx
+           in Just (idx, (nLeft - 1, nextIdx))
+
+
+-- | How many items are in an enum?
+--
+-- > enumLength (Proxy :: Proxy Bool) == 2
+enumLength :: (Enum a, Bounded a) => Proxy a -> Int
+enumLength p = length [ min' p .. max' p ]
+  where
+    min' :: Bounded a => Proxy a -> a
+    min' Proxy = minBound
+    max' :: Bounded a => Proxy a -> a
+    max' Proxy = maxBound
+
+data RelByUnit = RelByUnit ModArith Unit
+  deriving (Eq, Show)
+
+dayRelByUnit :: T.Day -> RelByUnit -> T.Day
+dayRelByUnit d (RelByUnit m s) = modifyDate (Mod (Right m)) s d
+
+data Relative
+  = RRelDay RelDay
+  | RDayOfWeek RelDayOfWeek
+  | RByUnit RelByUnit
+  deriving (Eq, Show)
+
+dayRelative :: DayOfWeek -> T.Day -> Relative -> T.Day
+dayRelative dow d r = case r of
+  RRelDay rd -> dayRelDay rd d
+  RByUnit rr -> dayRelByUnit d rr
+  RDayOfWeek rd -> dayRelDayOfWeek dow d rd
+
+--
+-- Ranges
+--
+
+data Unit
+  = UDay
+  | Week
+  | Month
+  | Year
+  | Decade
+  | Century
+  | Millennium
+  | Quarter
+  deriving (Eq, Show)
+
+weekList
+  :: DayOfWeek
+  -- ^ Week starts on this day
+  -> T.Day
+  -> [T.Day]
+weekList dow d = [ lwr .. upr ]
+  where
+    start = case dow of
+      { Sun -> 7; Mon -> 1; Tue -> 2; Wed -> 3; Thu -> 4;
+        Fri -> 5; Sat -> 6 }
+    (_, _, wd) = toWeekDate d
+    lwrAdj = if start > wd then wd + (7 - start) else wd - start
+    lwr = T.addDays (negate . fromIntegral $ lwrAdj) d
+    upr = T.addDays 6 lwr
+
+monthList :: T.Day -> [T.Day]
+monthList d = [ lwr .. upr ]
+  where
+    (y, m, _) = T.toGregorian d
+    lwr = T.fromGregorian y m 01
+    upr = T.fromGregorian y m (T.gregorianMonthLength y m)
+
+yearList :: T.Day -> [T.Day]
+yearList d = [ lwr .. upr ]
+  where
+    (y, _, _) = T.toGregorian d
+    lwr = T.fromGregorian y 1 1
+    upr = T.fromGregorian y 12 31
+
+type BaseOne = Bool
+
+baseTenRange
+  :: Int
+  -- ^ Exponent to use
+  -> BaseOne -> T.Day -> [T.Day]
+baseTenRange e b d = [ lwr .. upr ]
+  where
+    (y, _, _) = T.toGregorian d
+    (fstYr, lstYr) = inRange b e y
+    lwr = T.fromGregorian fstYr 1 1
+    upr = T.fromGregorian lstYr 12 31
+
+decadeList :: BaseOne -> T.Day -> [T.Day]
+decadeList = baseTenRange 1
+
+centuryList :: BaseOne -> T.Day -> [T.Day]
+centuryList = baseTenRange 2
+
+quarterList
+  :: T.Day
+  -> [T.Day]
+quarterList d =
+  let (by, bm, _) = T.toGregorian d
+      (mFst, mLst) = case () of
+        _ | bm < 4 -> (1, 3)
+          | bm < 7 -> (4, 6)
+          | bm < 10 -> (7, 9)
+          | otherwise -> (10, 12)
+      fstDy = T.fromGregorian by mFst 1
+      lstDy = T.fromGregorian by mLst (T.gregorianMonthLength by mLst)
+  in [fstDy .. lstDy]
+
+millenniumList :: BaseOne -> T.Day -> [T.Day]
+millenniumList = baseTenRange 3
+
+unitToList
+  :: DayOfWeek
+  -> BaseOne
+  -> Unit
+  -> T.Day
+  -> [T.Day]
+unitToList dow b1 r = case r of
+  UDay -> (:[])
+  Week -> weekList dow
+  Month -> monthList
+  Year -> yearList
+  Decade -> decadeList b1
+  Century -> centuryList b1
+  Millennium -> millenniumList b1
+  Quarter -> quarterList
+
+data ModText
+  = This
+  | Next
+  | Last
+  deriving (Eq, Show)
+
+data Mod = Mod (Either ModText ModArith)
+  deriving (Eq, Show)
+
+nMod :: Integral i => Mod -> i
+nMod (Mod m) = case m of
+  Left t -> case t of
+    This -> 0
+    Next -> 1
+    Last -> (-1)
+  Right ma -> nModArith ma
+
+modifyDate :: Mod -> Unit -> T.Day -> T.Day
+modifyDate m r d =
+  let n = nMod m
+  in case r of
+      UDay -> T.addDays n d
+      Week -> T.addDays (n * 7) d
+      Month -> T.addGregorianMonthsClip n d
+      Year -> T.addGregorianYearsClip n d
+      Decade -> T.addGregorianYearsClip (n * 10) d
+      Century -> T.addGregorianYearsClip (n * 100) d
+      Millennium -> T.addGregorianYearsClip (n * 1000) d
+      Quarter -> T.addGregorianMonthsClip (n * 3) d
+
+data ModdedUnit = ModdedUnit Mod UnitOrMonth
+  deriving (Eq, Show)
+
+moddedUnitToList
+  :: DayOfWeek
+  -> BaseOne
+  -> T.Day
+  -- ^ Current day
+  -> ModdedUnit
+  -> [T.Day]
+moddedUnitToList dow b d (ModdedUnit m (UnitOrMonth ei)) =
+  case ei of
+    Left u -> unitToList dow b u (modifyDate m u d)
+    Right mo -> moddedMonthToList d m mo
+
+data UnitOrMonth = UnitOrMonth (Either Unit Month)
+  deriving (Eq, Show)
+
+moddedMonthToList
+  :: T.Day
+  -> Mod
+  -> Month
+  -> [T.Day]
+moddedMonthToList d (Mod md) mo = [ d1 .. d2 ]
+  where
+    monthNum = monthToInt mo
+    (currY, _, _) = T.toGregorian d
+    d1 = T.fromGregorian yr monthNum 1
+    d2 = T.fromGregorian yr monthNum
+                         (T.gregorianMonthLength yr monthNum)
+    yr = case md of
+      Left mt -> case mt of
+        This -> currY
+        Next -> currY + 1
+        Last -> currY - 1
+      Right ma -> currY + (nModArith ma)
+
+data DatedRange = DatedRange DateSpec DateSpec
+  deriving (Eq, Show)
+
+datedRangeToList
+  :: DayOfWeek
+  -> T.Day
+  -> DatedRange
+  -> Ex.Exceptional String [T.Day]
+datedRangeToList dow b (DatedRange a1 a2) = do
+  d1 <- Ex.fromMaybe "invalid first date given" $ dayDateSpec dow b a1
+  d2 <- Ex.fromMaybe "invalid second date given" $ dayDateSpec dow d1 a2
+  return $ unfoldr (calcNextDay d2) d1
+
+data Range
+  = RUnit ModdedUnit
+  | RMonth MonthYear
+  | RYear AbsYear
+  | RDated DatedRange
+  deriving (Eq, Show)
+
+rangeToList
+  :: DayOfWeek
+  -> BaseOne
+  -> T.Day
+  -> Range
+  -> Ex.Exceptional String [T.Day]
+rangeToList dow b1 d r = case r of
+  RUnit u -> return $ moddedUnitToList dow b1 d u
+  RMonth my -> monthYearToList my
+  RYear y -> yearToList y
+  RDated dr -> datedRangeToList dow d dr
+
+data MonthYear = MonthYear Month AbsYear
+  deriving (Eq, Show)
+
+monthYearToList :: MonthYear -> Ex.Exceptional String [T.Day]
+monthYearToList (MonthYear m (AbsYear ds)) =
+  let y = digitsToInt ds
+      mI = monthToInt m
+      err = "Invalid month and year: " ++ show m ++ " " ++ show y
+  in Ex.fromMaybe err $ do
+      d1 <- T.fromGregorianValid y mI 1
+      d2 <- T.fromGregorianValid y mI (T.gregorianMonthLength y mI)
+      return $ [d1 .. d2]
+    
+
+yearToList :: AbsYear -> Ex.Exceptional String [T.Day]
+yearToList (AbsYear ds) =
+  let y = digitsToInt ds
+      err = "Invalid year: " ++ show y
+  in Ex.fromMaybe err $ do
+      d1 <- T.fromGregorianValid y 1 1
+      d2 <- T.fromGregorianValid y 12 31
+      return [d1 .. d2]
+    
+
+--
+-- Parsers
+--
+
+pUnit :: Parser Unit
+pUnit = parseList
+  [ ("day", UDay), ("week", Week), ("month", Month)
+  , ("year", Year)
+  , ("decade", Decade), ("century", Century)
+  , ("millennium", Millennium), ("quarter", Quarter) ]
+
+pModText :: Parser ModText
+pModText = parseList
+  [ ("this", This), ("next", Next), ("last", Last) ]
+
+pSign :: Parser Sign
+pSign = Plus <$ char '+' <|> Minus <$ char '-'
+
+spaces :: Parser ()
+spaces = () <$ many (char ' ')
+
+pDigit :: Parser Digit
+pDigit = f <$> P.digit
+  where
+    f d = case d of
+      { '0' -> D0; '1' -> D1; '2' -> D2; '3' -> D3;
+        '4' -> D4; '5' -> D5; '6' -> D6; '7' -> D7;
+        '8' -> D8; '9' -> D9;
+        _ -> error "pDigit: error: Parsec digit failed" }
+
+pModArith :: Parser ModArith
+pModArith = ModArith <$> pSign <*> some pDigit
+
+pEither :: Parser a -> Parser b -> Parser (Either a b)
+pEither a b = Left <$> a <|> Right <$> b
+
+pMod :: Parser Mod
+pMod = Mod <$> pEither pModText pModArith
+
+-- | Parses a Mod if there is one; otherwise returns This.
+pOptionalMod :: Parser Mod
+pOptionalMod
+  = fmap (fromMaybe (Mod (Left This)))
+  . optional
+  . P.try
+  $ pMod
+
+pModdedUnit :: Parser ModdedUnit
+pModdedUnit
+  = ModdedUnit
+  <$> pOptionalMod
+  <* spaces
+  <*> pUnitOrMonth
+  <* P.eof
+
+pUnitOrMonth :: Parser UnitOrMonth
+pUnitOrMonth = UnitOrMonth <$> pEither pUnit pMonth
+
+pRelDayOfWeek :: Parser RelDayOfWeek
+pRelDayOfWeek
+  = RelDayOfWeek <$> pOptionalMod <* spaces <*> pDayOfWeek
+
+pRelDay :: Parser RelDay
+pRelDay = parseList
+  [ ("today", Today), ("yesterday", Yesterday)
+  , ("tomorrow", Tomorrow) ]
+
+pAbsolute :: Parser Absolute
+pAbsolute = Absolute <$> pAbsYear <* separator <*> pMonth
+            <* separator <*> pDayOrLast
+
+separator :: Parser ()
+separator = () <$ (char '-' <|> char '/')
+
+parseList
+  :: [(String, a)]
+  -> Parser a
+
+parseList = P.choice . map (\(s, x) -> x <$ P.try (P.string s))
+
+pMonthAbbrev :: Parser Month
+pMonthAbbrev = parseList
+  [ ("jan", Jan), ("feb", Feb), ("mar", Mar),
+    ("apr", Apr) , ("may", May), ("jun", Jun), ("jul", Jul),
+    ("aug", Aug) , ("sep", Sep), ("oct", Oct),
+    ("nov", Nov), ("dec", Dec) ]
+
+pDayOfWeek :: Parser DayOfWeek
+pDayOfWeek = parseList
+  [ ("sun", Sun), ("mon", Mon), ("tue", Tue)
+  , ("wed", Wed), ("thu", Thu)
+  , ("fri", Fri), ("sat", Sat) ]
+
+
+
+pMonthFromDigits :: Parser Month
+pMonthFromDigits = some pDigit >>= parseDigits
+  where
+    parseDigits ls = case ls of
+      [] -> error "pMonthFromDigits: some returned an empty list"
+      d1:[] -> fromOneDigit d1
+      d1:d2:[] -> case d1 of
+        D0 -> fromOneDigit d2
+        D1 -> case d2 of
+          D0 -> return Oct
+          D1 -> return Nov
+          D2 -> return Dec
+          _ -> err
+        _ -> err
+      _ -> err
+      where
+        err = fail $ "invalid month: " ++ map digitChar ls
+        fromOneDigit d = case d of
+          { D0 -> err;
+
+            D1 -> return Jan;  D2 -> return Feb;  D3 -> return Mar;
+            D4 -> return Apr;  D5 -> return May;  D6 -> return Jun;
+            D7 -> return Jul;  D8 -> return Aug;  D9 -> return Sep }
+
+digitChar :: Digit -> Char
+digitChar d = case d of
+  { D0 -> '0'; D1 -> '1'; D2 -> '2'; D3 -> '3'; D4 -> '4';
+    D5 -> '5'; D6 -> '6'; D7 -> '7'; D8 -> '8'; D9 -> '9' }
+
+intToDayOfWeek :: Int -> DayOfWeek
+intToDayOfWeek i = case i of
+  { 1 -> Mon; 2 -> Tue; 3 -> Wed; 4 -> Thu; 5 -> Fri;
+    6 -> Sat; 7 -> Sun;
+    _ -> error "intToDayOfWeek: bad int" }
+
+monthToInt :: Month -> Int
+monthToInt m = case m of
+  { Jan -> 1; Feb -> 2; Mar -> 3; Apr -> 4; May -> 5; Jun -> 6;
+    Jul -> 7; Aug -> 8; Sep -> 9; Oct -> 10; Nov -> 11; Dec -> 12 }
+
+intToMonth :: Int -> Month
+intToMonth i = case i of
+  { 1 -> Jan; 2 -> Feb; 3 -> Mar; 4 -> Apr;  5 -> May;  6 -> Jun;
+    7 -> Jul; 8 -> Aug; 9 -> Sep; 10 -> Oct; 11 -> Nov; 12 -> Dec;
+    _ -> error "intToMonth: bad number" }
+
+pAbsYear :: Parser AbsYear
+pAbsYear = AbsYear <$> some pDigit
+
+pMonth :: Parser Month
+pMonth = pMonthFromDigits <|> pMonthAbbrev
+
+pDay :: Parser Day
+pDay = Day <$> some pDigit
+
+pLastDay :: Parser LastDay
+pLastDay = LastDay <$ char 'l'
+
+pDayOrLast :: Parser DayOrLast
+pDayOrLast = DayOrLast <$> pEither pDay pLastDay
+
+pRelative :: Parser Relative
+pRelative
+  = RRelDay <$> P.try pRelDay
+  <|> RDayOfWeek <$> P.try pRelDayOfWeek
+  <|> RByUnit <$> P.try pRelByUnit
+
+
+pRelByUnit :: Parser RelByUnit
+pRelByUnit = RelByUnit <$> pModArith <* spaces <*> pUnit
+
+pDateSpec :: Parser DateSpec
+pDateSpec = DateSpec <$> pEither pAbsolute pRelative
+
+pDatedRange :: Parser DatedRange
+pDatedRange
+  = DatedRange
+  <$> pDateSpec
+  <*  spaces
+  <* (() <$ char '-')
+  <* spaces
+  <*> pDateSpec
+
+pRange :: Parser Range
+pRange
+  = RUnit <$> P.try (pModdedUnit <* P.eof)
+  <|> RMonth <$> P.try (pMonthYear <* P.eof)
+  <|> RYear <$> P.try (pAbsYear <* P.eof)
+  <|> RDated <$> (pDatedRange <* P.eof)
+
+pMonthYear :: Parser MonthYear
+pMonthYear
+  = MonthYear
+  <$> pMonth
+  <* spaces
+  <*> pAbsYear
+  <* spaces
+  <* P.eof
+  <?> "month and year"
+
+--
+--
+--
+
+-- | Given a particular range, returns the lower and upper bound of
+-- the indicated span that includes the given number. Calls error if
+-- any of the arguments are negative.
+inRange
+
+  :: Integral i
+  => BaseOne
+  -> Int
+  -- ^ Exponent indicating which range the number must be
+  -- within. For example, 0 returns simply the number as the lower and
+  -- upper result. 1 returns a range that has 10 items. 2 returns a
+  -- range that has 100 items.
+
+  -> i
+  -- ^ Number we are checking
+
+  -> (i, i)
+  -- ^ Lower and upper bounds of range
+
+inRange b e n = fromMaybe (error "inRange: negative argument") $ do
+  guard $ e >= 0
+  guard $ n >= 0
+  let size = 10 ^ e
+      rmdr = n `mod` (10 ^ e)
+      (pLwr, pUpr) = (n - rmdr, (n + (size - rmdr) - 1))
+  return $ if b
+    then if n `mod` 10 == 0
+         then let lwr' = pLwr - (size - 1)
+              in (lwr', lwr' + (size - 1))
+         else (pLwr + 1, pUpr + 1)
+    else (pLwr, pUpr)
+
+--
+-- Parsing the command line
+--
+
+parseArgs
+  :: DayOfWeek
+  -> BaseOne
+  -> T.Day
+  -> [String]
+  -> Ex.Exceptional String [T.Day]
+parseArgs dow b1 d = fmap concat . mapM parse
+  where
+    parse s = case P.parse (pRange <* P.eof) "" (Lower s) of
+      Left e -> Ex.throw $ "could not parse range: " ++ show e
+      Right r -> rangeToList dow b1 d r
+
+
+calcNextDay
+  :: T.Day
+  -- ^ Stop iterating after this day is produced
+  -> T.Day
+  -- ^ Increment or decrement this day, and add the result to the list
+  -> Maybe (T.Day, T.Day)
+  -- ^ Nothing to stop iteration. Just (a, a) if iteration is to
+  -- continue, where a is the value to add to the list as well as the
+  -- next seed.
+
+calcNextDay stop d =
+  if d == stop
+  then Nothing
+  else let amtToAdd = if d < stop then 1 else (-1)
+           nextDay = T.addDays amtToAdd d
+       in Just (d, nextDay)
+
+dayInfos :: [T.Day] -> [DayInfo]
+dayInfos ds = zipWith3 f fwds baks ds
+  where
+    fwds = [0..]
+    baks = iterate pred (length ds - 1)
+    f fwd bak d = DayInfo d fwd bak
+
+--
+-- CLI
+--
+
+data DayInfo = DayInfo
+  { iDay :: T.Day
+  , iFwd :: Int
+  , iBack :: Int
+  }
+
+showDayInfo :: DayInfo -> Text
+showDayInfo i
+  = mconcat ["iFwd: ", fwd, " iBack: ", bak, " date: ", dt]
+  where
+    fwd = X.pack . show . iFwd $ i
+    bak = X.pack . show . iBack $ i
+    dt = X.pack
+         . T.formatTime defaultTimeLocale "%a %Y-%m-%d"
+         . iDay $ i
+
+data Opts = Opts
+  { oWeekStart :: DayOfWeek
+  , oBase :: BaseOne
+  , oFormat :: String
+  , oExprDesc :: Exp.ExprDesc
+  , oShowExpression :: Bool
+  , oVerboseFilter :: Bool
+  , oColorToFile :: Bool
+  }
+
+data ParseOpts = ParseOpts
+  { pWeekStart :: DayOfWeek
+  , pBase :: BaseOne
+  , pFormat :: String
+  , pExprDesc :: Exp.ExprDesc
+  , pCurrent :: T.Day
+  , pOperands :: [Exp.Token DayInfo]
+  , pShowExpression :: Bool
+  , pVerboseFilter :: Bool
+  , pColorToFile :: Bool
+  }
+
+initParseOpts :: T.Day -> Opts -> ParseOpts
+initParseOpts d o = ParseOpts
+  { pWeekStart = oWeekStart o
+  , pBase = oBase o
+  , pFormat = oFormat o
+  , pExprDesc = oExprDesc o
+  , pCurrent = d
+  , pOperands = []
+  , pShowExpression = oShowExpression o
+  , pVerboseFilter = oVerboseFilter o
+  , pColorToFile = oColorToFile o
+  }
+
+addOperand :: Exp.Token DayInfo
+           -> ParseOpts -> ParseOpts
+addOperand t o = o { pOperands = pOperands o ++ [t] }
+
+-- | Parses a string using a Parsec parser and, if it fails, returns a
+-- Multiarg error.
+parsecMultiarg
+  :: Parser a
+  -> String
+  -> Ex.Exceptional MA.OptArgError a
+parsecMultiarg p s = case P.parse (p <* P.eof) "" (Lower s) of
+  Left e -> Ex.throw . MA.ErrorMsg . init . show $ e
+  Right g -> return g
+
+allOpts :: [MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)]
+allOpts =
+
+  [ MA.OptSpec ["current"] "C" . MA.OneArgE $ \s -> do
+    ds <- parsecMultiarg pDateSpec s
+    return $ \o -> do
+      let baseDay = pCurrent o
+          dow = pWeekStart o
+      d <- Ex.fromMaybe ("invalid date: " ++ s) $ dayDateSpec dow baseDay ds
+      return o { pCurrent = d }
+
+  , MA.OptSpec ["week-start"] "W" . MA.OneArgE $ \s ->
+    case matchDayOfWeek (map toLower s) of
+      Nothing -> Ex.throw . MA.ErrorMsg $ "invalid day of week"
+      Just dow -> return $ \o -> return $ o { pWeekStart = dow }
+
+  , MA.OptSpec ["format"] "F" . MA.OneArg $ \s o ->
+    return o { pFormat = s }
+
+  , MA.OptSpec ["base0"] "" (MA.NoArg (\o -> return o { pBase = False }))
+  , MA.OptSpec ["base1"] "" (MA.NoArg (\o -> return o { pBase = True }))
+
+  , MA.OptSpec ["infix"] "I"
+    (MA.NoArg (\o -> return o { pExprDesc = Exp.Infix }))
+
+  , MA.OptSpec ["rpn"] "R"
+    (MA.NoArg (\o -> return o { pExprDesc = Exp.RPN }))
+
+  , MA.OptSpec ["show-expression"] "S"
+    (MA.NoArg (\o -> return o { pShowExpression =
+                                not (pShowExpression o) }))
+
+  , MA.OptSpec ["verbose-filter"] "V"
+    (MA.NoArg (\o -> return o { pVerboseFilter =
+                                not (pVerboseFilter o) }))
+
+  , MA.OptSpec ["color-to-file"] "T"
+    (MA.NoArg (\o -> return o { pColorToFile =
+                                not (pColorToFile o) }))
+
+  , pdctDate
+  , pdctWeekday
+  , pdctDay
+  , pdctYear
+  , pdctMonth
+  , pdctEnds
+  , pdctFirst
+  , pdctLast
+  , pdctNth
+
+  , MA.OptSpec ["and"] "a" . MA.NoArg . fmap return
+    $ addOperand Exp.opAnd
+
+  , MA.OptSpec ["or"] "o" . MA.NoArg . fmap return
+    $ addOperand Exp.opOr
+
+  , MA.OptSpec ["not"] "n" . MA.NoArg . fmap return
+    $ addOperand Exp.opNot
+
+  , MA.OptSpec ["open"] "(" . MA.NoArg . fmap return
+    $ addOperand Exp.openParen
+
+  , MA.OptSpec ["close"] ")" . MA.NoArg . fmap return
+    $ addOperand Exp.closeParen
+
+  ]
+
+pdctDate :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctDate = MA.OptSpec ["date"] "t" (MA.TwoArgE f)
+  where
+    f a1 a2 = do
+      cmpFn <- getComparer a1
+      ds <- parsecMultiarg pDateSpec a2
+      let g o = do
+            let curr = pCurrent o
+                dow = pWeekStart o
+            day <- Ex.fromMaybe ("invalid date: " ++ a2)
+                   $ dayDateSpec dow curr ds
+            let cmp i = compare (iDay i) day
+                tok = Exp.operand
+                      $ cmpFn (X.pack . show $ day) "date" cmp
+                o' = addOperand tok o
+            return o'
+      return g
+
+getComparer
+  :: String
+  -> Ex.Exceptional MA.OptArgError
+     (Text -> Text -> (a -> Ordering) -> Pd.Pdct a)
+getComparer s = Ex.fromMaybe (MA.ErrorMsg "could not parse comparer")
+                $ Pd.parseComparerBy (X.pack s)
+
+pdctWeekday :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctWeekday = MA.OptSpec ["weekday"] "w" (MA.TwoArgE f)
+  where
+    f a1 a2 = do
+      cmpFn <- getComparer a1
+      dow <- Ex.fromMaybe (MA.ErrorMsg "bad day of week")
+             $ matchDayOfWeek a2
+      let g o =
+            let lkup = fromMaybe (error "pdctWeekday: lookup failed")
+                       . flip lookup alist
+                dayList = listStartingWith (Proxy :: Proxy DayOfWeek)
+                          (pWeekStart o)
+                alist = zip dayList [(0 :: Int) ..]
+                cmp a = compare (lkup (dayToDayOfWeek . iDay $ a))
+                                (lkup dow)
+                pdct = cmpFn (X.pack . show $ dow) "day of week"
+                       cmp
+            in return $ addOperand (Exp.operand pdct) o
+      return g
+
+dayToDayOfWeek :: T.Day -> DayOfWeek
+dayToDayOfWeek d
+  | w == 1 = Mon
+  | w == 2 = Tue
+  | w == 3 = Wed
+  | w == 4 = Thu
+  | w == 5 = Fri
+  | w == 6 = Sat
+  | w == 7 = Sun
+  | otherwise = error "dayToDayOfWeek: toWeekDate failed"
+  where
+    (_, _, w) = toWeekDate d
+
+pdctDay :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctDay = MA.OptSpec ["day"] "d" (MA.TwoArgE f)
+  where
+    f a1 a2 = do
+      cmpFn <- getComparer a1
+      (DayOrLast dayOrLast) <- parsecMultiarg pDayOrLast a2
+      let itemDesc = case dayOrLast of
+            Left (Day ds) -> X.pack . (show :: Int -> String)
+                             . digitsToInt $ ds
+            Right _ -> "the last day of the month"
+          typeDesc = "day number"
+          cmp a = compare aDay bDay
+            where
+              aDay = let (_, _, day) = T.toGregorian (iDay a)
+                     in day
+              bDay = case dayOrLast of
+                Left (Day ds) -> digitsToInt ds
+                Right _ -> let (y, m, _) = T.toGregorian (iDay a)
+                           in T.gregorianMonthLength y m
+          tok = Exp.operand
+                $ cmpFn itemDesc typeDesc cmp
+      return $ fmap return (addOperand tok)
+
+pdctYear :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctYear = MA.OptSpec ["year"] "y" (MA.TwoArgE f)
+  where
+    f a1 a2 = do
+      cmpFn <- getComparer a1
+      yr <- MA.reader a2
+      let itemDesc = X.pack . show $ yr
+          typeDesc = "year number"
+          cmp a = compare aYear yr
+            where
+              aYear = let (y, _, _) = T.toGregorian (iDay a)
+                      in y
+          tok = Exp.operand $ cmpFn itemDesc typeDesc cmp
+      return $ fmap return (addOperand tok)
+
+pdctMonth :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctMonth = MA.OptSpec ["month"] "m" (MA.TwoArgE f)
+  where
+    f a1 a2 = do
+      cmpFn <- getComparer a1
+      mo <- parsecMultiarg pMonth a2
+      let itemDesc = X.pack . show $ mo
+          typeDesc = "month"
+          cmp a = compare aMo mo
+            where
+              aMo = let (_, m, _) = T.toGregorian (iDay a)
+                    in intToMonth m
+          tok = Exp.operand $ cmpFn itemDesc typeDesc cmp
+      return $ fmap return (addOperand tok)
+
+pdctEnds :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctEnds = MA.OptSpec ["ends"] "e" (MA.NoArg (fmap return f))
+  where
+    f = addOperand tok
+    tok = Exp.operand pdct
+    pdct = begin ||| end
+    begin = Pd.operand "first date in the list" ((== 0) . iFwd)
+    end = Pd.operand "last date in the list" ((== 0) . iBack)
+
+pdctFirst :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctFirst = MA.OptSpec ["first"] "f" (MA.NoArg (fmap return f))
+  where
+    f = addOperand
+        . Exp.operand
+        . Pd.operand "first date in the list"
+        $ ((== 0) . iFwd)
+
+pdctLast :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctLast = MA.OptSpec ["last"] "l" (MA.NoArg (fmap return f))
+  where
+    f = addOperand
+        . Exp.operand
+        . Pd.operand "last date in the list"
+        $ ((== 0) . iBack)
+
+pdctNth :: MA.OptSpec (ParseOpts -> Ex.Exceptional String ParseOpts)
+pdctNth = MA.OptSpec ["count"] "c" (MA.OneArgE f)
+  where
+    f a1 = do
+      count <- MA.reader a1
+      let g = addOperand
+              . Exp.operand
+              . Pd.operand (X.pack $ "every " ++ show count ++ " day")
+              $ ((== 0) . (`mod` count) . iFwd)
+      return (fmap return g)
+
+errExit :: String -> IO a
+errExit s = do
+  pn <- MA.getProgName
+  IO.hPutStrLn IO.stderr $ pn ++ ": error: " ++ s
+  Exit.exitFailure
+
+parseOptsInfos :: Opts -> IO (ParseOpts, [DayInfo])
+parseOptsInfos os = do
+  as <- MA.simpleWithHelp help MA.Intersperse
+        (map (fmap Left) allOpts) Right
+  today <- fmap (T.localDay . T.zonedTimeToLocalTime) T.getZonedTime
+  let (opts, args) = partitionEithers as
+      poInit = initParseOpts today os
+  po <- Ex.switch errExit return
+        . ($ poInit)
+        $ foldl' (>=>) return opts
+  days <- Ex.switch errExit return
+          $ parseArgs (pWeekStart po) (pBase po) (pCurrent po) args
+  let infos = dayInfos days
+  return (po, infos)
+
+main :: IO ()
+main = do
+  (po, infos) <- parseOptsInfos myOpts
+  pdct <-
+    if null (pOperands po)
+    then return Pd.always
+    else Ex.switch (errExit . X.unpack) return
+         $ Exp.parseExpression (pExprDesc po) (pOperands po)
+  t <- R.smartTermFromEnv (pColorToFile po) IO.stdout
+  let printer = R.printChunks t 
+  when (pShowExpression po) $ do
+    putStr $ "Filter expression:\n\n"
+    printer $ Pd.showPdct 2 0 pdct
+    putStr "\n"
+  let (remainingDayInfos, chunks)
+        = Pd.filter indentAmt False startLvl
+          showDayInfo pdct infos
+  when (pVerboseFilter po) $ do
+    putStr $ "Verbose evaluation:\n\n"
+    printer chunks
+    putStr "\n"
+  mapM_ putStrLn
+    . map (T.formatTime defaultTimeLocale (pFormat po))
+    . map iDay
+    $ remainingDayInfos
+