{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE CPP                 #-}

module Distribution.Fedora.ReadProducts
  (getProductsFile)
where

import Control.Monad
import Data.Aeson(encode)
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Fedora.PDC (makeKey, pdcProductVersions)
import System.Directory
import System.FilePath ((</>))

getProductsFile :: IO FilePath
getProductsFile :: IO FilePath
getProductsFile = do
  FilePath
home <- IO FilePath
getHomeDirectory
  let dir :: FilePath
dir = FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
".fedora"
  Bool
dirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirectory FilePath
dir
  let file :: FilePath
file = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"product-versions-2.json"
  Bool
recent <- do
    Bool
have <- FilePath -> IO Bool
doesFileExist FilePath
file
    if Bool
have then do
      UTCTime
ts <- FilePath -> IO UTCTime
getModificationTime FilePath
file
      UTCTime
t <- IO UTCTime
getCurrentTime
      -- about 5.5 hours
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
ts NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
20000
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
recent (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> Query -> IO [Object]
pdcProductVersions FilePath
"pdc.fedoraproject.org" (FilePath -> FilePath -> Query
makeKey FilePath
"active" FilePath
"true") IO [Object] -> ([Object] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    FilePath -> ByteString -> IO ()
BL.writeFile FilePath
file (ByteString -> IO ())
-> ([Object] -> ByteString) -> [Object] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Object] -> ByteString
forall a. ToJSON a => a -> ByteString
encode
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file