d1b44bf · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Move Time.Implementation to use <>

d1b44bfLeon P Smith12 years ago

src/Database/PostgreSQL/Simple/Time/Implementation.hs+24−27

compare with master

unifiedsplit

@@ -12,7 +12,7 @@

13module Database.PostgreSQL.Simple.Time.Implementation where

15−import Prelude hiding (take, (++))

15+import Prelude hiding (take)

16import Data.ByteString.Builder(Builder, byteString, char8, integerDec)

17import Control.Arrow((***))

18import Control.Applicative

@@ -24,14 +24,11 @@ import Data.Time hiding (getTimeZone, getZonedTime)

24import Data.Typeable

25import Data.Word(Word8)

26import qualified Data.Attoparsec.ByteString.Char8 as A

27+import Database.PostgreSQL.Simple.Compat ((<>))

27import Data.Monoid(Monoid(..))

28import Data.Monoid(Monoid(..))

28import Data.Fixed (Pico)

29import Data.Fixed (Pico)

29import Unsafe.Coerce

30import Unsafe.Coerce

31−(++) :: Monoid a => a -> a -> a

32−(++) = mappend

33−infixr 5 ++

34−

35data Unbounded a

32data Unbounded a

36 = NegInfinity

33 = NegInfinity

37 | Finite !a

34 | Finite !a

@@ -41,9 +38,9 @@ data Unbounded a

41instance Show a => Show (Unbounded a) where

38instance Show a => Show (Unbounded a) where

42 showsPrec prec x rest

39 showsPrec prec x rest

43 = case x of

40 = case x of

44− NegInfinity -> "-infinity" ++ rest

41+ NegInfinity -> "-infinity" <> rest

45 Finite time -> showsPrec prec time rest

42 Finite time -> showsPrec prec time rest

46− PosInfinity -> "infinity" ++ rest

43+ PosInfinity -> "infinity" <> rest

48instance Read a => Read (Unbounded a) where

45instance Read a => Read (Unbounded a) where

49 readsPrec prec = readParen False $ \str -> case str of

46 readsPrec prec = readParen False $ \str -> case str of

@@ -205,21 +202,21 @@ digits msg = do

205 y <- A.anyChar

202 y <- A.anyChar

206 if A.isDigit x && A.isDigit y

203 if A.isDigit x && A.isDigit y

207 then return $! (10 * digit (c2w x) + digit (c2w y))

204 then return $! (10 * digit (c2w x) + digit (c2w y))

208− else fail (msg ++ " is not 2 digits")

205+ else fail (msg <> " is not 2 digits")

