{- |
   Module      :  System.Win32.Utils
   Copyright   :  2009 Balazs Komuves, 2013 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Utilities for calling Win32 API
-}
module System.Win32.Utils
  ( try, tryWithoutNull, trySized, try'
  -- * Maybe values

  , maybePtr, ptrToMaybe, maybeNum, numToMaybe
  , peekMaybe, withMaybe
  -- * Format picture translation

  , fromDateFormatPicture
  , fromTimeFormatPicture
  ) where

import Control.Monad               ( unless )
import Foreign.C.Types             ( CInt )
import Foreign.Marshal.Array       ( allocaArray, peekArray )
import Foreign.Marshal.Utils       ( with )
import Foreign.Ptr                 ( Ptr, nullPtr )
import Foreign.Storable            ( Storable(..) )
import Text.ParserCombinators.ReadP ( ReadP, (<++), between, char, count
                                    , readP_to_S, satisfy )


import System.Win32.String         ( LPTSTR, peekTString, peekTStringLen
                                   , withTStringBufferLen )
import System.Win32.Types          ( BOOL, UINT, eRROR_INSUFFICIENT_BUFFER
                                   , failIfZero, failWith, getLastError
                                   , maybeNum, maybePtr, numToMaybe
                                   , ptrToMaybe )
import qualified System.Win32.Types ( try )
import System.Win32.Word           ( DWORD, PDWORD )

-- | Support for API calls that are passed a fixed-size buffer and tell

-- you via the return value if the buffer was too small.  In that

-- case, we extend the buffer size and try again.

try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
try :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
try = String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
System.Win32.Types.try
{-# INLINE try #-}

tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
tryWithoutNull :: String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
tryWithoutNull String
loc LPTSTR -> UINT -> IO UINT
f UINT
n = do
   Either UINT String
e <- forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral UINT
n) forall a b. (a -> b) -> a -> b
$ \LPTSTR
lptstr -> do
          UINT
r <- forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
loc forall a b. (a -> b) -> a -> b
$ LPTSTR -> UINT -> IO UINT
f LPTSTR
lptstr UINT
n
          if UINT
r forall a. Ord a => a -> a -> Bool
> UINT
n then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left UINT
r) else do
            String
str <- LPTSTR -> IO String
peekTString LPTSTR
lptstr
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right String
str)
   case Either UINT String
e of
        Left UINT
r'   -> String -> (LPTSTR -> UINT -> IO UINT) -> UINT -> IO String
tryWithoutNull String
loc LPTSTR -> UINT -> IO UINT
f UINT
r'
        Right String
str -> forall (m :: * -> *) a. Monad m => a -> m a
return String
str

try' :: Storable a => String -> (Ptr a -> PDWORD -> IO BOOL) -> DWORD -> IO [a]
try' :: forall a.
Storable a =>
String -> (Ptr a -> PDWORD -> IO Bool) -> UINT -> IO [a]
try' String
loc Ptr a -> PDWORD -> IO Bool
f UINT
n =
   forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with UINT
n forall a b. (a -> b) -> a -> b
$ \PDWORD
n' -> do
   Either UINT [a]
e <- forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral UINT
n) forall a b. (a -> b) -> a -> b
$ \Ptr a
lptstr -> do
          Bool
flg <- Ptr a -> PDWORD -> IO Bool
f Ptr a
lptstr PDWORD
n'
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
flg forall a b. (a -> b) -> a -> b
$ do
            UINT
err_code <- IO UINT
getLastError
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UINT
err_code forall a. Eq a => a -> a -> Bool
== UINT
eRROR_INSUFFICIENT_BUFFER)
              forall a b. (a -> b) -> a -> b
$ forall a. String -> UINT -> IO a
failWith String
loc UINT
err_code
          UINT
r   <- forall a. Storable a => Ptr a -> IO a
peek PDWORD
n'
          if UINT
r forall a. Ord a => a -> a -> Bool
> UINT
n then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left UINT
r) else do
            [a]
str <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral UINT
r) Ptr a
lptstr
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [a]
str)
   case Either UINT [a]
e of
        Left UINT
r'   -> forall a.
Storable a =>
String -> (Ptr a -> PDWORD -> IO Bool) -> UINT -> IO [a]
try' String
loc Ptr a -> PDWORD -> IO Bool
f UINT
r'
        Right [a]
str -> forall (m :: * -> *) a. Monad m => a -> m a
return [a]
str

-- | Support for API calls that return the required size, in characters

-- including a null character, of the buffer when passed a buffer size of zero.

