{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- Types and lenses used by the library.
module Distribution.Uusi.Types (module Distribution.Uusi.Types) where

import Data.Text (Text)
import qualified Data.Text as T
import Distribution.Pretty (prettyShow)
import Distribution.Types.Dependency (Dependency (..))
import Distribution.Types.ExeDependency (ExeDependency (..))
import Distribution.Types.LegacyExeDependency (LegacyExeDependency (..))
import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import Distribution.Types.VersionRange (VersionRange)
import Lens.Micro
import Lens.Micro.TH (makeClassy)

-----------------------------------------------------------------------------

-- | Action acting on cabal dependencies.
data Action tag
  = -- | For a dependency x, if P(x) then remove x
    Remove tag (PackageName -> Bool)
  | -- | For a dependency x, if P(x) then set x's version range
    SetVersion tag (PackageName -> Bool) VersionRange
  | -- | For a dependency x, if P(x) then replace x with a set of packages
    Replace tag (PackageName -> Bool) [VersionedPackage]
    -- | For a component x, if P(x) then set the buildable of x
  | SetBuildable tag (UnqualComponentName -> Bool) Bool

instance (Show tag) => Show (Action tag) where
  show :: Action tag -> String
show (Remove tag
tag PackageName -> Bool
_) = String
"Remove[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag -> String
forall a. Show a => a -> String
show tag
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (SetVersion tag
tag PackageName -> Bool
_ VersionRange
range) = String
"SetVersion[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag -> String
forall a. Show a => a -> String
show tag
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VersionRange -> String
forall a. Pretty a => a -> String
prettyShow VersionRange
range String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (Replace tag
tag PackageName -> Bool
_ [VersionedPackage]
targets) = String
"Replace[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag -> String
forall a. Show a => a -> String
show tag
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" |-> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> (VersionedPackage -> String) -> VersionedPackage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionedPackage -> String
forall a. Show a => a -> String
show (VersionedPackage -> Text) -> [VersionedPackage] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionedPackage]
targets) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
  show (SetBuildable tag
tag UnqualComponentName -> Bool
_ Bool
buildable) = String
"SetBuildable[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tag -> String
forall a. Show a => a -> String
show tag
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
buildable String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"

-- | Common 'Action', where the predication @p@ is 'PackageName'.
type Uusi = Action Text

-- | A list of 'Uusi'
type SomeUusi = [Uusi]

-- | An endo operation
type Op a = a -> a

-----------------------------------------------------------------------------

-- | Super type of three kinds of dependency.
-- Because cabal doesn't define lenses of 'Dependency', 'ExeDependency', and 'LegacyExeDependency',
-- here comes out a general data type to define overloaded lenses.
-- See 'HasVersionedPackage'.
data VersionedPackage = VersionedPackage
  { VersionedPackage -> PackageName
_myPkgName :: PackageName,
    VersionedPackage -> VersionRange
_myVersionRange :: VersionRange
  }

instance Show VersionedPackage where
  show :: VersionedPackage -> String
