{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK ignore-exports #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability : portable
-- Types used in this project.
module Distribution.ArchHs.Types
  ( PkgList,
    ComponentPkgList,
    CommunityDB,
    HackageEnv,
    CommunityEnv,
    FlagAssignmentsEnv,
    WithMyErr,
    MyException (..),
    DependencyType (..),
    DependencyKind (..),
    DependencyProvider (..),
    SolvedPackage (..),
    SolvedDependency (..),
    FlagAssignments,
    depProvider,
    pkgProvider,
    pkgName,
    pkgDeps,
    depName,
    depType,
    DependencyRecord,
    HasCallStack,
    module Polysemy,
    module Polysemy.Error,
    module Polysemy.Reader,
    module Polysemy.State,
    module Polysemy.Trace,
    module Lens.Micro,
  )
where

import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import Data.Set (Set)
import Distribution.Hackage.DB (HackageDB)
import Distribution.PackageDescription (FlagAssignment)
import Distribution.Pretty (prettyShow)
import Distribution.Types.PackageName (PackageName, unPackageName)
import Distribution.Types.UnqualComponentName (UnqualComponentName, unUnqualComponentName)
import Distribution.Types.Version (Version)
import Distribution.Version (VersionRange)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Lens.Micro
import Lens.Micro.TH (makeLenses)
import Polysemy
import Polysemy.Error
import Polysemy.Reader
import Polysemy.State
import Polysemy.Trace

-- | A list of 'PackageName'
type PkgList = [PackageName]

-- | A list of component represented by 'UnqualComponentName' and its dependencies collected in a 'PkgList'
type ComponentPkgList = [(UnqualComponentName, PkgList)]

-- | Representation of @cummunity.db@
type CommunityDB = Set String

-- | Reader effect of 'HackageDB'
type HackageEnv = Reader HackageDB

-- | Reader effect of 'CommunityDB'
type CommunityEnv = Reader CommunityDB

-- | A map of packages with their 'FlagAssignment'
type FlagAssignments = Map PackageName FlagAssignment

-- | Reader effect of a map, associating 'PackageName' with its 'FlagAssignment'
type FlagAssignmentsEnv = Reader FlagAssignments

-- | Unused state effect
type DependencyRecord = State (Map PackageName [VersionRange])

-- | Error effect of 'MyException'
type WithMyErr = Error MyException

-- | Custom exception used in this project
data MyException
  = PkgNotFound PackageName
  | VersionError PackageName Version
  | TargetExist PackageName DependencyProvider
  | CyclicError [PackageName]
  deriving stock (MyException -> MyException -> Bool
(MyException -> MyException -> Bool)
-> (MyException -> MyException -> Bool) -> Eq MyException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MyException -> MyException -> Bool
$c/= :: MyException -> MyException -> Bool
== :: MyException -> MyException -> Bool
$c== :: MyException -> MyException -> Bool
Eq)

instance Show MyException where
  show :: MyException -> String
show (PkgNotFound PackageName
name) = String
"Unable to find [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
unPackageName PackageName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (VersionError PackageName
name Version
version) = String
"Unable to find [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
unPackageName PackageName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
forall a. Pretty a => a -> String
prettyShow Version
version String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (TargetExist PackageName
name DependencyProvider
provider) = String
"Target [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
unPackageName PackageName
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] has been provided by " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DependencyProvider -> String
forall a. Show a => a -> String
show DependencyProvider
provider
  show (CyclicError [PackageName]
c) = String
"Graph contains a cycle " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([String] -> String
forall a. Show a => a -> String
show ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PackageName -> String) -> [PackageName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageName -> String
unPackageName [PackageName]
c)

