从Web.Routes.Boomerang中的URL解析复杂数据类型

Question

我正在使用Web.Routes.Boomerang包构建站点地图，我想使用其中Data.Time.Calendar的日期：

data Sitemap = Index
         | Yearly Integer
         | Monthly Integer Int
         | Daily Day

sitemap = mconcat
    [ rIndex
    , rYearly . integer
    , rMonthly . integer </> int
    , rDaily . integer </> int </> int  -- does not typecheck
    ]

这不是类型检查，因为rDaily的类型是

rDaily :: Boomerang e tok (Day :- r) (Sitemap :- r)

而不是

rDaily :: Boomerang e tok (Integer :- (Int :- (Int :- r))) (Sitemap :- r)

我想从(Integer :- (Int :- (Int :- r)))转换为(Day :- r)。看起来xpure可以帮助我：

dayr :: Boomerang TextsError [Text] r (Day :- r)
dayr = xpure mkDay parseDay . (integer </> int </> int)
    where mkDay (y :- m :- d :- x) = fromGregorian y m d :- x
          parseDay (day :- x) = let (y, m, d) = toGregorian day in Just $ y :- m :- d :- x

sitemap = mconcat 
    [ rIndex
    , rYearly . integer
    , rMonthly . integer </> int
    , rDaily . dayr
    ]

但是，上面的fromGregorian不完整，我想使用fromGregorianValid：

fromGregorian :: Integer -> Int -> Int -> Day
fromGregorianValid :: Integer -> Int -> Int -> Maybe Day
toGregorian :: Day -> (Integer, Int, Int) -- for completeness

如何翻转dayr来制作2014/95/13无效网址？