eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Rename {render,parse}Time FTime

Browse source
This commit is contained in:
Alex Mason 2016-09-02 16:16:41 +10:00
parent 518a2715be
commit 7293717a0d
2 changed files with 18 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant/src/Servant/API.hs
View file

@ -83,7 +83,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
HList (..), Headers (..), HList (..), Headers (..),
getHeadersHList, getResponse) getHeadersHList, getResponse)
import Servant.API.Sub ((:>)) import Servant.API.Sub ((:>))
import Servant.API.Times (FTime(..), getFormat, renderTime, parseTime) import Servant.API.Times (FTime(..), getFormat, renderFTime, parseFTime)
import Servant.API.Vault (Vault) import Servant.API.Vault (Vault)
import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted, import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted,
DeleteNoContent, DeleteNoContent,

36
servant/src/Servant/API/Times.hs
View file

@ -11,8 +11,8 @@ module Servant.API.Times
( FTime(..) ( FTime(..)
, toFormatProxy , toFormatProxy
, getFormat , getFormat
, renderTime , renderFTime
, parseTime , parseFTime
, ISO8601Date , ISO8601Date
, ISO8601DateTime , ISO8601DateTime
, ISO8601DateTimeZ , ISO8601DateTimeZ
@ -49,7 +49,7 @@ newtype FTime (format :: Symbol) t = FTime {getFTime :: t}
deriving (Typeable, Eq, Ord) deriving (Typeable, Eq, Ord)
instance (KnownSymbol format, T.FormatTime t) => Show (FTime format t) where instance (KnownSymbol format, T.FormatTime t) => Show (FTime format t) where
showsPrec i t = showParen (i > 1) (renderTime t ++) showsPrec i t = showParen (i > 1) (renderFTime t ++)
instance (KnownSymbol format, T.ParseTime t) => Read (FTime format t) where instance (KnownSymbol format, T.ParseTime t) => Read (FTime format t) where
readsPrec i str = res where readsPrec i str = res where
@ -61,15 +61,15 @@ instance (KnownSymbol format, T.ParseTime t) => Read (FTime format t) where
instance (KnownSymbol format, T.FormatTime t) => ToHttpApiData (FTime format t) where instance (KnownSymbol format, T.FormatTime t) => ToHttpApiData (FTime format t) where
toUrlPiece = toUrlPiece . renderTime toUrlPiece = toUrlPiece . renderFTime
toHeader = toHeader . renderTime toHeader = toHeader . renderFTime
toQueryParam = toQueryParam . renderTime toQueryParam = toQueryParam . renderFTime
instance (KnownSymbol format, T.ParseTime t) => FromHttpApiData (FTime format t) where instance (KnownSymbol format, T.ParseTime t) => FromHttpApiData (FTime format t) where
parseUrlPiece = parseUrlPiece >=> parseTime parseUrlPiece = parseUrlPiece >=> parseFTime
parseHeader = parseHeader >=> parseTime parseHeader = parseHeader >=> parseFTime
parseQueryParam = parseQueryParam >=> parseTime parseQueryParam = parseQueryParam >=> parseFTime
toFormatProxy :: FTime format t -> Proxy format toFormatProxy :: FTime format t -> Proxy format
@ -78,18 +78,14 @@ toFormatProxy _ = Proxy
getFormat :: KnownSymbol format => FTime format t -> String getFormat :: KnownSymbol format => FTime format t -> String
getFormat t = symbolVal (toFormatProxy t) getFormat t = symbolVal (toFormatProxy t)
renderTime :: (KnownSymbol format, T.FormatTime t) => FTime format t -> String renderFTime :: (KnownSymbol format, T.FormatTime t) => FTime format t -> String
renderTime tt@(FTime t) = T.formatTime T.defaultTimeLocale (getFormat tt) t renderFTime tt@(FTime t) = T.formatTime T.defaultTimeLocale (getFormat tt) t
parseTime :: (KnownSymbol format, T.ParseTime t) => String -> Either Text (FTime format t) parseFTime :: (KnownSymbol format, T.ParseTime t) => String -> Either Text (FTime format t)
parseTime str = res parseFTime str = res where
where res = case ptime T.defaultTimeLocale fmt str of
#if !MIN_VERSION_time(1,5,0) Nothing -> Left . pack $ "Could not parse time string \""
res = case T.parseTime T.defaultTimeLocale fmt str of ++ str ++ "\" with format \"" ++ fmt ++ "\""
#else
res = case T.parseTimeM False T.defaultTimeLocale fmt str of
#endif
Nothing -> Left . pack $ "Could not parse time string \"" ++ str ++ "\" with format \"" ++ fmt ++ "\""
Just t -> Right (FTime t) Just t -> Right (FTime t)
fmt = getFormat (toFTimeTy res) fmt = getFormat (toFTimeTy res)