-- | The type of a dependency. Who requires this?
data DependencyType
  = -- | By a /executable/
    CExe UnqualComponentName
  | -- | By the /build tools/ of a /executable/
    CExeBuildTools UnqualComponentName
  | -- | By a /library/
    CLib
  | -- | By a /test suit/
    CTest UnqualComponentName
  | -- | By a /benchmark/
    CBenchmark UnqualComponentName
  | -- | By the /build tools/ of a /library/
    CLibBuildTools
  | -- | By the /build tools/ of a /test suit/
    CTestBuildTools UnqualComponentName
  | -- | By the /build tools/ of a /benchmark/
    CBenchmarkBuildTools UnqualComponentName
  | -- |  By a /sub-library/
    CSubLibs UnqualComponentName
  | -- |  By the /build tools/ of a /sub-library/
    CSubLibsBuildTools UnqualComponentName
  deriving stock (DependencyType -> DependencyType -> Bool
(DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool) -> Eq DependencyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyType -> DependencyType -> Bool
$c/= :: DependencyType -> DependencyType -> Bool
== :: DependencyType -> DependencyType -> Bool
$c== :: DependencyType -> DependencyType -> Bool
Eq, Eq DependencyType
Eq DependencyType
-> (DependencyType -> DependencyType -> Ordering)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> Bool)
-> (DependencyType -> DependencyType -> DependencyType)
-> (DependencyType -> DependencyType -> DependencyType)
-> Ord DependencyType
DependencyType -> DependencyType -> Bool
DependencyType -> DependencyType -> Ordering
DependencyType -> DependencyType -> DependencyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DependencyType -> DependencyType -> DependencyType
$cmin :: DependencyType -> DependencyType -> DependencyType
max :: DependencyType -> DependencyType -> DependencyType
$cmax :: DependencyType -> DependencyType -> DependencyType
>= :: DependencyType -> DependencyType -> Bool
$c>= :: DependencyType -> DependencyType -> Bool
> :: DependencyType -> DependencyType -> Bool
$c> :: DependencyType -> DependencyType -> Bool
<= :: DependencyType -> DependencyType -> Bool
$c<= :: DependencyType -> DependencyType -> Bool
< :: DependencyType -> DependencyType -> Bool
$c< :: DependencyType -> DependencyType -> Bool
compare :: DependencyType -> DependencyType -> Ordering
$ccompare :: DependencyType -> DependencyType -> Ordering
$cp1Ord :: Eq DependencyType
Ord, (forall x. DependencyType -> Rep DependencyType x)
-> (forall x. Rep DependencyType x -> DependencyType)
-> Generic DependencyType
forall x. Rep DependencyType x -> DependencyType
forall x. DependencyType -> Rep DependencyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DependencyType x -> DependencyType
$cfrom :: forall x. DependencyType -> Rep DependencyType x
Generic)
  deriving anyclass (DependencyType -> ()
(DependencyType -> ()) -> NFData DependencyType
forall a. (a -> ()) -> NFData a
rnf :: DependencyType -> ()
$crnf :: DependencyType -> ()
NFData)

-- | Tags of data constructors of 'DependencyType'
data DependencyKind
  = Exe
  | ExeBuildTools
  | Lib
  | Test
  | Benchmark
  | LibBuildTools
  | TestBuildTools
  | BenchmarkBuildTools
  | SubLibs
  | SubLibsBuildTools
  deriving stock (DependencyKind -> DependencyKind -> Bool
(DependencyKind -> DependencyKind -> Bool)
-> (DependencyKind -> DependencyKind -> Bool) -> Eq DependencyKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyKind -> DependencyKind -> Bool
$c/= :: DependencyKind -> DependencyKind -> Bool
== :: DependencyKind -> DependencyKind -> Bool
$c== :: DependencyKind -> DependencyKind -> Bool
Eq)

instance Show DependencyType where
  show :: DependencyType -> String
