lib/Hcompta/Date/Write.hs

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