0 | module IotaTime.Locale.Windows.Platform
6 | %foreign "C:iotatime_windows_locale_snapshot, libiotatime_windows"
7 | prim__windowsLocaleSnapshot : String -> Int -> PrimIO AnyPtr
9 | %foreign "C:iotatime_windows_locale_item, libiotatime_windows"
10 | prim__windowsLocaleItem : AnyPtr -> Int -> String
12 | %foreign "C:iotatime_windows_locale_free, libiotatime_windows"
13 | prim__windowsLocaleFree : AnyPtr -> PrimIO ()
16 | record WindowsLocaleData where
17 | constructor MkWindowsLocaleData
18 | windowsLocaleId : String
19 | windowsMonthNames : Vect 12 String
20 | windowsMonthNamesShort : Vect 12 String
21 | windowsDayNames : Vect 7 String
22 | windowsDayNamesShort : Vect 7 String
23 | windowsAmName : String
24 | windowsPmName : String
25 | windowsRawDateFormat : String
26 | windowsRawTimeFormat : String
29 | localeIdentifier : WindowsLocaleData -> String
30 | localeIdentifier = windowsLocaleId
33 | localeMonthNames : WindowsLocaleData -> Vect 12 String
34 | localeMonthNames = windowsMonthNames
37 | localeMonthNamesShort : WindowsLocaleData -> Vect 12 String
38 | localeMonthNamesShort = windowsMonthNamesShort
41 | localeDayNames : WindowsLocaleData -> Vect 7 String
42 | localeDayNames = windowsDayNames
45 | localeDayNamesShort : WindowsLocaleData -> Vect 7 String
46 | localeDayNamesShort = windowsDayNamesShort
49 | localeAmName : WindowsLocaleData -> String
50 | localeAmName = windowsAmName
53 | localePmName : WindowsLocaleData -> String
54 | localePmName = windowsPmName
57 | localeDateFormat : WindowsLocaleData -> String
58 | localeDateFormat = windowsRawDateFormat
61 | localeTimeFormat : WindowsLocaleData -> String
62 | localeTimeFormat = windowsRawTimeFormat
64 | isPictureField : Char -> Bool
65 | isPictureField value =
66 | value == 'd' || value == 'M' || value == 'y' || value == 'H' ||
67 | value == 'h' || value == 'm' || value == 's' || value == 't'
69 | fieldSpecifier : Char -> Nat -> List Char
70 | fieldSpecifier 'd' count = if count >= 4 then unpack "%A"
71 | else if count == 3 then unpack "%a"
72 | else if count == 2 then unpack "%d"
74 | fieldSpecifier 'M' count = if count >= 4 then unpack "%B"
75 | else if count == 3 then unpack "%b"
77 | fieldSpecifier 'y' count = if count >= 3 then unpack "%Y" else unpack "%y"
78 | fieldSpecifier 'H' count = unpack "%H"
79 | fieldSpecifier 'h' count = unpack "%I"
80 | fieldSpecifier 'm' count = unpack "%M"
81 | fieldSpecifier 's' count = unpack "%S"
82 | fieldSpecifier 't' count = unpack "%p"
83 | fieldSpecifier value count = []
85 | data PictureMode = PictureText | PictureLiteral
87 | flushField : Maybe (Char, Nat) -> List Char
88 | flushField Nothing = []
89 | flushField (Just (value, count)) = fieldSpecifier value count
91 | translatePicture : PictureMode -> Maybe (Char, Nat) ->
92 | List Char -> List Char
93 | translatePicture mode pending [] = flushField pending
94 | translatePicture PictureLiteral pending ('\'' :: '\'' :: rest) =
95 | flushField pending ++ '\'' :: translatePicture PictureLiteral Nothing rest
96 | translatePicture PictureLiteral pending ('\'' :: rest) =
97 | flushField pending ++ translatePicture PictureText Nothing rest
98 | translatePicture PictureLiteral pending ('%' :: rest) =
99 | flushField pending ++ '%' :: '%' ::
100 | translatePicture PictureLiteral Nothing rest
101 | translatePicture PictureLiteral pending (value :: rest) =
102 | flushField pending ++ value :: translatePicture PictureLiteral Nothing rest
103 | translatePicture PictureText pending ('\'' :: rest) =
104 | flushField pending ++ translatePicture PictureLiteral Nothing rest
105 | translatePicture PictureText pending ('%' :: rest) =
106 | flushField pending ++ '%' :: '%' ::
107 | translatePicture PictureText Nothing rest
108 | translatePicture PictureText Nothing (value :: rest) =
109 | if isPictureField value
110 | then translatePicture PictureText (Just (value, 1)) rest
111 | else value :: translatePicture PictureText Nothing rest
112 | translatePicture PictureText (Just (field, count)) (value :: rest) =
114 | then translatePicture PictureText (Just (field, S count)) rest
115 | else fieldSpecifier field count ++
116 | if isPictureField value
117 | then translatePicture PictureText (Just (value, 1)) rest
118 | else value :: translatePicture PictureText Nothing rest
121 | windowsPictureToStrftime : String -> String
122 | windowsPictureToStrftime =
123 | pack . translatePicture PictureText Nothing . unpack
125 | items : (count : Nat) -> Int -> AnyPtr -> Vect count String
126 | items Z offset pointer = []
127 | items (S count) offset pointer =
128 | prim__windowsLocaleItem pointer offset :: items count (offset + 1) pointer
131 | loadWindowsLocaleData : Bool -> String -> IO (Maybe WindowsLocaleData)
132 | loadWindowsLocaleData current name = do
133 | pointer <- primIO (prim__windowsLocaleSnapshot name (if current then 1 else 0))
134 | if prim__nullAnyPtr pointer /= 0
137 | let value = MkWindowsLocaleData
138 | (prim__windowsLocaleItem pointer 0)
139 | (items 12 1 pointer)
140 | (items 12 13 pointer)
141 | (items 7 25 pointer)
142 | (items 7 32 pointer)
143 | (prim__windowsLocaleItem pointer 39)
144 | (prim__windowsLocaleItem pointer 40)
145 | (windowsPictureToStrftime (prim__windowsLocaleItem pointer 41))
146 | (windowsPictureToStrftime (prim__windowsLocaleItem pointer 42))
147 | primIO (prim__windowsLocaleFree pointer)