trySized :: String -> (LPTSTR -> CInt -> IO CInt) -> IO String
trySized :: String -> (LPTSTR -> CInt -> IO CInt) -> IO String
trySized String
wh LPTSTR -> CInt -> IO CInt
f = do
    CInt
c_len <- forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
wh forall a b. (a -> b) -> a -> b
$ LPTSTR -> CInt -> IO CInt
f forall a. Ptr a
nullPtr CInt
0
    let len :: Int
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len
    forall a. Int -> ((LPTSTR, Int) -> IO a) -> IO a
withTStringBufferLen Int
len forall a b. (a -> b) -> a -> b
$ \(LPTSTR
buf', Int
len') -> do
        let c_len' :: CInt
c_len' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len'
        CInt
c_len'' <- forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
wh forall a b. (a -> b) -> a -> b
$ LPTSTR -> CInt -> IO CInt
f LPTSTR
buf' CInt
c_len'
        let len'' :: Int
len'' = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_len''
        (LPTSTR, Int) -> IO String
peekTStringLen (LPTSTR
buf', Int
len'' forall a. Num a => a -> a -> a
- Int
1) -- Drop final null character


-- | See also: 'Foreign.Marshal.Utils.maybePeek' function.

peekMaybe :: Storable a => Ptr a -> IO (Maybe a)
peekMaybe :: forall a. Storable a => Ptr a -> IO (Maybe a)
peekMaybe Ptr a
p =
  if Ptr a
p forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Storable a => Ptr a -> IO a
peek Ptr a
p

-- | See also: 'Foreign.Marshal.Utils.maybeWith' function.

withMaybe :: Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe :: forall a b. Storable a => Maybe a -> (Ptr a -> IO b) -> IO b
withMaybe Maybe a
Nothing  Ptr a -> IO b
action = Ptr a -> IO b
action forall a. Ptr a
nullPtr
withMaybe (Just a
x) Ptr a -> IO b
action = forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
x Ptr a -> IO b
action

-- | Type representing components of a Windows API day, month, year and era

-- format picture.

data DateFormatPicture
  = Day
  | Day0 -- Padded with zeros

  | DayShort
  | DayLong
  | Month
  | Month0 -- Padded with zeros

  | MonthShort
  | MonthLong
  | YearVeryShort -- Year represented only by the last digit

  | YearShort
  | Year
  | Era
  | DateOther String
  deriving (DateFormatPicture -> DateFormatPicture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateFormatPicture -> DateFormatPicture -> Bool
$c/= :: DateFormatPicture -> DateFormatPicture -> Bool
== :: DateFormatPicture -> DateFormatPicture -> Bool
$c== :: DateFormatPicture -> DateFormatPicture -> Bool
Eq, Int -> DateFormatPicture -> ShowS
[DateFormatPicture] -> ShowS
DateFormatPicture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateFormatPicture] -> ShowS
$cshowList :: [DateFormatPicture] -> ShowS
show :: DateFormatPicture -> String
$cshow :: DateFormatPicture -> String
showsPrec :: Int -> DateFormatPicture -> ShowS
$cshowsPrec :: Int -> DateFormatPicture -> ShowS
Show)

fromDFP :: DateFormatPicture -> String
fromDFP :: DateFormatPicture -> String
fromDFP DateFormatPicture
Day = String
"%-e" -- No padding

fromDFP DateFormatPicture
Day0 = String
"%d" -- Padded with zeros

fromDFP DateFormatPicture
DayShort = String
"%a" -- eg Tue

fromDFP DateFormatPicture
DayLong = String
"%A" -- eg Tuesday

fromDFP DateFormatPicture
Month = String
"%-m" -- No padding

fromDFP DateFormatPicture
Month0 = String
"%m" -- Padded with zeros

fromDFP DateFormatPicture
MonthShort = String
"%b" -- eg Jan

fromDFP DateFormatPicture
MonthLong = String
"%B" -- eg January

fromDFP DateFormatPicture
YearVeryShort = String
"%-y" -- No direct equivalent of a one digit year, so

                              -- do not distinguish from a short year without

                              -- padding

fromDFP DateFormatPicture
YearShort = String
"%y"
fromDFP DateFormatPicture
Year = String
"%Y"
fromDFP DateFormatPicture
Era = String
"" -- No equivalent

fromDFP (DateOther String
cs) = ShowS
escape String
cs

escape :: String -> String
escape :: ShowS
escape [] = []
escape (Char
c:String
cs) = Char -> String
escape' Char
c forall a. [a] -> [a] -> [a]
++ ShowS
escape String
cs
 where
  escape' :: Char -> String
escape' Char
'%' = String
"%%"
  escape' Char
'\t' = String
"%t"
  escape' Char