show (VersionedPackage PackageName
name VersionRange
range) = ShowS
forall a. Show a => a -> String
show (PackageName -> String
unPackageName PackageName
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VersionRange -> String
forall a. Pretty a => a -> String
prettyShow VersionRange
range

-- | Sub type of 'VersionedPackage', with 'UnqualComponentName'.
-- Similar to 'VersionedPackage', for defining lenses.
-- See 'HasComponentialPackage'.
data ComponentialPackage = ComponentialPackage
  { ComponentialPackage -> VersionedPackage
_myCorePackage :: VersionedPackage,
    ComponentialPackage -> UnqualComponentName
_myComponentName :: UnqualComponentName
  }

makeClassy ''VersionedPackage
makeClassy ''ComponentialPackage

instance HasVersionedPackage Dependency where
  versionedPackage :: (VersionedPackage -> f VersionedPackage)
-> Dependency -> f Dependency
versionedPackage =
    (Dependency -> VersionedPackage)
-> (Dependency -> VersionedPackage -> Dependency)
-> Lens' Dependency VersionedPackage
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      (\(Dependency PackageName
name VersionRange
range Set LibraryName
_) -> PackageName -> VersionRange -> VersionedPackage
VersionedPackage PackageName
name VersionRange
range)
      (\(Dependency PackageName
_ VersionRange
_ Set LibraryName
lib) (VersionedPackage PackageName
name VersionRange
range) -> PackageName -> VersionRange -> Set LibraryName -> Dependency
Dependency PackageName
name VersionRange
range Set LibraryName
lib)

instance HasVersionedPackage ExeDependency where
  versionedPackage :: (VersionedPackage -> f VersionedPackage)
-> ExeDependency -> f ExeDependency
versionedPackage =
    (ExeDependency -> VersionedPackage)
-> (ExeDependency -> VersionedPackage -> ExeDependency)
-> Lens' ExeDependency VersionedPackage
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      (\(ExeDependency PackageName
name UnqualComponentName
_ VersionRange
range) -> PackageName -> VersionRange -> VersionedPackage
VersionedPackage PackageName
name VersionRange
range)
      (\(ExeDependency PackageName
_ UnqualComponentName
component VersionRange
_) (VersionedPackage PackageName
name VersionRange
range) -> PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
ExeDependency PackageName
name UnqualComponentName
component VersionRange
range)

instance HasComponentialPackage ExeDependency where
  componentialPackage :: (ComponentialPackage -> f ComponentialPackage)
-> ExeDependency -> f ExeDependency
componentialPackage =
    (ExeDependency -> ComponentialPackage)
-> (ExeDependency -> ComponentialPackage -> ExeDependency)
-> Lens' ExeDependency ComponentialPackage
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      (\x :: ExeDependency
x@(ExeDependency PackageName
_ UnqualComponentName
component VersionRange
_) -> VersionedPackage -> UnqualComponentName -> ComponentialPackage
ComponentialPackage (ExeDependency
x ExeDependency
-> Getting VersionedPackage ExeDependency VersionedPackage
-> VersionedPackage
forall s a. s -> Getting a s a -> a
^. Getting VersionedPackage ExeDependency VersionedPackage
forall c. HasVersionedPackage c => Lens' c VersionedPackage
versionedPackage) UnqualComponentName
component)
      ( \ExeDependency
x (ComponentialPackage VersionedPackage
core UnqualComponentName
component) ->
          ExeDependency
x ExeDependency -> (ExeDependency -> ExeDependency) -> ExeDependency
forall a b. a -> (a -> b) -> b
& (VersionedPackage -> Identity VersionedPackage)
-> ExeDependency -> Identity ExeDependency
forall c. HasComponentialPackage c => Lens' c VersionedPackage
myCorePackage ((VersionedPackage -> Identity VersionedPackage)
 -> ExeDependency -> Identity ExeDependency)
-> VersionedPackage -> ExeDependency -> ExeDependency
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VersionedPackage
core
            ExeDependency -> (ExeDependency -> ExeDependency) -> ExeDependency
forall a b. a -> (a -> b) -> b
& (UnqualComponentName -> Identity UnqualComponentName)
-> ExeDependency -> Identity ExeDependency
forall c. HasComponentialPackage c => Lens' c UnqualComponentName
myComponentName ((UnqualComponentName -> Identity UnqualComponentName)
 -> ExeDependency -> Identity ExeDependency)
-> UnqualComponentName -> ExeDependency -> ExeDependency
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnqualComponentName
component
      )

instance HasVersionedPackage LegacyExeDependency where
  versionedPackage :: (VersionedPackage -> f VersionedPackage)
-> LegacyExeDependency -> f LegacyExeDependency
versionedPackage =
    (LegacyExeDependency -> VersionedPackage)
-> (LegacyExeDependency -> VersionedPackage -> LegacyExeDependency)
-> Lens' LegacyExeDependency VersionedPackage
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
      (\(LegacyExeDependency String
name VersionRange
range) -> PackageName -> VersionRange -> VersionedPackage
VersionedPackage (String -> PackageName
mkPackageName String
name) VersionRange
range)
      (\LegacyExeDependency
_ (VersionedPackage PackageName
name VersionRange
range) -> String -> VersionRange -> LegacyExeDependency
LegacyExeDependency (PackageName -> String
unPackageName PackageName
name) VersionRange
range)