lib/Hcompta/Date/Write.hs

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