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

-- | Copyright: (c) 2020-2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
-- Types 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.PackageName (PackageName, unPackageName)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import Distribution.Types.VersionRange (VersionRange)

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

-- | 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
  | -- | For a component or library x, if P(x) then modify build options of x
    ModifyBuiltOptions tag (UnqualComponentName -> Bool) (Op [String])

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
"]"
  show (ModifyBuiltOptions tag
tag UnqualComponentName -> Bool
_ Op [String]
_) = String
"ModifyBuiltOptions[" 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
"]"

-- | Common 'Action', where the tag 'Text'.
type Uusi = Action Text

-- | A list of 'Uusi'
type Uusis = [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
  }