Skip to content

Commit ce38867

Browse files
committed
Re CLC issue 292 Avoid using partial init and last
1 parent 618b690 commit ce38867

File tree

2 files changed

+37
-14
lines changed

2 files changed

+37
-14
lines changed

lib/Data/Format.hs

+14-4
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE Safe #-}
23

34
module Data.Format (
@@ -26,6 +27,9 @@ module Data.Format (
2627

2728
import Control.Monad.Fail
2829
import Data.Char
30+
#if MIN_VERSION_base(4,19,0)
31+
import Data.List (unsnoc)
32+
#endif
2933
import Data.Void
3034
import Text.ParserCombinators.ReadP
3135
import Prelude hiding (fail)
@@ -227,11 +231,17 @@ zeroPad Nothing s = s
227231
zeroPad (Just i) s = replicate (i - length s) '0' ++ s
228232

229233
trimTrailing :: String -> String
230-
trimTrailing "" = ""
231234
trimTrailing "." = ""
232-
trimTrailing s
233-
| last s == '0' = trimTrailing $ init s
234-
trimTrailing s = s
235+
trimTrailing s = case unsnoc s of
236+
Nothing -> ""
237+
Just (initial, '0') -> trimTrailing initial
238+
_ -> s
239+
240+
#if !MIN_VERSION_base(4,19,0)
241+
unsnoc :: [a] -> Maybe ([a], a)
242+
unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
243+
{-# INLINABLE unsnoc #-}
244+
#endif
235245

236246
showNumber :: Show t => SignOption -> Maybe Int -> t -> Maybe String
237247
showNumber signOpt mdigitcount t =

test/unix/Test/Format/Format.hs

+23-10
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# OPTIONS -fno-warn-orphans #-}
23

34
module Test.Format.Format (
@@ -6,6 +7,9 @@ module Test.Format.Format (
67

78
import Data.Char
89
import Data.Fixed as F
10+
#if MIN_VERSION_base(4,19,0)
11+
import Data.List (unsnoc)
12+
#endif
913
import Data.Time
1014
import Data.Time.Clock.POSIX
1115
import Foreign
@@ -151,16 +155,25 @@ unixWorkarounds fmt s
151155
unixWorkarounds _ s = s
152156

153157
compareFormat :: (String -> String) -> String -> TimeZone -> UTCTime -> Result
154-
compareFormat _modUnix fmt zone _time
155-
| last fmt == 'Z' && timeZoneName zone == "" = rejected
156-
compareFormat modUnix fmt zone time =
157-
let
158-
ctime = utcToZonedTime zone time
159-
haskellText = formatTime locale fmt ctime
160-
unixText = unixFormatTime fmt zone time
161-
expectedText = unixWorkarounds fmt (modUnix unixText)
162-
in
163-
assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText
158+
compareFormat modUnix fmt zone time = case unsnoc fmt of
159+
Nothing ->
160+
error "compareFormat: The impossible happened! Format string is \"\"."
161+
Just (_, lastChar)
162+
| lastChar == 'Z' && timeZoneName zone == "" -> rejected
163+
| otherwise ->
164+
let
165+
ctime = utcToZonedTime zone time
166+
haskellText = formatTime locale fmt ctime
167+
unixText = unixFormatTime fmt zone time
168+
expectedText = unixWorkarounds fmt (modUnix unixText)
169+
in
170+
assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText
171+
172+
#if !MIN_VERSION_base(4,19,0)
173+
unsnoc :: [a] -> Maybe ([a], a)
174+
unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
175+
{-# INLINABLE unsnoc #-}
176+
#endif
164177

165178
-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
166179
-- plus FgGklz

0 commit comments

Comments
 (0)