'\n' = String
"%n"
  escape' Char
c' = [Char
c']

d :: ReadP Char
d :: ReadP Char
d = Char -> ReadP Char
char Char
'd'

day :: ReadP DateFormatPicture
day :: ReadP DateFormatPicture
day = do
  Char
_ <- ReadP Char
d
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Day

day0 :: ReadP DateFormatPicture
day0 :: ReadP DateFormatPicture
day0 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
d
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Day0

dayShort :: ReadP DateFormatPicture
dayShort :: ReadP DateFormatPicture
dayShort = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
3 ReadP Char
d
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
DayShort

dayLong :: ReadP DateFormatPicture
dayLong :: ReadP DateFormatPicture
dayLong = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
4 ReadP Char
d
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
DayLong

days :: ReadP DateFormatPicture
days :: ReadP DateFormatPicture
days = ReadP DateFormatPicture
dayLong forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
dayShort forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
day0 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
day

bigM :: ReadP Char
bigM :: ReadP Char
bigM = Char -> ReadP Char
char Char
'M'

month :: ReadP DateFormatPicture
month :: ReadP DateFormatPicture
month = do
  Char
_ <- ReadP Char
bigM
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Month

month0 :: ReadP DateFormatPicture
month0 :: ReadP DateFormatPicture
month0 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
bigM
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Month0

monthShort :: ReadP DateFormatPicture
monthShort :: ReadP DateFormatPicture
monthShort = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
3 ReadP Char
bigM
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
MonthShort

monthLong :: ReadP DateFormatPicture
monthLong :: ReadP DateFormatPicture
monthLong = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
4 ReadP Char
bigM
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
MonthLong

months :: ReadP DateFormatPicture
months :: ReadP DateFormatPicture
months = ReadP DateFormatPicture
monthLong forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
monthShort forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
month0 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
month

y :: ReadP Char
y :: ReadP Char
y = Char -> ReadP Char
char Char
'y'

yearVeryShort :: ReadP DateFormatPicture
yearVeryShort :: ReadP DateFormatPicture
yearVeryShort = do
  Char
_ <- ReadP Char
y
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
YearVeryShort

yearShort :: ReadP DateFormatPicture
yearShort :: ReadP DateFormatPicture
yearShort = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
y
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
YearShort

year :: ReadP DateFormatPicture
year :: ReadP DateFormatPicture
year = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
5 ReadP Char
y forall a. ReadP a -> ReadP a -> ReadP a
<++ forall a. Int -> ReadP a -> ReadP [a]
count Int
4 ReadP Char
y
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Year

years :: ReadP DateFormatPicture
years :: ReadP DateFormatPicture
years = ReadP DateFormatPicture
year forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
yearShort forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
yearVeryShort

g :: ReadP Char
g :: ReadP Char
g = Char -> ReadP Char
char Char
'g'

era :: ReadP DateFormatPicture
era :: ReadP DateFormatPicture
era = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
g forall a. ReadP a -> ReadP a -> ReadP a
<++ forall a. Int -> ReadP a -> ReadP [a]
count Int
1 ReadP Char
g
  forall (m :: * -> *) a. Monad m => a -> m a
return DateFormatPicture
Era

quote :: ReadP Char
quote :: ReadP Char
quote = Char -> ReadP Char
char Char
'\''

notQuote :: ReadP Char
notQuote :: ReadP Char
notQuote = (Char -> Bool) -> ReadP Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'\'')

escQuote :: ReadP Char
escQuote :: ReadP Char
escQuote = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
quote
  forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''

quotedChars :: ReadP String
quotedChars :: ReadP String
quotedChars = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between ReadP Char
quote ReadP Char
quote forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadP [a]
greedy (ReadP Char
escQuote forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP Char
notQuote)

-- | Although not documented at

-- https://docs.microsoft.com/en-us/windows/win32/intl/day--month--year--and-era-format-pictures

-- the format pictures used by Windows do not require all such characters to be

-- enclosed in single quotation marks.

nonDateSpecial :: ReadP Char
nonDateSpecial :: ReadP Char
nonDateSpecial = (Char -> Bool) -> ReadP Char
satisfy (\Char
c -> Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'd', Char
'M', Char
'y', Char
'g', Char
'\''])

nonDateSpecials :: ReadP String
nonDateSpecials :: ReadP String
nonDateSpecials = forall a. ReadP a -> ReadP [a]
greedy1 ReadP Char
nonDateSpecial

dateOther :: ReadP DateFormatPicture
dateOther :: ReadP DateFormatPicture
dateOther = do
  [String]
