{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedRecordDot #-}

-- | This module contains all the types related to the idea of installing a

-- package in the pkg-db or an executable on the file system.

module Stack.Types.Installed
  ( InstallLocation (..)
  , InstalledPackageLocation (..)
  , PackageDatabase (..)
  , PackageDbVariety (..)
  , InstallMap
  , Installed (..)
  , InstalledMap
  , InstalledLibraryInfo (..)
  , toPackageDbVariety
  , installedLibraryInfoFromGhcPkgId
  , simpleInstalledLib
  , installedToPackageIdOpt
  , installedPackageIdentifier
  , installedVersion
  , foldOnGhcPkgId'
  ) where

import qualified Data.Map as M
import qualified Distribution.SPDX.License as SPDX
import           Distribution.License ( License )
import           Stack.Prelude
import           Stack.Types.ComponentUtils ( StackUnqualCompName )
import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )

-- | Type representing user package databases that packages can be installed

-- into.

data InstallLocation
  = Snap
    -- ^ The write-only package database, formerly known as the snapshot

    -- database.

  | Local
    -- ^ The mutable package database, formerly known as the local database.

  deriving (InstallLocation -> InstallLocation -> Bool
(InstallLocation -> InstallLocation -> Bool)
-> (InstallLocation -> InstallLocation -> Bool)
-> Eq InstallLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallLocation -> InstallLocation -> Bool
== :: InstallLocation -> InstallLocation -> Bool
$c/= :: InstallLocation -> InstallLocation -> Bool
/= :: InstallLocation -> InstallLocation -> Bool
Eq, Int -> InstallLocation -> ShowS
[InstallLocation] -> ShowS
InstallLocation -> String
(Int -> InstallLocation -> ShowS)
-> (InstallLocation -> String)
-> ([InstallLocation] -> ShowS)
-> Show InstallLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallLocation -> ShowS
showsPrec :: Int -> InstallLocation -> ShowS
$cshow :: InstallLocation -> String
show :: InstallLocation -> String
$cshowList :: [InstallLocation] -> ShowS
showList :: [InstallLocation] -> ShowS
Show)

instance Semigroup InstallLocation where
  InstallLocation
Local <> :: InstallLocation -> InstallLocation -> InstallLocation
<> InstallLocation
_ = InstallLocation
Local
  InstallLocation
_ <> InstallLocation
Local = InstallLocation
Local
  InstallLocation
Snap <> InstallLocation
Snap = InstallLocation
Snap

instance Monoid InstallLocation where
  mempty :: InstallLocation
mempty = InstallLocation
Snap
  mappend :: InstallLocation -> InstallLocation -> InstallLocation
mappend = InstallLocation -> InstallLocation -> InstallLocation
forall a. Semigroup a => a -> a -> a
(<>)

-- | Type representing user (non-global) package databases that can provide

-- installed packages.

data InstalledPackageLocation
  = InstalledTo InstallLocation
    -- ^ A package database that a package can be installed into.

  | ExtraPkgDb
    -- ^ An \'extra\' package database, specified by @extra-package-dbs@.

  deriving (InstalledPackageLocation -> InstalledPackageLocation -> Bool
(InstalledPackageLocation -> InstalledPackageLocation -> Bool)
-> (InstalledPackageLocation -> InstalledPackageLocation -> Bool)
-> Eq InstalledPackageLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
== :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
$c/= :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
/= :: InstalledPackageLocation -> InstalledPackageLocation -> Bool
Eq, Int -> InstalledPackageLocation -> ShowS
[InstalledPackageLocation] -> ShowS
InstalledPackageLocation -> String
(Int -> InstalledPackageLocation -> ShowS)
-> (InstalledPackageLocation -> String)
-> ([InstalledPackageLocation] -> ShowS)
-> Show InstalledPackageLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstalledPackageLocation -> ShowS
showsPrec :: Int -> InstalledPackageLocation -> ShowS
$cshow :: InstalledPackageLocation -> String
show :: InstalledPackageLocation -> String
$cshowList :: [InstalledPackageLocation] -> ShowS
showList :: [InstalledPackageLocation] -> ShowS
Show)

