
   0 | module IotaTime.Tzdb
   1 | 
   2 | import IotaTime.TimeZone.Core
   3 | import IotaTime.TimeZone.Error
   4 | import IotaTime.Tzdb.Tzif
   5 | import IotaTime.Tzdb.Posix
   6 | import IotaTime.Tzdb.Windows
   7 | import IotaTime.Tzdb.Windows.Platform
   8 | import IotaTime.Tzdb.Metadata
   9 | import IotaTime.Tzdb.Provider
  10 | import Data.Buffer
  11 | import System.File.Buffer
  12 | import System.File.ReadWrite
  13 | import System
  14 | import System.Directory
  15 | import System.Info
  16 | import Data.List
  17 | import Data.Either
  18 | 
  19 | %default total
  20 | 
  21 | timeZoneFromTzif : String -> TzifData -> Either TzdbError TimeZone
  22 | timeZoneFromTzif valueId decoded = case decoded.posixFooter of
  23 |   Nothing => finiteZone
  24 |   Just "" => finiteZone
  25 |   Just footer => do
  26 |     parsed <- mapFst TzdbPosixError (parsePosixZone footer)
  27 |     case parsed of
  28 |       PosixFixed _ => finiteZone
  29 |       PosixRecurring recurrence => mapFst TzdbZoneError
  30 |         (refineRecurringTimeZone valueId decoded.initialTransition
  31 |           decoded.transitions recurrence)
  32 |   where
  33 |     finiteZone : Either TzdbError TimeZone
  34 |     finiteZone = mapFst TzdbZoneError
  35 |       (refineTimeZone valueId decoded.initialTransition decoded.transitions)
  36 | 
  37 | bufferBytes : Buffer -> IO (List Bits8)
  38 | bufferBytes buffer = do
  39 |   size <- rawSize buffer
  40 |   readBytes (cast size) 0
  41 |   where
  42 |     readBytes : Nat -> Int -> IO (List Bits8)
  43 |     readBytes Z offset = pure []
  44 |     readBytes (S count) offset = do
  45 |       byte <- getBits8 buffer offset
  46 |       remaining <- readBytes count (offset + 1)
  47 |       pure (byte :: remaining)
  48 | 
  49 | loadTzifFile : String -> IO (Either TzdbError TzifData)
  50 | loadTzifFile path = do
  51 |   loaded <- createBufferFromFile path
  52 |   case loaded of
  53 |     Left error => pure (Left (TzdbFileError (show error)))
  54 |     Right buffer => do
  55 |       bytes <- bufferBytes buffer
  56 |       pure (mapFst TzdbParseError (parseTzif bytes))
  57 | 
  58 | loadTimeZoneFile : String -> String -> IO (Either TzdbError TimeZone)
  59 | loadTimeZoneFile valueId path = do
  60 |   decoded <- loadTzifFile path
  61 |   pure (decoded >>= timeZoneFromTzif valueId)
  62 | 
  63 | zoneInfoRoot : IO String
  64 | zoneInfoRoot = do
  65 |   configured <- getEnv "TZDIR"
  66 |   pure (case configured of
  67 |     Just value => if value == "" then "/usr/share/zoneinfo" else value
  68 |     Nothing => "/usr/share/zoneinfo")
  69 | 
  70 | pathComponents : List Char -> List (List Char)
  71 | pathComponents = go []
  72 |   where
  73 |     go : List Char -> List Char -> List (List Char)
  74 |     go current [] = [reverse current]
  75 |     go current ('/' :: rest) = reverse current :: go [] rest
  76 |     go current (value :: rest) = go (value :: current) rest
  77 | 
  78 | validZoneName : String -> Bool
  79 | validZoneName source =
  80 |   let characters = unpack source
  81 |    in not (null characters) && headIsRelative characters &&
  82 |       all validComponent (pathComponents characters)
  83 |   where
  84 |     headIsRelative : List Char -> Bool
  85 |     headIsRelative ('/' :: _) = False
  86 |     headIsRelative _ = True
  87 | 
  88 |     validComponent : List Char -> Bool
  89 |     validComponent [] = False
  90 |     validComponent ['.'] = False
  91 |     validComponent ['.', '.'] = False
  92 |     validComponent values = all (/= '\0') values
  93 | 
  94 | zonePath : String -> String -> String
  95 | zonePath root name = root ++ "/" ++ name
  96 | 
  97 | unixTimeZone : String -> IO (Either TzdbError TimeZone)
  98 | unixTimeZone name = if validZoneName name
  99 |   then do
 100 |     root <- zoneInfoRoot
 101 |     loadTimeZoneFile name (zonePath root name)
 102 |   else pure (Left (InvalidZoneName name))
 103 | 
 104 | unixUtc : IO (Either TzdbError TimeZone)
 105 | unixUtc = unixTimeZone "UTC"
 106 | 
 107 | stripLeadingColon : String -> String
 108 | stripLeadingColon source = case unpack source of
 109 |   ':' :: rest => pack rest
 110 |   _ => source
 111 | 
 112 | unixLocalZone : IO (Either TzdbError TimeZone)
 113 | unixLocalZone = do
 114 |   configured <- getEnv "TZ"
 115 |   case configured of
 116 |     Nothing => loadTimeZoneFile "local" "/etc/localtime"
 117 |     Just "" => unixUtc
 118 |     Just source =>
 119 |       let value = stripLeadingColon source
 120 |        in case unpack value of
 121 |             '/' :: _ => loadTimeZoneFile value value
 122 |             _ => unixTimeZone value
 123 | 
 124 | collectZonePath : String -> String -> IO (List String)
 125 | collectZonePath root relative = do
 126 |   let path = if relative == "" then root else zonePath root relative
 127 |   listed <- listDir path
 128 |   case listed of
 129 |     Right entries => assert_total (collectEntries entries)
 130 |     Left _ => do
 131 |       decoded <- loadTzifFile path
 132 |       pure (case decoded of
 133 |         Right _ => [relative]
 134 |         Left _ => [])
 135 |   where
 136 |     collectEntries : List String -> IO (List String)
 137 |     collectEntries [] = pure []
 138 |     collectEntries (entry :: rest) = do
 139 |       let child = if relative == "" then entry else relative ++ "/" ++ entry
 140 |       found <- collectZonePath root child
 141 |       remaining <- collectEntries rest
 142 |       pure (found ++ remaining)
 143 | 
 144 | unixAvailableZones : IO (Either TzdbError (List String))
 145 | unixAvailableZones = do
 146 |   root <- zoneInfoRoot
 147 |   listed <- listDir root
 148 |   case listed of
 149 |     Left error => pure (Left (TzdbFileError (show error)))
 150 |     Right _ => map (Right . sort) (collectZonePath root "")
 151 | 
 152 | unixMetadata : IO (Either TzdbError TzdbMetadata)
 153 | unixMetadata = assert_total $ do
 154 |   root <- zoneInfoRoot
 155 |   loaded <- readFile (zonePath root "tzdata.zi")
 156 |   pure $ case loaded of
 157 |     Left error => Left (TzdbFileError (show error))
 158 |     Right source =>
 159 |       let (version, aliases) = parseTzdataIdentity source
 160 |        in Right (MkTzdbMetadata version aliases)
 161 | 
 162 | ||| The built-in Unix filesystem provider.
 163 | export
 164 | unixTimeZoneProvider : TimeZoneProviderRep
 165 | unixTimeZoneProvider = timeZoneProvider unixUtc unixTimeZone
 166 |   unixLocalZone unixAvailableZones unixMetadata
 167 | 
 168 | ||| The provider selected for the current operating system.
 169 | export
 170 | systemTimeZoneProvider : TimeZoneProviderRep
 171 | systemTimeZoneProvider = if isWindows
 172 |   then windowsRegistryTimeZoneProvider windowsNativeRegistrySource
 173 |   else unixTimeZoneProvider
 174 | 
 175 | ||| Read the native Windows registry once and return a provider backed by that
 176 | ||| immutable snapshot. Construct another provider to observe registry changes.
 177 | ||| On non-Windows hosts this returns `UnsupportedPlatform` through the native
 178 | ||| registry source.
 179 | export
 180 | windowsSnapshotTimeZoneProvider : IO (Either TzdbError TimeZoneProviderRep)
 181 | windowsSnapshotTimeZoneProvider =
 182 |   windowsRegistrySnapshotProvider windowsNativeRegistrySource
 183 | 
 184 | ||| Load UTC through an explicit platform provider.
 185 | export
 186 | utcWith : TimeZoneProviderRep -> IO (Either TzdbError TimeZone)
 187 | utcWith = runProviderUtc
 188 | 
 189 | ||| Load a named zone through an explicit platform provider.
 190 | export
 191 | timeZoneWith : TimeZoneProviderRep -> String -> IO (Either TzdbError TimeZone)
 192 | timeZoneWith = runProviderTimeZone
 193 | 
 194 | ||| Load the local zone through an explicit platform provider.
 195 | export
 196 | localZoneWith : TimeZoneProviderRep -> IO (Either TzdbError TimeZone)
 197 | localZoneWith = runProviderLocalZone
 198 | 
 199 | ||| Enumerate zones through an explicit platform provider.
 200 | export
 201 | availableZonesWith : TimeZoneProviderRep -> IO (Either TzdbError (List String))
 202 | availableZonesWith = runProviderAvailableZones
 203 | 
 204 | ||| Query version and identifier metadata through an explicit provider.
 205 | export
 206 | metadataWith : TimeZoneProviderRep -> IO (Either TzdbError TzdbMetadata)
 207 | metadataWith = runProviderMetadata
 208 | 
 209 | ||| Load UTC from the platform TZDB.
 210 | export
 211 | loadSystemUtc : IO (Either TzdbError TimeZone)
 212 | loadSystemUtc = utcWith systemTimeZoneProvider
 213 | 
 214 | ||| Load a named zone from the platform TZDB.
 215 | export
 216 | loadSystemTimeZone : String -> IO (Either TzdbError TimeZone)
 217 | loadSystemTimeZone = timeZoneWith systemTimeZoneProvider
 218 | 
 219 | ||| Load the locally configured platform zone.
 220 | export
 221 | loadSystemLocalZone : IO (Either TzdbError TimeZone)
 222 | loadSystemLocalZone = localZoneWith systemTimeZoneProvider
 223 | 
 224 | ||| List every zone available through the platform provider.
 225 | export
 226 | loadSystemAvailableZones : IO (Either TzdbError (List String))
 227 | loadSystemAvailableZones = availableZonesWith systemTimeZoneProvider
 228 | 
 229 | ||| Query version, aliases, and Windows/IANA mappings from the platform
 230 | ||| provider.
 231 | export
 232 | metadata : IO (Either TzdbError TzdbMetadata)
 233 | metadata = metadataWith systemTimeZoneProvider