chars <- forall a. ReadP a -> ReadP [a]
greedy1 (ReadP String
nonDateSpecials forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP String
quotedChars)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> DateFormatPicture
DateOther forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
chars

datePicture :: ReadP [DateFormatPicture]
datePicture :: ReadP [DateFormatPicture]
datePicture = forall a. ReadP a -> ReadP [a]
greedy (ReadP DateFormatPicture
days forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
months forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
years forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
era forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP DateFormatPicture
dateOther)

-- | Type representing components of a Windows API hours, minute, and second

-- format picture.

data TimeFormatPicture
  = Hours12
  | Hours012 -- Padded with zeros

  | Hours24
  | Hours024 -- Padded with zeros

  | Minutes
  | Minutes0 -- Padded with zeros

  | Seconds
  | Seconds0 -- Padded with zeros

  | TimeMarkerShort -- One-character time marker string, eg "A" and "P"

  | TimeMarker -- Multi-character time marker string, eg "AM" and "PM"

  | TimeOther String
  deriving (TimeFormatPicture -> TimeFormatPicture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeFormatPicture -> TimeFormatPicture -> Bool
$c/= :: TimeFormatPicture -> TimeFormatPicture -> Bool
== :: TimeFormatPicture -> TimeFormatPicture -> Bool
$c== :: TimeFormatPicture -> TimeFormatPicture -> Bool
Eq, Int -> TimeFormatPicture -> ShowS
[TimeFormatPicture] -> ShowS
TimeFormatPicture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeFormatPicture] -> ShowS
$cshowList :: [TimeFormatPicture] -> ShowS
show :: TimeFormatPicture -> String
$cshow :: TimeFormatPicture -> String
showsPrec :: Int -> TimeFormatPicture -> ShowS
$cshowsPrec :: Int -> TimeFormatPicture -> ShowS
Show)

fromTFP :: TimeFormatPicture -> String
fromTFP :: TimeFormatPicture -> String
fromTFP TimeFormatPicture
Hours12 = String
"%-l" -- No padding

fromTFP TimeFormatPicture
Hours012 = String
"%I" -- Padded with zeros

fromTFP TimeFormatPicture
Hours24 = String
"%-k" -- No padding

fromTFP TimeFormatPicture
Hours024 = String
"%H" -- Padded with zeros

fromTFP TimeFormatPicture
Minutes = String
"%-M" -- No padding

fromTFP TimeFormatPicture
Minutes0 = String
"%M" -- Padded with zeros

fromTFP TimeFormatPicture
Seconds = String
"%-S" -- No padding

fromTFP TimeFormatPicture
Seconds0 = String
"%S" -- Padded with zeros

fromTFP TimeFormatPicture
TimeMarkerShort = String
"%p" -- No direct equivalent, so do not distinguish

                               -- from TimeMarker

fromTFP TimeFormatPicture
TimeMarker = String
"%p"
fromTFP (TimeOther String
cs) = ShowS
escape String
cs

h :: ReadP Char
h :: ReadP Char
h = Char -> ReadP Char
char Char
'h'

hours12 :: ReadP TimeFormatPicture
hours12 :: ReadP TimeFormatPicture
hours12 = do
  Char
_ <- ReadP Char
h
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Hours12

hours012 :: ReadP TimeFormatPicture
hours012 :: ReadP TimeFormatPicture
hours012 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
h
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Hours012

bigH :: ReadP Char
bigH :: ReadP Char
bigH = Char -> ReadP Char
char Char
'H'

hours24 :: ReadP TimeFormatPicture
hours24 :: ReadP TimeFormatPicture
hours24 = do
  Char
_ <- ReadP Char
bigH
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Hours24

hours024 :: ReadP TimeFormatPicture
hours024 :: ReadP TimeFormatPicture
hours024 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
bigH
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Hours024

hours :: ReadP TimeFormatPicture
hours :: ReadP TimeFormatPicture
hours = ReadP TimeFormatPicture
hours012 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
hours12 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
hours024 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
hours24

m :: ReadP Char
m :: ReadP Char
m = Char -> ReadP Char
char Char
'm'

minute :: ReadP TimeFormatPicture
minute :: ReadP TimeFormatPicture
minute = do
  Char
_ <- ReadP Char
m
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Minutes

minute0 :: ReadP TimeFormatPicture
minute0 :: ReadP TimeFormatPicture
minute0 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
m
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Minutes0

minutes :: ReadP TimeFormatPicture
minutes :: ReadP TimeFormatPicture
minutes = ReadP TimeFormatPicture
minute0 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
minute

s :: ReadP Char
s :: ReadP Char
s = Char -> ReadP Char
char Char
's'