show (CExe UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Exe"
  show (CExeBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: ExeBuildTools"
  show (CTest UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Test"
  show (CBenchmark UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: Benchmark"
  show (CTestBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: TestBuildTools"
  show (CBenchmarkBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: BenchmarkBuildTools"
  show (CSubLibs UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: SubLibs"
  show (CSubLibsBuildTools UnqualComponentName
x) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: SubLibsBuildTools"
  show DependencyType
CLib = String
"Lib"
  show DependencyType
CLibBuildTools = String
"LibBuildTools"

-- | Provider of a dependency.
data DependencyProvider = ByCommunity | ByAur
  deriving stock (DependencyProvider -> DependencyProvider -> Bool
(DependencyProvider -> DependencyProvider -> Bool)
-> (DependencyProvider -> DependencyProvider -> Bool)
-> Eq DependencyProvider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyProvider -> DependencyProvider -> Bool
$c/= :: DependencyProvider -> DependencyProvider -> Bool
== :: DependencyProvider -> DependencyProvider -> Bool
$c== :: DependencyProvider -> DependencyProvider -> Bool
Eq, (forall x. DependencyProvider -> Rep DependencyProvider x)
-> (forall x. Rep DependencyProvider x -> DependencyProvider)
-> Generic DependencyProvider
forall x. Rep DependencyProvider x -> DependencyProvider
forall x. DependencyProvider -> Rep DependencyProvider x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DependencyProvider x -> DependencyProvider
$cfrom :: forall x. DependencyProvider -> Rep DependencyProvider x
Generic)
  deriving anyclass (DependencyProvider -> ()
(DependencyProvider -> ()) -> NFData DependencyProvider
forall a. (a -> ()) -> NFData a
rnf :: DependencyProvider -> ()
$crnf :: DependencyProvider -> ()
NFData)

instance Show DependencyProvider where
  show :: DependencyProvider -> String
show DependencyProvider
ByCommunity = String
"community"
  show DependencyProvider
ByAur = String
"aur"

-- | A solved dependency, holden by 'SolvedPackage'
data SolvedDependency = SolvedDependency
  { -- | Provider of this dependency
    SolvedDependency -> Maybe DependencyProvider
_depProvider :: Maybe DependencyProvider,
    -- | Name of the dependency
    SolvedDependency -> PackageName
_depName :: PackageName,
    -- | Types of the dependency
    SolvedDependency -> [DependencyType]
_depType :: [DependencyType]
  }
  deriving stock (Int -> SolvedDependency -> ShowS
[SolvedDependency] -> ShowS
SolvedDependency -> String
(Int -> SolvedDependency -> ShowS)
-> (SolvedDependency -> String)
-> ([SolvedDependency] -> ShowS)
-> Show SolvedDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolvedDependency] -> ShowS
$cshowList :: [SolvedDependency] -> ShowS
show :: SolvedDependency -> String
$cshow :: SolvedDependency -> String
showsPrec :: Int -> SolvedDependency -> ShowS
$cshowsPrec :: Int -> SolvedDependency -> ShowS
Show, SolvedDependency -> SolvedDependency -> Bool
(SolvedDependency -> SolvedDependency -> Bool)
-> (SolvedDependency -> SolvedDependency -> Bool)
-> Eq SolvedDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolvedDependency -> SolvedDependency -> Bool
$c/= :: SolvedDependency -> SolvedDependency -> Bool
== :: SolvedDependency -> SolvedDependency -> Bool
$c== :: SolvedDependency -> SolvedDependency -> Bool
Eq, (forall x. SolvedDependency -> Rep SolvedDependency x)
-> (forall x. Rep SolvedDependency x -> SolvedDependency)
-> Generic SolvedDependency
forall x. Rep SolvedDependency x -> SolvedDependency
forall x. SolvedDependency -> Rep SolvedDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolvedDependency x -> SolvedDependency
$cfrom :: forall x. SolvedDependency -> Rep SolvedDependency x
Generic)
  deriving anyclass (SolvedDependency -> ()
(SolvedDependency -> ()) -> NFData SolvedDependency
forall a. (a -> ()) -> NFData a
rnf :: SolvedDependency -> ()
$crnf :: SolvedDependency -> ()
NFData)

-- | A solved package collected from dgraph. This data type is not designed to be recursively,
-- thus the element type of '_pkgDeps' is 'SolvedDependency', rather than another 'SolvedPackage'.
data SolvedPackage
  = -- | A package which has been provided by somebody, so there is no need to expand its dependencies
    ProvidedPackage
      { -- | Package name
        SolvedPackage -> PackageName
_pkgName :: PackageName,
        -- | Package provider. (The name of 'DependencyProvider' may be confusing...)
        SolvedPackage -> DependencyProvider
_pkgProvider :: DependencyProvider
      }
  | -- | A package with its dependencies
    SolvedPackage
      { -- | Package name
        _pkgName :: PackageName,
        -- | Package dependencies
        SolvedPackage -> [SolvedDependency]
_pkgDeps :: [SolvedDependency]
      }
  deriving stock (Int -> SolvedPackage -> ShowS
[SolvedPackage] -> ShowS
SolvedPackage -> String
(Int -> SolvedPackage -> ShowS)
-> (SolvedPackage -> String)
-> ([SolvedPackage] -> ShowS)
-> Show SolvedPackage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolvedPackage] -> ShowS
$cshowList :: [SolvedPackage] -> ShowS
show :: SolvedPackage -> String
$cshow :: SolvedPackage -> String
showsPrec :: Int -> SolvedPackage -> ShowS
$cshowsPrec :: Int -> SolvedPackage -> ShowS
Show, SolvedPackage -> SolvedPackage -> Bool
(SolvedPackage -> SolvedPackage -> Bool)
-> (SolvedPackage -> SolvedPackage -> Bool) -> Eq SolvedPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolvedPackage -> SolvedPackage -> Bool
$c/= :: SolvedPackage -> SolvedPackage -> Bool
== :: SolvedPackage -> SolvedPackage -> Bool
$c== :: SolvedPackage -> SolvedPackage -> Bool
Eq, (forall x. SolvedPackage -> Rep SolvedPackage x)
-> (forall x. Rep SolvedPackage x -> SolvedPackage)
-> Generic SolvedPackage
forall x. Rep SolvedPackage x -> SolvedPackage
forall x. SolvedPackage -> Rep SolvedPackage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolvedPackage x -> SolvedPackage
$cfrom :: forall x. SolvedPackage -> Rep SolvedPackage x
Generic)
  deriving anyclass (SolvedPackage -> ()
(SolvedPackage -> ()) -> NFData SolvedPackage
forall a. (a -> ()) -> NFData a
rnf :: SolvedPackage -> ()
$crnf :: SolvedPackage -> ()
NFData)

makeLenses ''SolvedDependency
makeLenses ''SolvedPackage