lib/Hcompta/Date/Write.hs

   1 {-# LANGUAGE MagicHash #-}
   2 module Hcompta.Date.Write where
   3
   4 import qualified Data.Text as Text
   5 import qualified Data.Time.LocalTime as Time
   6 import           GHC.Exts (Int(..))
   7 import           GHC.Integer.Logarithms (integerLogBase#)
   8
   9 import qualified Hcompta.Lib.Leijen as W
  10 import           Hcompta.Lib.Leijen (Doc, (<>))
  11 import qualified Hcompta.Date as Date
  12 import           Hcompta.Date (Date)
  13
  14 -- * Write 'Date'
  15
  16 date :: Date -> Doc
  17 date dat = do
  18         let (y, mo, d) = Date.gregorian dat
  19         (if y == 0 then W.empty else W.integer y <> sep '/') <> do
  20         int2 mo <> do
  21         sep '/' <> int2 d <> do
  22         (case Date.tod dat of
  23          Time.TimeOfDay 0 0 0 -> W.empty
  24          Time.TimeOfDay h m s ->
  25                 sep '_' <> int2 h <> do
  26                 sep ':' <> int2 m <> do
  27                 (case s of
  28                  0 -> W.empty
  29                  _ -> sep ':' <> do
  30                         (if s < 10 then W.char '0' else W.empty) <> do
  31                         W.strict_text $ Text.pack $ show $ (truncate s::Integer)))
  32         -- (case tz_min of
  33         --  0 -> W.empty
  34         --  _ | tz_name /= "" -> W.space <> do W.strict_text $ Text.pack tz_name
  35         --  _ -> W.space <> do W.strict_text $ Text.pack $ Time.timeZoneOffsetString tz)
  36         where
  37                 int2 :: Int -> Doc
  38                 int2 i = if i < 10 then W.char '0' <> W.int i else W.int i
  39                 sep :: Char -> Doc
  40                 sep = W.bold . W.dullblack . W.char
  41
  42 -- ** Measure 'Date'
  43
  44 date_length :: Date -> Int
  45 date_length dat = do
  46         let (y, _, _) = Date.gregorian dat
  47         (case y of
  48          0 -> 0
  49          _ ->
  50                 (if y < 0 then 1 else 0) -- sign
  51                 + (1 + (I# (integerLogBase# 10 (abs y)))) -- year
  52                 + 1) -- /
  53         + 2 -- month
  54         + 1 -- /
  55         + 2 -- dom
  56         + (case Date.tod dat of
  57          Time.TimeOfDay 0 0 0 -> 0
  58          Time.TimeOfDay _ _ s ->
  59                 1 -- _
  60                 + 2 -- hour
  61                 + 1 -- :
  62                 + 2 -- min
  63                 + (case s of
  64                  0 -> 0
  65                  _ -> 1 + 2 -- : sec
  66                 )
  67         )