Rakka/Utils.hs

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