Rakka/Utils.hs

   1 module Rakka.Utils
   2     ( parseYesOrNo
   3     , maybeA
   4     , defaultTo
   5     , deleteIfEmpty
   6     , formatW3CDateTime
   7     )
   8     where
   9
  10 import           Control.Arrow
  11 import           Control.Arrow.ArrowList
  12 import           System.Time
  13 import           Text.Printf
  14
  15
  16 parseYesOrNo :: ArrowChoice a => a String Bool
  17 parseYesOrNo
  18     = proc str -> do case str of
  19                        "yes" -> returnA -< True
  20                        "no"  -> returnA -< False
  21                        _     -> returnA -< error ("Expected yes or no: " ++ str)
  22
  23
  24 maybeA :: (ArrowList a, ArrowChoice a) => a b c -> a b (Maybe c)
  25 maybeA a = listA a
  26            >>>
  27            proc xs -> case xs of
  28                         []    -> returnA -< Nothing
  29                         (x:_) -> returnA -< Just x
  30
  31
  32 defaultTo :: ArrowChoice a => b -> a (Maybe b) b
  33 defaultTo def
  34     = proc m -> case m of
  35                   Nothing -> returnA -< def
  36                   Just x  -> returnA -< x
  37
  38
  39 deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String
  40 deleteIfEmpty
  41     = proc str -> do case str of
  42                        "" -> none    -< ()
  43                        _  -> returnA -< str
  44
  45
  46 formatW3CDateTime :: CalendarTime -> String
  47 formatW3CDateTime time
  48     = formatDateTime time ++ formatTimeZone time
  49     where
  50       formatDateTime :: CalendarTime -> String
  51       formatDateTime time
  52           = printf "%04d-%02d-%02dT%02d:%02d:%02d"
  53             (ctYear time)
  54             (fromEnum (ctMonth time) + 1)
  55             (ctDay  time)
  56             (ctHour time)
  57             (ctMin  time)
  58             (ctSec  time)
  59
  60       formatTimeZone :: CalendarTime -> String
  61       formatTimeZone time
  62           = case ctTZ time
  63             of offset | offset <  0 -> '-':(showTZ $ negate offset)
  64                       | offset == 0 -> "Z"
  65                       | otherwise   -> '+':(showTZ offset)
  66
  67       showTZ :: Int -> String
  68       showTZ offset
  69           = let hour = offset `div` 3600
  70                 min  = (offset - hour * 3600) `div` 60
  71             in
  72               show2 hour ++ ":" ++ show2 min
  73
  74       show2 :: Int -> String
  75       show2 n | n < 10    = '0':(show n)
  76               | otherwise = show n