second :: ReadP TimeFormatPicture
second :: ReadP TimeFormatPicture
second = do
  Char
_ <- ReadP Char
s
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Seconds

second0 :: ReadP TimeFormatPicture
second0 :: ReadP TimeFormatPicture
second0 = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
s
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
Seconds0

seconds :: ReadP TimeFormatPicture
seconds :: ReadP TimeFormatPicture
seconds = ReadP TimeFormatPicture
second0 forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
second

t :: ReadP Char
t :: ReadP Char
t = Char -> ReadP Char
char Char
't'

timeMarkerShort :: ReadP TimeFormatPicture
timeMarkerShort :: ReadP TimeFormatPicture
timeMarkerShort = do
  Char
_ <- ReadP Char
t
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
TimeMarkerShort

timeMarker :: ReadP TimeFormatPicture
timeMarker :: ReadP TimeFormatPicture
timeMarker = do
  String
_ <- forall a. Int -> ReadP a -> ReadP [a]
count Int
2 ReadP Char
t
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormatPicture
TimeMarker

timeMarkers :: ReadP TimeFormatPicture
timeMarkers :: ReadP TimeFormatPicture
timeMarkers = ReadP TimeFormatPicture
timeMarker forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
timeMarkerShort

-- | Although not documented at

-- https://docs.microsoft.com/en-us/windows/win32/intl/hour--minute--and-second-format-pictures

-- the format pictures used by Windows do not require all such characters to be

-- enclosed in single quotation marks.

nonTimeSpecial :: ReadP Char
nonTimeSpecial :: ReadP Char
nonTimeSpecial = (Char -> Bool) -> ReadP Char
satisfy (\Char
c -> Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'h', Char
'H', Char
'm', Char
's', Char
't', Char
'\''])

nonTimeSpecials :: ReadP String
nonTimeSpecials :: ReadP String
nonTimeSpecials = forall a. ReadP a -> ReadP [a]
greedy1 ReadP Char
nonTimeSpecial

timeOther :: ReadP TimeFormatPicture
timeOther :: ReadP TimeFormatPicture
timeOther = do
  [String]
chars <- forall a. ReadP a -> ReadP [a]
greedy1 (ReadP String
nonTimeSpecials forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP String
quotedChars)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> TimeFormatPicture
TimeOther forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
chars

timePicture :: ReadP [TimeFormatPicture]
timePicture :: ReadP [TimeFormatPicture]
timePicture = forall a. ReadP a -> ReadP [a]
greedy (ReadP TimeFormatPicture
hours forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
minutes forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
seconds forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TimeFormatPicture
timeMarkers forall a. ReadP a -> ReadP a -> ReadP a
<++
                     ReadP TimeFormatPicture
timeOther)

greedy :: ReadP a -> ReadP [a]
greedy :: forall a. ReadP a -> ReadP [a]
greedy ReadP a
p = forall a. ReadP a -> ReadP [a]
greedy1 ReadP a
p forall a. ReadP a -> ReadP a -> ReadP a
<++ forall (m :: * -> *) a. Monad m => a -> m a
return []

greedy1 :: ReadP a -> ReadP [a]
greedy1 :: forall a. ReadP a -> ReadP [a]
greedy1 ReadP a
p = do
  a
first <- ReadP a
p
  [a]
rest <- forall a. ReadP a -> ReadP [a]
greedy ReadP a
p
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
first forall a. a -> [a] -> [a]
: [a]
rest)

parseMaybe :: ReadP a -> String -> Maybe a
parseMaybe :: forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP a
parser String
input =
  case forall a. ReadP a -> ReadS a
readP_to_S ReadP a
parser String
input of
    [] -> forall a. Maybe a
Nothing
    ((a
result, String
_):[(a, String)]
_) -> forall a. a -> Maybe a
Just a
result

-- | Translate from a Windows API day, month, year, and era format picture to

-- the closest corresponding format string used by

-- 'Data.Time.Format.formatTime'.

fromDateFormatPicture :: String -> Maybe String
fromDateFormatPicture :: String -> Maybe String
fromDateFormatPicture String
dfp =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DateFormatPicture -> String
fromDFP) forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP [DateFormatPicture]
datePicture String
dfp

-- | Translate from a Windows API hours, minute, and second format picture to

-- the closest corresponding format string used by

-- 'Data.Time.Format.formatTime'.

fromTimeFormatPicture :: String -> Maybe String
fromTimeFormatPicture :: String -> Maybe String
fromTimeFormatPicture String
tfp =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TimeFormatPicture -> String
fromTFP) forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> String -> Maybe a
parseMaybe ReadP [TimeFormatPicture]
timePicture String
tfp