-- | Type representing package databases that can provide installed packages.

data PackageDatabase
  = GlobalPkgDb
    -- ^ GHC's global package database.

  | UserPkgDb InstalledPackageLocation (Path Abs Dir)
    -- ^ A user package database.

  deriving (PackageDatabase -> PackageDatabase -> Bool
(PackageDatabase -> PackageDatabase -> Bool)
-> (PackageDatabase -> PackageDatabase -> Bool)
-> Eq PackageDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDatabase -> PackageDatabase -> Bool
== :: PackageDatabase -> PackageDatabase -> Bool
$c/= :: PackageDatabase -> PackageDatabase -> Bool
/= :: PackageDatabase -> PackageDatabase -> Bool
Eq, Int -> PackageDatabase -> ShowS
[PackageDatabase] -> ShowS
PackageDatabase -> String
(Int -> PackageDatabase -> ShowS)
-> (PackageDatabase -> String)
-> ([PackageDatabase] -> ShowS)
-> Show PackageDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDatabase -> ShowS
showsPrec :: Int -> PackageDatabase -> ShowS
$cshow :: PackageDatabase -> String
show :: PackageDatabase -> String
$cshowList :: [PackageDatabase] -> ShowS
showList :: [PackageDatabase] -> ShowS
Show)

-- | A function to yield the variety of package database for a given

-- package database that can provide installed packages.

toPackageDbVariety :: PackageDatabase -> PackageDbVariety
toPackageDbVariety :: PackageDatabase -> PackageDbVariety
toPackageDbVariety PackageDatabase
GlobalPkgDb = PackageDbVariety
GlobalDb
toPackageDbVariety (UserPkgDb InstalledPackageLocation
ExtraPkgDb Path Abs Dir
_) = PackageDbVariety
ExtraDb
toPackageDbVariety (UserPkgDb (InstalledTo InstallLocation
Snap) Path Abs Dir
_) = PackageDbVariety
WriteOnlyDb
toPackageDbVariety (UserPkgDb (InstalledTo InstallLocation
Local) Path Abs Dir
_) = PackageDbVariety
MutableDb

-- | Type representing varieties of package databases that can provide

-- installed packages.

data PackageDbVariety
  = GlobalDb
    -- ^ GHC's global package database.

  | ExtraDb
    -- ^ An \'extra\' package database, specified by @extra-package-dbs@.

  | WriteOnlyDb
    -- ^ The write-only package database, for immutable packages.

  | MutableDb
    -- ^ The mutable package database.

  deriving (PackageDbVariety -> PackageDbVariety -> Bool
(PackageDbVariety -> PackageDbVariety -> Bool)
-> (PackageDbVariety -> PackageDbVariety -> Bool)
-> Eq PackageDbVariety
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDbVariety -> PackageDbVariety -> Bool
== :: PackageDbVariety -> PackageDbVariety -> Bool
$c/= :: PackageDbVariety -> PackageDbVariety -> Bool
/= :: PackageDbVariety -> PackageDbVariety -> Bool
Eq, Int -> PackageDbVariety -> ShowS
[PackageDbVariety] -> ShowS
PackageDbVariety -> String
(Int -> PackageDbVariety -> ShowS)
-> (PackageDbVariety -> String)
-> ([PackageDbVariety] -> ShowS)
-> Show PackageDbVariety
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDbVariety -> ShowS
showsPrec :: Int -> PackageDbVariety -> ShowS
$cshow :: PackageDbVariety -> String
show :: PackageDbVariety -> String
$cshowList :: [PackageDbVariety] -> ShowS
showList :: [PackageDbVariety] -> ShowS
Show)

-- | Type synonym representing dictionaries of package names for a project's

-- packages and dependencies, and pairs of their relevant database (write-only

-- or mutable) and package versions.

