@@ -1,4 +1,4 @@
1−{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
1+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverloadedStrings #-}
22module Web.PathPieces
33 ( PathPiece (..)
44 , PathMultiPiece (..)
@@ -14,6 +14,7 @@ import qualified Data.Text as S
1414import qualified Data.Text.Lazy as L
1515import qualified Data.Text.Read
1616import Data.Time (Day)
17+import Control.Exception (assert)
1718
1819class PathPiece s where
1920 fromPathPiece :: S.Text -> Maybe s
@@ -34,29 +35,29 @@ instance PathPiece L.Text where
3435instance PathPiece Integer where
3536 fromPathPiece s =
3637 case Data.Text.Read.signed Data.Text.Read.decimal s of
37− Right (i, _) -> Just i
38− Left _ -> Nothing
38+ Right (i, "") -> Just i
39+ _ -> Nothing
3940 toPathPiece = S.pack . show
4041
4142instance PathPiece Int where
4243 fromPathPiece s =
4344 case Data.Text.Read.signed Data.Text.Read.decimal s of
44− Right (i, _) -> Just i
45− Left _ -> Nothing
45+ Right (i, "") -> Just i
46+ _ -> Nothing
4647 toPathPiece = S.pack . show
4748
4849instance PathPiece Bool where
4950 fromPathPiece t =
50− case reads $ S.unpack t of
51− [(a,"")] -> Just a
51+ case filter (null . snd) $ reads $ S.unpack t of
52+ (a, s):_ -> assert (null s) (Just a)
5253 _ -> Nothing
5354 toPathPiece = S.pack . show
5455
5556instance PathPiece Int64 where
5657 fromPathPiece s =
5758 case Data.Text.Read.signed Data.Text.Read.decimal s of
58− Right (i, _) -> Just i
59− Left _ -> Nothing
59+ Right (i, "") -> Just i
60+ _ -> Nothing
6061 toPathPiece = S.pack . show
6162
6263instance PathPiece Day where