content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE RecordWildCards #-}
  module Stackage.Database.Types
      ( SnapName(..)
      , isLts
      , isNightly
      , SnapshotBranch(..)
      , snapshotPrettyName
      , snapshotPrettyNameShort
      , CompilerP(..)
      , FlagNameP(..)
      , StackageCron(..)
      , PantryCabal(..)
      , BlobKey(..)
      , GenericPackageDescription
      , toPackageIdentifierRevision
      , PantryPackage(..)
      , SnapshotFile(..)
      , SnapshotPackageInfo(..)
      , SnapshotPackagePageInfo(..)
      , spiVersionRev
      , HackageCabalInfo(..)
      , PackageListingInfo(..)
      , ModuleListingInfo(..)
      , PackageNameP(..)
      , VersionP(..)
      , Revision(..)
      , VersionRangeP(..)
      , PackageIdentifierP(..)
      , VersionRev(..)
      , toRevMaybe
      , toVersionRev
      , toVersionMRev
      , PackageVersionRev(..)
      , dropVersionRev
      , ModuleNameP(..)
      , SafeFilePath
      , Origin(..)
      , LatestInfo(..)
      , Deprecation(..)
      , defHaddockBucketName
      , defHaddockBucketUrl
      , Changelog(..)
      , Readme(..)
      , StackageCronOptions(..)
      ) where
  
  import Data.Aeson
  import qualified Data.Text as T
  import Data.Text.Read (decimal)
  import Amazonka (Env)
  import Pantry (BlobKey(..), CabalFileInfo(..), FileSize(..),
                 HasPantryConfig(..), PantryConfig, PackageIdentifierRevision(..), TreeKey(..))
  import Pantry.SHA256 (fromHexText)
  import RIO
  import RIO.Process (HasProcessContext(..), ProcessContext)
  import RIO.Time (Day, utctDay)
  import Stackage.Database.Github (GithubRepo(..))
  import Stackage.Database.Schema
  import Text.Blaze (ToMarkup(..))
  import Types
  
  defHaddockBucketName :: Text
  defHaddockBucketName = "haddock.stackage.org"
  
  defHaddockBucketUrl :: Text
  defHaddockBucketUrl = "https://s3.amazonaws.com/" <> defHaddockBucketName
  
  data StackageCronOptions = StackageCronOptions
    { scoForceUpdate        :: !Bool
    , scoDownloadBucketName :: !Text
    , scoDownloadBucketUrl  :: !Text
    , scoUploadBucketName   :: !Text
    , scoDoNotUpload        :: !Bool
    , scoLogLevel           :: !LogLevel
    , scoSnapshotsRepo      :: !GithubRepo
    , scoReportProgress     :: !Bool
    , scoCacheCabalFiles    :: !Bool
    }
  
  data StackageCron = StackageCron
      { scPantryConfig       :: !PantryConfig
      , scStackageRoot       :: !FilePath
      , scLogFunc            :: !LogFunc
      , scProcessContext     :: !ProcessContext
      , scForceFullUpdate    :: !Bool
      , scCachedGPD          :: !(IORef (IntMap GenericPackageDescription))
      , scEnvAWS             :: !Env
      , scDownloadBucketName :: !Text
      , scDownloadBucketUrl  :: !Text
      , scUploadBucketName   :: !Text
      , scSnapshotsRepo      :: !GithubRepo
      , scReportProgress     :: !Bool
      , scCacheCabalFiles    :: !Bool
      , scHoogleVersionId    :: !VersionId
      }
  
  instance HasLogFunc StackageCron where
      logFuncL = lens scLogFunc (\c f -> c {scLogFunc = f})
  
  instance HasProcessContext StackageCron where
      processContextL = lens scProcessContext (\c f -> c {scProcessContext = f})
  
  instance HasPantryConfig StackageCron where
      pantryConfigL = lens scPantryConfig (\c f -> c {scPantryConfig = f})
  
  
  
  data SnapshotFile = SnapshotFile
      { sfCompiler    :: !CompilerP
      , sfPackages    :: ![PantryPackage]
      , sfHidden      :: !(Map PackageNameP Bool)
      , sfFlags       :: !(Map PackageNameP (Map FlagNameP Bool))
      , sfPublishDate :: !(Maybe Day)
      } deriving (Show)
  
  
  -- Is this a reference to a cabal file stored in Pantry?
  data PantryCabal = PantryCabal
      { pcPackageName :: !PackageNameP
      , pcVersion     :: !VersionP
      , pcCabalKey    :: !BlobKey
      } deriving (Show)
  
  instance Display PantryCabal where
      display PantryCabal {..} =
          display (PackageIdentifierP pcPackageName pcVersion) <> "@sha256:" <>
          display pcCabalKey
  
  instance ToMarkup PantryCabal where
      toMarkup = toMarkup . textDisplay
  
  -- A Cabal file (package name, version, blob) and source tree
  data PantryPackage = PantryPackage
      { ppPantryCabal :: !PantryCabal
      , ppPantryKey   :: !TreeKey
      } deriving (Show)
  
  toPackageIdentifierRevision :: PantryCabal -> PackageIdentifierRevision
  toPackageIdentifierRevision PantryCabal {..} =
      PackageIdentifierRevision
          (unPackageNameP pcPackageName)
          (unVersionP pcVersion)
          (CFIHash sha (Just size))
    where
      BlobKey sha size = pcCabalKey
  
  -- QUESTION: Potentially switch to `parsePackageIdentifierRevision`:
     -- PackageIdentifierRevision pn v (CFIHash sha (Just size)) <-
     --     either (fail . displayException) pure $ parsePackageIdentifierRevision txt
     -- return (PantryCabal pn v sha size)
  -- Issues with such switch:
  --  * CFILatest and CFIRevision do not make sense in stackage-snapshots
  --  * Implementation below is faster
  instance FromJSON PantryCabal where
      parseJSON =
          withText "PantryCabal" $ \txt -> do
              let (packageTxt, hashWithSize) = T.break (== '@') txt
                  (hashTxtWithAlgo, sizeWithComma) = T.break (== ',') hashWithSize
              -- Split package identifier foo-bar-0.1.2 into package name and version
              (pkgNameTxt, pkgVersionTxt) <-
                  case T.breakOnEnd "-" packageTxt of
                      (pkgNameWithDashEnd, pkgVersionTxt)
                          | Just pkgName <- T.stripSuffix "-" pkgNameWithDashEnd ->
                              return (pkgName, pkgVersionTxt)
                      _ -> fail $ "Invalid package identifier format: " ++ T.unpack packageTxt
              pcPackageName <- parseJSON $ String pkgNameTxt
              pcVersion <- parseJSON $ String pkgVersionTxt
              hashTxt <-
                  maybe (fail $ "Unrecognized hashing algorithm: " ++ T.unpack hashTxtWithAlgo) pure $
                  T.stripPrefix "@sha256:" hashTxtWithAlgo
              pcSHA256 <- either (fail . displayException) pure $ fromHexText hashTxt
              (pcFileSize, "") <-
                  either fail (pure . first FileSize) =<<
                  maybe
                      (fail $ "Wrong size format:" ++ show sizeWithComma)
                      (pure . decimal)
                      (T.stripPrefix "," sizeWithComma)
              let pcCabalKey = BlobKey pcSHA256 pcFileSize
              return PantryCabal {..}
  
  
  instance FromJSON PantryPackage where
      parseJSON =
          withObject "PantryPackage" $ \obj ->
              PantryPackage <$> obj .: "hackage" <*> obj .: "pantry-tree"
  
  
  instance FromJSON SnapshotFile where
      parseJSON =
          withObject "SnapshotFile" $ \obj -> do
              sfCompiler <-
                  obj .:? "resolver" >>= \case
                      Just resolverCompiler -> resolverCompiler .: "compiler"
                      Nothing -> obj .: "compiler"
              sfPackages <- obj .: "packages"
              sfHidden <- obj .:? "hidden" .!= mempty
              sfFlags <- obj .:? "flags" .!= mempty
              sfPublishDate <- fmap utctDay <$> obj .:? "publish-time"
              pure SnapshotFile {..}
  
  
  data PackageListingInfo = PackageListingInfo
      { pliName     :: !PackageNameP
      , pliVersion  :: !VersionP
      , pliSynopsis :: !Text
      , pliOrigin   :: !Origin
      } deriving Show
  
  
  instance ToJSON PackageListingInfo where
      toJSON PackageListingInfo {..} =
          object
              [ "name"     .= pliName
              , "version"  .= pliVersion
              , "synopsis" .= pliSynopsis
              , "origin"   .= pliOrigin
              ]
  
  
  data HackageCabalInfo = HackageCabalInfo
      { hciCabalId     :: !HackageCabalId
      , hciCabalBlobId :: !BlobId
      , hciPackageName :: !PackageNameP
      , hciVersionRev  :: !VersionRev
      } deriving (Show, Eq)
  
  data SnapshotPackageInfo = SnapshotPackageInfo
      { spiSnapshotPackageId :: !SnapshotPackageId
      , spiSnapshotId        :: !SnapshotId
      , spiCabalBlobId       :: !(Maybe BlobId)
      , spiSnapName          :: !SnapName
      , spiPackageName       :: !PackageNameP
      , spiVersion           :: !VersionP
      , spiRevision          :: !(Maybe Revision)
      , spiOrigin            :: !Origin
      , spiReadme            :: !(Maybe TreeEntryId)
      , spiChangelog         :: !(Maybe TreeEntryId)
      } deriving (Show, Eq)
  
  
  data SnapshotPackagePageInfo = SnapshotPackagePageInfo
      { sppiSnapshotPackageInfo    :: !SnapshotPackageInfo
      -- ^ Info of the package on this page
      , sppiLatestHackageCabalInfo :: !(Maybe HackageCabalInfo)
      -- ^ If the package is available on hackage, show its latest info
      , sppiForwardDeps            :: ![(PackageNameP, VersionRangeP)]
      -- ^ Limited list of packages in the snapshot that this package depends on
      , sppiForwardDepsCount       :: !Int
      -- ^ Count of all packages in the snapshot that this package depends on
      , sppiReverseDeps            :: ![(PackageNameP, VersionRangeP)]
      -- ^ Limited list of packages in the snapshot that depend on this package
      , sppiReverseDepsCount       :: !Int
      -- ^ Count of all packages in the snapshot that depends on this package
      , sppiLatestInfo             :: ![LatestInfo]
      , sppiModuleNames            :: !(Map ModuleNameP Bool)
      , sppiPantryCabal            :: !(Maybe PantryCabal)
      , sppiVersion                :: !(Maybe VersionRev)
      -- ^ Version on this page. Should be present only if different from latest
      }
  
  toRevMaybe :: Revision -> Maybe Revision
  toRevMaybe rev = guard (rev /= Revision 0) >> Just rev
  
  -- | Add revision only if it is non-zero
  toVersionRev :: VersionP -> Revision -> VersionRev
  toVersionRev v = VersionRev v . toRevMaybe
  
  -- | Add revision only if it is present and is non-zero
  toVersionMRev :: VersionP -> Maybe Revision -> VersionRev
  toVersionMRev v mrev = VersionRev v (maybe Nothing toRevMaybe mrev)
  
  spiVersionRev :: SnapshotPackageInfo -> VersionRev
  spiVersionRev spi = VersionRev (spiVersion spi) (spiRevision spi >>= toRevMaybe)
  
  dropVersionRev :: PackageVersionRev -> PackageNameP
  dropVersionRev (PackageVersionRev pname _) = pname
  
  
  data ModuleListingInfo = ModuleListingInfo
      { mliModuleName        :: !ModuleNameP
      , mliPackageIdentifier :: !PackageIdentifierP
      } deriving Show
  
  
  data LatestInfo = LatestInfo
      { liSnapName   :: !SnapName
      , liVersionRev :: !VersionRev
      } deriving (Show, Eq)
  
  
  
  data Deprecation = Deprecation
      { depPackage    :: !PackageNameP
      , depInFavourOf :: !(Set PackageNameP)
      }
  instance ToJSON Deprecation where
      toJSON d = object
          [ "deprecated-package" .= depPackage d
          , "in-favour-of" .= depInFavourOf d
          ]
  instance FromJSON Deprecation where
      parseJSON = withObject "Deprecation" $ \o -> Deprecation
          <$> o .: "deprecated-package"
          <*> o .: "in-favour-of"
  
  
  data Readme = Readme !ByteString !Bool
  data Changelog = Changelog !ByteString !Bool
  