type InstallMap = Map PackageName (InstallLocation, Version)

-- | Type synonym representing dictionaries of package names, and a pair of in

-- which package database the package is installed (write-only or mutable) and

-- information about what is installed.

type InstalledMap = Map PackageName (InstallLocation, Installed)

data InstalledLibraryInfo = InstalledLibraryInfo
  { InstalledLibraryInfo -> GhcPkgId
ghcPkgId :: GhcPkgId
  , InstalledLibraryInfo -> Maybe (Either License License)
license :: Maybe (Either SPDX.License License)
  , InstalledLibraryInfo -> Map StackUnqualCompName GhcPkgId
subLib :: Map StackUnqualCompName GhcPkgId
  }
  deriving (InstalledLibraryInfo -> InstalledLibraryInfo -> Bool
(InstalledLibraryInfo -> InstalledLibraryInfo -> Bool)
-> (InstalledLibraryInfo -> InstalledLibraryInfo -> Bool)
-> Eq InstalledLibraryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstalledLibraryInfo -> InstalledLibraryInfo -> Bool
== :: InstalledLibraryInfo -> InstalledLibraryInfo -> Bool
$c/= :: InstalledLibraryInfo -> InstalledLibraryInfo -> Bool
/= :: InstalledLibraryInfo -> InstalledLibraryInfo -> Bool
Eq, Int -> InstalledLibraryInfo -> ShowS
[InstalledLibraryInfo] -> ShowS
InstalledLibraryInfo -> String
(Int -> InstalledLibraryInfo -> ShowS)
-> (InstalledLibraryInfo -> String)
-> ([InstalledLibraryInfo] -> ShowS)
-> Show InstalledLibraryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstalledLibraryInfo -> ShowS
showsPrec :: Int -> InstalledLibraryInfo -> ShowS
$cshow :: InstalledLibraryInfo -> String
show :: InstalledLibraryInfo -> String
$cshowList :: [InstalledLibraryInfo] -> ShowS
showList :: [InstalledLibraryInfo] -> ShowS
Show)

-- | Type representing information about what is installed.

data Installed
  = Library PackageIdentifier InstalledLibraryInfo
    -- ^ A library, including its installed package id and, optionally, its

    -- license.

  | Executable PackageIdentifier
    -- ^ An executable.

  deriving (Installed -> Installed -> Bool
(Installed -> Installed -> Bool)
-> (Installed -> Installed -> Bool) -> Eq Installed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Installed -> Installed -> Bool
== :: Installed -> Installed -> Bool
$c/= :: Installed -> Installed -> Bool
/= :: Installed -> Installed -> Bool
Eq, Int -> Installed -> ShowS
[Installed] -> ShowS
Installed -> String
(Int -> Installed -> ShowS)
-> (Installed -> String)
-> ([Installed] -> ShowS)
-> Show Installed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Installed -> ShowS
showsPrec :: Int -> Installed -> ShowS
$cshow :: Installed -> String
show :: Installed -> String
$cshowList :: [Installed] -> ShowS
showList :: [Installed] -> ShowS
Show)

installedLibraryInfoFromGhcPkgId :: GhcPkgId -> InstalledLibraryInfo
installedLibraryInfoFromGhcPkgId :: GhcPkgId -> InstalledLibraryInfo
installedLibraryInfoFromGhcPkgId GhcPkgId
ghcPkgId =
  GhcPkgId
-> Maybe (Either License License)
-> Map StackUnqualCompName GhcPkgId
-> InstalledLibraryInfo
InstalledLibraryInfo GhcPkgId
ghcPkgId Maybe (Either License License)
forall a. Maybe a
Nothing Map StackUnqualCompName GhcPkgId
forall a. Monoid a => a
mempty

simpleInstalledLib ::
     PackageIdentifier
  -> GhcPkgId
  -> Map StackUnqualCompName GhcPkgId
  -> Installed
