Rakka/Utils.hs

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