{- |
   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  portable
 -}

module Distribution.Hackage.DB.Utility where

import Distribution.Hackage.DB.Errors

import Codec.Archive.Tar.Entry as Tar
import Control.Exception
import Control.Monad.Fail
import Data.Maybe
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Format
import Distribution.Parsec

parseText :: Parsec a => String -> String -> a
parseText :: String -> String -> a
parseText String
t String
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (InvalidRepresentationOfType -> a
forall a e. Exception e => e -> a
throw (String -> String -> InvalidRepresentationOfType
InvalidRepresentationOfType String
t String
x)) (String -> Maybe a
forall a. Parsec a => String -> Maybe a
simpleParsec String
x)

-- | Convert the the 'EpochTime' used by the @tar@ library into a standard
-- 'UTCTime' type.

fromEpochTime :: EpochTime -> UTCTime
fromEpochTime :: EpochTime -> UTCTime
fromEpochTime EpochTime
et = POSIXTime -> UTCTime
posixSecondsToUTCTime (EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac EpochTime
et)

-- | Convert the standard 'UTCTime' type into the 'EpochTime' used by the @tar@
-- library.

toEpochTime :: UTCTime -> EpochTime
toEpochTime :: UTCTime -> EpochTime
toEpochTime = POSIXTime -> EpochTime
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> EpochTime)
-> (UTCTime -> POSIXTime) -> UTCTime -> EpochTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

-- | Parse an UTC timestamp in extended ISO8601 format a standard 'UTCTime'
-- type. This function is useful to parse the "snapshot" identifier printed by
-- @cabal-install@ after a database update into a useable type. Combine with
-- 'toEpochTime' to obtain an 'EpochTime' that can be passed to the Hackage DB
-- reading code from this library.
--
-- >>> parseIso8601 "2018-12-21T13:17:40Z"
-- 2018-12-21 13:17:40 UTC

parseIso8601 :: MonadFail m => String -> m UTCTime
parseIso8601 :: String -> m UTCTime
parseIso8601 = Bool -> TimeLocale -> String -> String -> m UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%SZ"))