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           Data.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 :: ZonedTime -> String
  46 formatW3CDateTime zonedTime
  47     = formatLocalTime (zonedTimeToLocalTime zonedTime)
  48       ++
  49       formatTimeZone (zonedTimeZone zonedTime)
  50     where
  51       formatLocalTime :: LocalTime -> String
  52       formatLocalTime localTime
  53           = let (year, month, day) = toGregorian (localDay localTime)
  54                 timeOfDay          = localTimeOfDay localTime
  55                 (secInt, secFrac)  = properFraction (todSec timeOfDay)
  56             in
  57               (printf "%04d-%02d-%02dT%02d:%02d:%02d"
  58                       year
  59                       month
  60                       day
  61                       (todHour timeOfDay)
  62                       (todMin timeOfDay)
  63                       (secInt :: Int))
  64               ++
  65               (if secFrac == 0
  66                then ""
  67                else tail (show secFrac))
  68
  69       formatTimeZone :: TimeZone -> String
  70       formatTimeZone tz
  71           = case timeZoneMinutes tz of
  72               offset | offset <  0 -> '-':(showTZ $ negate offset)
  73                      | offset == 0 -> "Z"
  74                      | otherwise   -> '+':(showTZ offset)
  75
  76       showTZ :: Int -> String
  77       showTZ offset
  78           = let hour   = offset `div` 60
  79                 minute = offset - hour * 60
  80             in
  81               show2 hour ++ ":" ++ show2 minute
  82
  83       show2 :: Int -> String
  84       show2 n | n < 10    = '0':(show n)
  85               | otherwise = show n
  86
  87
  88 chomp :: String -> String
  89 chomp = reverse . snd . break (/= '\n') . reverse