jcc/Hcompta/Format/JCC/Date/Write.hs

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