simpleInstalledLib :: PackageIdentifier
-> GhcPkgId -> Map StackUnqualCompName GhcPkgId -> Installed
simpleInstalledLib PackageIdentifier
pkgIdentifier GhcPkgId
ghcPkgId =
  PackageIdentifier -> InstalledLibraryInfo -> Installed
Library PackageIdentifier
pkgIdentifier (InstalledLibraryInfo -> Installed)
-> (Map StackUnqualCompName GhcPkgId -> InstalledLibraryInfo)
-> Map StackUnqualCompName GhcPkgId
-> Installed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcPkgId
-> Maybe (Either License License)
-> Map StackUnqualCompName GhcPkgId
-> InstalledLibraryInfo
InstalledLibraryInfo GhcPkgId
ghcPkgId Maybe (Either License License)
forall a. Maybe a
Nothing

installedToPackageIdOpt :: InstalledLibraryInfo -> [String]
installedToPackageIdOpt :: InstalledLibraryInfo -> [String]
installedToPackageIdOpt InstalledLibraryInfo
libInfo =
  (GhcPkgId -> [String] -> [String])
-> [String] -> Map StackUnqualCompName GhcPkgId -> [String]
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr' (([String] -> [String] -> [String])
-> GhcPkgId -> [String] -> [String]
forall {f :: * -> *} {t} {t}.
Applicative f =>
(f String -> t -> t) -> GhcPkgId -> t -> t
iterator [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++)) (String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ GhcPkgId -> String
toStr InstalledLibraryInfo
libInfo.ghcPkgId) InstalledLibraryInfo
libInfo.subLib
 where
  toStr :: GhcPkgId -> String
toStr GhcPkgId
ghcPkgId = String
"-package-id=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> String
ghcPkgIdString GhcPkgId
ghcPkgId
  iterator :: (f String -> t -> t) -> GhcPkgId -> t -> t
iterator f String -> t -> t
op GhcPkgId
ghcPkgId t
acc = String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GhcPkgId -> String
toStr GhcPkgId
ghcPkgId) f String -> t -> t
`op` t
acc

installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier :: Installed -> PackageIdentifier
installedPackageIdentifier (Library PackageIdentifier
pid InstalledLibraryInfo
_) = PackageIdentifier
pid
installedPackageIdentifier (Executable PackageIdentifier
pid) = PackageIdentifier
pid

-- | A strict fold over the 'GhcPkgId' of the given installed package. This will

-- iterate on both sub and main libraries, if any.

foldOnGhcPkgId' ::
     (Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT)
  -> Installed
  -> resT
  -> resT
foldOnGhcPkgId' :: forall resT.
(Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT)
-> Installed -> resT -> resT
foldOnGhcPkgId' Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT
_ Executable{} resT
res = resT
res
foldOnGhcPkgId' Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT
fn (Library PackageIdentifier
_ InstalledLibraryInfo
libInfo) resT
res =
  (StackUnqualCompName -> GhcPkgId -> resT -> resT)
-> resT -> Map StackUnqualCompName GhcPkgId -> resT
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey' (Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT
fn (Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT)
-> (StackUnqualCompName -> Maybe StackUnqualCompName)
-> StackUnqualCompName
-> GhcPkgId
-> resT
-> resT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackUnqualCompName -> Maybe StackUnqualCompName
forall a. a -> Maybe a
Just) (resT -> resT
base resT
res) InstalledLibraryInfo
libInfo.subLib
 where
  base :: resT -> resT
base = Maybe StackUnqualCompName -> GhcPkgId -> resT -> resT
fn Maybe StackUnqualCompName
forall a. Maybe a
Nothing InstalledLibraryInfo
libInfo.ghcPkgId

-- | Get the installed Version.

installedVersion :: Installed -> Version
installedVersion :: Installed -> Version
installedVersion Installed
i =
  let PackageIdentifier PackageName
_ Version
version = Installed -> PackageIdentifier
installedPackageIdentifier Installed
i
  in  Version
version