209{-# INLINE digits #-}

206{-# INLINE digits #-}

210

207

211dayToBuilder :: Day -> Builder

208dayToBuilder :: Day -> Builder

212dayToBuilder (toGregorian -> (y,m,d)) = do

209dayToBuilder (toGregorian -> (y,m,d)) = do

213− pad4 y ++ char8 '-' ++ pad2 m ++ char8 '-' ++ pad2 d

210+ pad4 y <> char8 '-' <> pad2 m <> char8 '-' <> pad2 d

214

211

215timeOfDayToBuilder :: TimeOfDay -> Builder

212timeOfDayToBuilder :: TimeOfDay -> Builder

216timeOfDayToBuilder (TimeOfDay h m s) = do

213timeOfDayToBuilder (TimeOfDay h m s) = do

217− pad2 h ++ char8 ':' ++ pad2 m ++ char8 ':' ++ showSeconds s

214+ pad2 h <> char8 ':' <> pad2 m <> char8 ':' <> showSeconds s

218

215

219timeZoneToBuilder :: TimeZone -> Builder

216timeZoneToBuilder :: TimeZone -> Builder

220timeZoneToBuilder tz

217timeZoneToBuilder tz

221− | m == 0 = sign h ++ pad2 (abs h)

218+ | m == 0 = sign h <> pad2 (abs h)

222− | otherwise = sign h ++ pad2 (abs h) ++ char8 ':' ++ pad2 (abs m)

219+ | otherwise = sign h <> pad2 (abs h) <> char8 ':' <> pad2 (abs m)

223 where

220 where

224 (h,m) = timeZoneMinutes tz `quotRem` 60

221 (h,m) = timeZoneMinutes tz `quotRem` 60

225 sign h | h >= 0 = char8 '+'

222 sign h | h >= 0 = char8 '+'

@@ -227,16 +224,16 @@ timeZoneToBuilder tz

227

224

228utcTimeToBuilder :: UTCTime -> Builder

225utcTimeToBuilder :: UTCTime -> Builder

229utcTimeToBuilder (UTCTime day time) =

226utcTimeToBuilder (UTCTime day time) =

230− dayToBuilder day ++ char8 ' '

227+ dayToBuilder day <> char8 ' '

231− ++ timeOfDayToBuilder (timeToTimeOfDay time) ++ byteString "+00"

228+ <> timeOfDayToBuilder (timeToTimeOfDay time) <> byteString "+00"

232

229

233zonedTimeToBuilder :: ZonedTime -> Builder

230zonedTimeToBuilder :: ZonedTime -> Builder

234zonedTimeToBuilder (ZonedTime localTime tz) =

231zonedTimeToBuilder (ZonedTime localTime tz) =

235− localTimeToBuilder localTime ++ timeZoneToBuilder tz

232+ localTimeToBuilder localTime <> timeZoneToBuilder tz

236

233

237localTimeToBuilder :: LocalTime -> Builder

234localTimeToBuilder :: LocalTime -> Builder

238localTimeToBuilder (LocalTime day tod) =

235localTimeToBuilder (LocalTime day tod) =

239− dayToBuilder day ++ char8 ' ' ++ timeOfDayToBuilder tod

236+ dayToBuilder day <> char8 ' ' <> timeOfDayToBuilder tod

240

237

241unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

238unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

242unboundedToBuilder finiteToBuilder unbounded

239unboundedToBuilder finiteToBuilder unbounded

@@ -259,8 +256,8 @@ dateToBuilder = unboundedToBuilder dayToBuilder

259

256

260nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

257nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

261nominalDiffTimeToBuilder xyz

258nominalDiffTimeToBuilder xyz

262− | yz < 500000 = sign ++ integerDec x

259+ | yz < 500000 = sign <> integerDec x

263− | otherwise = sign ++ integerDec x ++ char8 '.' ++ showD6 y

260+ | otherwise = sign <> integerDec x <> char8 '.' <> showD6 y

264 where

261 where

265 -- A kludge to work around the fact that Data.Fixed isn't very fast and

262 -- A kludge to work around the fact that Data.Fixed isn't very fast and

266 -- doesn't give me access to the MkFixed constructor.

263 -- doesn't give me access to the MkFixed constructor.

@@ -271,8 +268,8 @@ nominalDiffTimeToBuilder xyz

271showSeconds :: Pico -> Builder

268showSeconds :: Pico -> Builder

272showSeconds xyz

269showSeconds xyz

273 | yz == 0 = pad2 x

270 | yz == 0 = pad2 x

274− | z == 0 = pad2 x ++ char8 '.' ++ showD6 y

271+ | z == 0 = pad2 x <> char8 '.' <> showD6 y

275− | otherwise = pad2 x ++ char8 '.' ++ pad6 y ++ showD6 z

272+ | otherwise = pad2 x <> char8 '.' <> pad6 y <> showD6 z

276 where

273 where

277 -- A kludge to work around the fact that Data.Fixed isn't very fast and

274 -- A kludge to work around the fact that Data.Fixed isn't very fast and

278 -- doesn't give me access to the MkFixed constructor.

275 -- doesn't give me access to the MkFixed constructor.

@@ -282,24 +279,24 @@ showSeconds xyz

282

279

283pad6 :: Int -> Builder

280pad6 :: Int -> Builder

284pad6 xy = let (x,y) = xy `quotRem` 1000

281pad6 xy = let (x,y) = xy `quotRem` 1000

285− in pad3 x ++ pad3 y

282+ in pad3 x <> pad3 y

286

283

287showD6 :: Int -> Builder

284showD6 :: Int -> Builder

288showD6 xy = case xy `quotRem` 1000 of

285showD6 xy = case xy `quotRem` 1000 of

289 (x,0) -> showD3 x

286 (x,0) -> showD3 x

290− (x,y) -> pad3 x ++ showD3 y

287+ (x,y) -> pad3 x <> showD3 y

291

288

292pad3 :: Int -> Builder

289pad3 :: Int -> Builder

293pad3 abc = let (ab,c) = abc `quotRem` 10

290pad3 abc = let (ab,c) = abc `quotRem` 10

294 (a,b) = ab `quotRem` 10

291 (a,b) = ab `quotRem` 10

295− in p a ++ p b ++ p c

292+ in p a <> p b <> p c

296

293

297showD3 :: Int -> Builder

294showD3 :: Int -> Builder

298showD3 abc = case abc `quotRem` 100 of

295showD3 abc = case abc `quotRem` 100 of

299 (a, 0) -> p a

296 (a, 0) -> p a

300 (a,bc) -> case bc `quotRem` 10 of

297 (a,bc) -> case bc `quotRem` 10 of

301− (b,0) -> p a ++ p b

298+ (b,0) -> p a <> p b

302− (b,c) -> p a ++ p b ++ p c

299+ (b,c) -> p a <> p b <> p c

303

300

304-- | p assumes its input is in the range [0..9]

301-- | p assumes its input is in the range [0..9]

305p :: Integral n => n -> Builder

302p :: Integral n => n -> Builder

@@ -308,13 +305,13 @@ p n = char8 (w2c (fromIntegral (n + 48)))

308

305

309-- | pad2 assumes its input is in the range [0..99]

306-- | pad2 assumes its input is in the range [0..99]

310pad2 :: Integral n => n -> Builder

307pad2 :: Integral n => n -> Builder

311−pad2 n = let (a,b) = n `quotRem` 10 in p a ++ p b

308+pad2 n = let (a,b) = n `quotRem` 10 in p a <> p b

312{-# INLINE pad2 #-}

309{-# INLINE pad2 #-}

313

310

314-- | pad4 assumes its input is positive

311-- | pad4 assumes its input is positive

315pad4 :: Integer -> Builder

312pad4 :: Integer -> Builder

316pad4 abcd | abcd >= 10000 = integerDec abcd

313pad4 abcd | abcd >= 10000 = integerDec abcd

317− | otherwise = p a ++ p b ++ p c ++ p d

314+ | otherwise = p a <> p b <> p c <> p d

318 where (ab,cd) = abcd `quotRem` 100

315 where (ab,cd) = abcd `quotRem` 100

319 (a,b) = ab `quotRem` 10

316 (a,b) = ab `quotRem` 10

320 (c,d) = cd `quotRem` 10

317 (c,d) = cd `quotRem` 10