{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Distribution.Client.Types.SourceRepo
  ( SourceRepositoryPackage (..)
  , SourceRepoList
  , SourceRepoMaybe
  , SourceRepoProxy
  , srpHoist
  , srpToProxy
  , srpFanOut
  , sourceRepositoryPackageGrammar
  ) where

import Distribution.Client.Compat.Prelude
import Distribution.Compat.Lens (Lens, Lens')
import Prelude ()

import Distribution.FieldGrammar
import Distribution.Types.SourceRepo (RepoType (..))

-- | @source-repository-package@ definition
data SourceRepositoryPackage f = SourceRepositoryPackage
  { forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType :: !RepoType
  , forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation :: !String
  , forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag :: !(Maybe String)
  , forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch :: !(Maybe String)
  , forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir :: !(f FilePath)
  , forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpCommand :: ![String]
  }
  deriving ((forall x.
 SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x)
-> (forall x.
    Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f)
-> Generic (SourceRepositoryPackage f)
forall x.
Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f
forall x.
SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f
forall (f :: * -> *) x.
SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x
$cfrom :: forall (f :: * -> *) x.
SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x
from :: forall x.
SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x
$cto :: forall (f :: * -> *) x.
Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f
to :: forall x.
Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f
Generic)

deriving instance Eq (f FilePath) => Eq (SourceRepositoryPackage f)
deriving instance Ord (f FilePath) => Ord (SourceRepositoryPackage f)
deriving instance Show (f FilePath) => Show (SourceRepositoryPackage f)
deriving instance Binary (f FilePath) => Binary (SourceRepositoryPackage f)
deriving instance (Typeable f, Structured (f FilePath)) => Structured (SourceRepositoryPackage f)

-- | Read from @cabal.project@
type SourceRepoList = SourceRepositoryPackage []

-- | Distilled from 'Distribution.Types.SourceRepo.SourceRepo'
type SourceRepoMaybe = SourceRepositoryPackage Maybe

-- | 'SourceRepositoryPackage' without subdir. Used in clone errors. Cloning doesn't care about subdirectory.
type SourceRepoProxy = SourceRepositoryPackage Proxy

srpHoist :: (forall x. f x -> g x) -> SourceRepositoryPackage f -> SourceRepositoryPackage g
srpHoist :: forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x)
-> SourceRepositoryPackage f -> SourceRepositoryPackage g
srpHoist forall x. f x -> g x
nt SourceRepositoryPackage f
s = SourceRepositoryPackage f
s{srpSubdir = nt (srpSubdir s)}

srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy :: forall (f :: * -> *).
SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy SourceRepositoryPackage f
s = SourceRepositoryPackage f
s{srpSubdir = Proxy}

-- | Split single @source-repository-package@ declaration with multiple subdirs,
-- into multiple ones with at most single subdir.
srpFanOut :: SourceRepositoryPackage [] -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut :: SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut s :: SourceRepoList
s@SourceRepositoryPackage{srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir = []} =
  SourceRepoList
s{srpSubdir = Nothing} SourceRepositoryPackage Maybe
-> [SourceRepositoryPackage Maybe]
-> NonEmpty (SourceRepositoryPackage Maybe)
forall a. a -> [a] -> NonEmpty a
:| []
srpFanOut s :: SourceRepoList
s@SourceRepositoryPackage{srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir = String
d : [String]
ds} = String -> SourceRepositoryPackage Maybe
f String
d SourceRepositoryPackage Maybe
-> [SourceRepositoryPackage Maybe]
-> NonEmpty (SourceRepositoryPackage Maybe)
forall a. a -> [a] -> NonEmpty a
:| (String -> SourceRepositoryPackage Maybe)
-> [String] -> [SourceRepositoryPackage Maybe]
forall a b. (a -> b) -> [a] -> [b]
map String -> SourceRepositoryPackage Maybe
f [String]
ds
  where
    f :: String -> SourceRepositoryPackage Maybe
f String
subdir = SourceRepoList
s{srpSubdir = Just subdir}

-------------------------------------------------------------------------------
-- Lens
-------------------------------------------------------------------------------

srpTypeLens :: Lens' (SourceRepositoryPackage f) RepoType
srpTypeLens :: forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  RepoType
  RepoType
srpTypeLens RepoType -> f RepoType
f SourceRepositoryPackage f
s = (RepoType -> SourceRepositoryPackage f)
-> f RepoType -> f (SourceRepositoryPackage f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RepoType
x -> SourceRepositoryPackage f
s{srpType = x}) (RepoType -> f RepoType
f (SourceRepositoryPackage f -> RepoType
forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType SourceRepositoryPackage f
s))
{-# INLINE srpTypeLens #-}

srpLocationLens :: Lens' (SourceRepositoryPackage f) String
srpLocationLens :: forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  String
  String
srpLocationLens String -> f String
f SourceRepositoryPackage f
s = (String -> SourceRepositoryPackage f)
-> f String -> f (SourceRepositoryPackage f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> SourceRepositoryPackage f
s{srpLocation = x}) (String -> f String
f (SourceRepositoryPackage f -> String
forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation SourceRepositoryPackage f
s))
{-# INLINE srpLocationLens #-}

srpTagLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpTagLens :: forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe String)
  (Maybe String)
srpTagLens Maybe String -> f (Maybe String)
f SourceRepositoryPackage f
s = (Maybe String -> SourceRepositoryPackage f)
-> f (Maybe String) -> f (SourceRepositoryPackage f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe String
x -> SourceRepositoryPackage f
s{srpTag = x}) (Maybe String -> f (Maybe String)
f (SourceRepositoryPackage f -> Maybe String
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpTag SourceRepositoryPackage f
s))
{-# INLINE srpTagLens #-}

srpBranchLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpBranchLens :: forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe String)
  (Maybe String)
srpBranchLens Maybe String -> f (Maybe String)
f SourceRepositoryPackage f
s = (Maybe String -> SourceRepositoryPackage f)
-> f (Maybe String) -> f (SourceRepositoryPackage f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe String
x -> SourceRepositoryPackage f
s{srpBranch = x}) (Maybe String -> f (Maybe String)
f (SourceRepositoryPackage f -> Maybe String
forall (f :: * -> *). SourceRepositoryPackage f -> Maybe String
srpBranch SourceRepositoryPackage f
s))
{-# INLINE srpBranchLens #-}

srpSubdirLens :: Lens (SourceRepositoryPackage f) (SourceRepositoryPackage g) (f FilePath) (g FilePath)
srpSubdirLens :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage g)
  (f String)
  (g String)
srpSubdirLens f String -> f (g String)
f SourceRepositoryPackage f
s = (g String -> SourceRepositoryPackage g)
-> f (g String) -> f (SourceRepositoryPackage g)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\g String
x -> SourceRepositoryPackage f
s{srpSubdir = x}) (f String -> f (g String)
f (SourceRepositoryPackage f -> f String
forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir SourceRepositoryPackage f
s))
{-# INLINE srpSubdirLens #-}

srpCommandLensNE :: Lens' (SourceRepositoryPackage f) (Maybe (NonEmpty String))
srpCommandLensNE :: forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe (NonEmpty String))
  (Maybe (NonEmpty String))
srpCommandLensNE Maybe (NonEmpty String) -> f (Maybe (NonEmpty String))
f SourceRepositoryPackage f
s = (Maybe (NonEmpty String) -> SourceRepositoryPackage f)
-> f (Maybe (NonEmpty String)) -> f (SourceRepositoryPackage f)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (NonEmpty String)
x -> SourceRepositoryPackage f
s{srpCommand = maybe [] toList x}) (Maybe (NonEmpty String) -> f (Maybe (NonEmpty String))
f ([String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (SourceRepositoryPackage f -> [String]
forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpCommand SourceRepositoryPackage f
s)))
{-# INLINE srpCommandLensNE #-}

-------------------------------------------------------------------------------
-- Parser & PPrinter
-------------------------------------------------------------------------------

sourceRepositoryPackageGrammar
  :: ( FieldGrammar c g
     , Applicative (g SourceRepoList)
     , c (Identity RepoType)
     , c (List NoCommaFSep FilePathNT String)
     , c (NonEmpty' NoCommaFSep Token String)
     )
  => g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (Identity RepoType), c (List NoCommaFSep FilePathNT String),
 c (NonEmpty' NoCommaFSep Token String)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar =
  RepoType
-> String
-> Maybe String
-> Maybe String
-> [String]
-> [String]
-> SourceRepoList
forall (f :: * -> *).
RepoType
-> String
-> Maybe String
-> Maybe String
-> f String
-> [String]
-> SourceRepositoryPackage f
SourceRepositoryPackage
    (RepoType
 -> String
 -> Maybe String
 -> Maybe String
 -> [String]
 -> [String]
 -> SourceRepoList)
-> g SourceRepoList RepoType
-> g SourceRepoList
     (String
      -> Maybe String
      -> Maybe String
      -> [String]
      -> [String]
      -> SourceRepoList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' SourceRepoList RepoType -> g SourceRepoList RepoType
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"type" ALens' SourceRepoList RepoType
forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  RepoType
  RepoType
srpTypeLens
    g SourceRepoList
  (String
   -> Maybe String
   -> Maybe String
   -> [String]
   -> [String]
   -> SourceRepoList)
-> g SourceRepoList String
-> g SourceRepoList
     (Maybe String
      -> Maybe String -> [String] -> [String] -> SourceRepoList)
forall a b.
g SourceRepoList (a -> b)
-> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (String -> Token)
-> ALens' SourceRepoList String
-> g SourceRepoList String
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
uniqueFieldAla FieldName
"location" String -> Token
Token ALens' SourceRepoList String
forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  String
  String
srpLocationLens
    g SourceRepoList
  (Maybe String
   -> Maybe String -> [String] -> [String] -> SourceRepoList)
-> g SourceRepoList (Maybe String)
-> g SourceRepoList
     (Maybe String -> [String] -> [String] -> SourceRepoList)
forall a b.
g SourceRepoList (a -> b)
-> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (String -> Token)
-> ALens' SourceRepoList (Maybe String)
-> g SourceRepoList (Maybe String)
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"tag" String -> Token
Token ALens' SourceRepoList (Maybe String)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe String)
  (Maybe String)
srpTagLens
    g SourceRepoList
  (Maybe String -> [String] -> [String] -> SourceRepoList)
-> g SourceRepoList (Maybe String)
-> g SourceRepoList ([String] -> [String] -> SourceRepoList)
forall a b.
g SourceRepoList (a -> b)
-> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (String -> Token)
-> ALens' SourceRepoList (Maybe String)
-> g SourceRepoList (Maybe String)
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"branch" String -> Token
Token ALens' SourceRepoList (Maybe String)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe String)
  (Maybe String)
srpBranchLens
    g SourceRepoList ([String] -> [String] -> SourceRepoList)
-> g SourceRepoList [String]
-> g SourceRepoList ([String] -> SourceRepoList)
forall a b.
g SourceRepoList (a -> b)
-> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List NoCommaFSep FilePathNT String)
-> ALens' SourceRepoList [String]
-> g SourceRepoList [String]
forall b a s.
(c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"subdir" (NoCommaFSep
-> (String -> FilePathNT)
-> [String]
-> List NoCommaFSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep String -> FilePathNT
FilePathNT) ALens' SourceRepoList [String]
forall (f :: * -> *) (g :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage g)
  (f String)
  (g String)
srpSubdirLens -- note: NoCommaFSep is somewhat important for roundtrip, as "." is there...
    g SourceRepoList ([String] -> SourceRepoList)
-> g SourceRepoList [String] -> g SourceRepoList SourceRepoList
forall a b.
g SourceRepoList (a -> b)
-> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe (NonEmpty String) -> [String])
-> g SourceRepoList (Maybe (NonEmpty String))
-> g SourceRepoList [String]
forall a b. (a -> b) -> g SourceRepoList a -> g SourceRepoList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String]
-> (NonEmpty String -> [String])
-> Maybe (NonEmpty String)
-> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) g SourceRepoList (Maybe (NonEmpty String))
forall {f :: * -> *}.
g (SourceRepositoryPackage f) (Maybe (NonEmpty String))
pcc
  where
    pcc :: g (SourceRepositoryPackage f) (Maybe (NonEmpty String))
pcc = FieldName
-> (NonEmpty String -> NonEmpty' NoCommaFSep Token String)
-> ALens' (SourceRepositoryPackage f) (Maybe (NonEmpty String))
-> g (SourceRepositoryPackage f) (Maybe (NonEmpty String))
forall b a s.
(c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla FieldName
"post-checkout-command" (NoCommaFSep
-> (String -> Token)
-> NonEmpty String
-> NonEmpty' NoCommaFSep Token String
forall sep a b. sep -> (a -> b) -> NonEmpty a -> NonEmpty' sep b a
alaNonEmpty' NoCommaFSep
NoCommaFSep String -> Token
Token) ALens' (SourceRepositoryPackage f) (Maybe (NonEmpty String))
forall (f :: * -> *) (f :: * -> *).
Functor f =>
LensLike
  f
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage f)
  (Maybe (NonEmpty String))
  (Maybe (NonEmpty String))
srpCommandLensNE
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}