]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Date/Write.hs
Polissage : Lib.Parsec : espaces.
[comptalang.git] / 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 )