content: {-# LANGUAGE NoImplicitPrelude #-}
  module Import
      ( module Import
      ) where
  
  import ClassyPrelude.Yesod as Import hiding (getCurrentTime)
  import Foundation as Import
  import Settings as Import
  import Settings.StaticFiles as Import
  import Types as Import
  import Yesod.Auth as Import
  import Data.WebsiteContent as Import (WebsiteContent (..), Post (..))
  import Data.Text.Read (decimal)
  import RIO.Time (diffUTCTime, getCurrentTime)
  --import qualified Prometheus as P
  import Stackage.Database.Types (ModuleListingInfo(..))
  import Formatting (format)
  import Formatting.Time (diff)
  import Yesod.GitRepo (grContent)
  
  parseLtsPair :: Text -> Maybe (Int, Int)
  parseLtsPair t1 = do
      (x, t2) <- either (const Nothing) Just $ decimal t1
      t3 <- stripPrefix "." t2
      (y, "") <- either (const Nothing) Just $ decimal t3
      Just (x, y)
  
  packageUrl :: SnapName -> PackageNameP -> VersionP -> Route App
  packageUrl sname pkgname pkgver = SnapshotR sname sdistR
    where
      sdistR = StackageSdistR (PNVNameVersion pkgname pkgver)
  
  haddockUrl :: SnapName -> ModuleListingInfo -> Route App
  haddockUrl sname mli =
      HaddockR
          sname
          [toPathPiece (mliPackageIdentifier mli), toPathPiece (mliModuleName mli) <> ".html"]
  
  hoogleHaddockUrl :: SnapName -> PackageNameP -> ModuleNameP -> Route App
  hoogleHaddockUrl sname pname mname = HaddockR sname [toPathPiece pname, toPathPiece mname <> ".html"]
  
  track
      :: MonadIO m
      => String -> m a -> m a
  track _ = id
  {- FIXME prometheus isn't in Stackage anymore
  track name inner = do
      start <- liftIO getCurrentTime
      result <- inner
      end <- liftIO getCurrentTime
      let latency = fromRational $ toRational (end `diffUTCTime` start) * 1000000
      liftIO (P.withLabel name (P.observe latency) duration)
      return result
    where
      {-# NOINLINE duration #-}
      duration :: P.Metric (P.Vector P.Label1 P.Histogram)
      duration =
          P.unsafeRegisterIO
              (P.vector
                   "fn"
                   (P.histogram
                        (P.Info
                             "stackage_server_fn"
                             "Stackage Server function call (duration in microseconds).")
                        P.defaultBuckets))
  -}
  
  dateDiff :: UTCTime -- ^ now
           -> Day -- ^ target
           -> Text
  dateDiff (UTCTime now' _) target
      | now' == target = "today"
      | otherwise = toStrict $ format (diff True) $ diffUTCTime
          (UTCTime target 0)
          (UTCTime now' 0)
  
  getPosts :: Handler (Vector Post)
  getPosts = do
      now <- getCurrentTime
      posts <- getYesod >>= fmap wcPosts . liftIO . grContent . appWebsiteContent
      mpreview <- lookupGetParam "preview"
      case mpreview of
          Just "true" -> return posts
          _ -> return $ filter (\p -> postTime p <= now) posts
  
  postYear :: Post -> Year
  postYear p =
      let (y, _, _) = toGregorian $ utctDay $ postTime p
       in fromInteger y
  
  postMonth :: Post -> Month
  postMonth p =
      let (_, m, _) = toGregorian $ utctDay $ postTime p
       in Month m
  