Rakka/Utils.hs

   1 module Rakka.Utils
   2     ( yesOrNo
   3     , parseYesOrNo
   4     , maybeA
   5     , deleteIfEmpty
   6     , formatW3CDateTime
   7     , chomp
   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 deleteIfEmpty :: (ArrowList a, ArrowChoice a) => a String String
  39 deleteIfEmpty
  40     = proc str -> do case str of
  41                        "" -> none    -< ()
  42                        _  -> returnA -< str
  43
  44
  45 formatW3CDateTime :: CalendarTime -> String
  46 formatW3CDateTime time
  47     = formatDateTime time ++ formatTimeZone time
  48     where
  49       formatDateTime :: CalendarTime -> String
  50       formatDateTime time
  51           = printf "%04d-%02d-%02dT%02d:%02d:%02d"
  52             (ctYear time)
  53             (fromEnum (ctMonth time) + 1)
  54             (ctDay  time)
  55             (ctHour time)
  56             (ctMin  time)
  57             (ctSec  time)
  58
  59       formatTimeZone :: CalendarTime -> String
  60       formatTimeZone time
  61           = case ctTZ time
  62             of offset | offset <  0 -> '-':(showTZ $ negate offset)
  63                       | offset == 0 -> "Z"
  64                       | otherwise   -> '+':(showTZ offset)
  65
  66       showTZ :: Int -> String
  67       showTZ offset
  68           = let hour = offset `div` 3600
  69                 min  = (offset - hour * 3600) `div` 60
  70             in
  71               show2 hour ++ ":" ++ show2 min
  72
  73       show2 :: Int -> String
  74       show2 n | n < 10    = '0':(show n)
  75               | otherwise = show n
  76
  77
  78 chomp :: String -> String
  79 chomp = reverse . snd . break (/= '\n') . reverse