{-# 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 -> FilePath
srpLocation :: !String
    , forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag      :: !(Maybe String)
    , forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpBranch   :: !(Maybe String)
    , forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpSubdir   :: !(f FilePath)
    , forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
srpCommand  :: ![String]
    }
  deriving (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
$cto :: forall (f :: * -> *) x.
Rep (SourceRepositoryPackage f) x -> SourceRepositoryPackage f
$cfrom :: forall (f :: * -> *) x.
SourceRepositoryPackage f -> Rep (SourceRepositoryPackage f) x
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 :: g FilePath
srpSubdir = forall x. f x -> g x
nt (forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpSubdir SourceRepositoryPackage f
s) }

srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy :: forall (f :: * -> *).
SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy SourceRepositoryPackage f
s = SourceRepositoryPackage f
s { srpSubdir :: Proxy FilePath
srpSubdir = forall {k} (t :: k). Proxy t
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 FilePath
srpSubdir = [] } =
    SourceRepoList
s { srpSubdir :: Maybe FilePath
srpSubdir = forall a. Maybe a
Nothing } forall a. a -> [a] -> NonEmpty a
:| []
srpFanOut s :: SourceRepoList
s@SourceRepositoryPackage { srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpSubdir = FilePath
d:[FilePath]
ds } = FilePath -> SourceRepositoryPackage Maybe
f FilePath
d forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map FilePath -> SourceRepositoryPackage Maybe
f [FilePath]
ds where
    f :: FilePath -> SourceRepositoryPackage Maybe
f FilePath
subdir = SourceRepoList
s { srpSubdir :: Maybe FilePath
srpSubdir = forall a. a -> Maybe a
Just FilePath
subdir }

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

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

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

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

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

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

srpCommandLensNE :: Lens' (SourceRepositoryPackage f) (Maybe (NonEmpty String))
srpCommandLensNE :: forall (f :: * -> *).
Lens' (SourceRepositoryPackage f) (Maybe (NonEmpty FilePath))
srpCommandLensNE Maybe (NonEmpty FilePath) -> f (Maybe (NonEmpty FilePath))
f SourceRepositoryPackage f
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (NonEmpty FilePath)
x -> SourceRepositoryPackage f
s { srpCommand :: [FilePath]
srpCommand = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (NonEmpty FilePath)
x }) (Maybe (NonEmpty FilePath) -> f (Maybe (NonEmpty FilePath))
f (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
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 FilePath),
 c (NonEmpty' NoCommaFSep Token FilePath)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar = forall (f :: * -> *).
RepoType
-> FilePath
-> Maybe FilePath
-> Maybe FilePath
-> f FilePath
-> [FilePath]
-> SourceRepositoryPackage f
SourceRepositoryPackage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField      FieldName
"type"                                       forall (f :: * -> *). Lens' (SourceRepositoryPackage f) RepoType
srpTypeLens
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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" FilePath -> Token
Token                             forall (f :: * -> *). Lens' (SourceRepositoryPackage f) FilePath
srpLocationLens
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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"      FilePath -> Token
Token                             forall (f :: * -> *).
Lens' (SourceRepositoryPackage f) (Maybe FilePath)
srpTagLens
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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"   FilePath -> Token
Token                             forall (f :: * -> *).
Lens' (SourceRepositoryPackage f) (Maybe FilePath)
srpBranchLens
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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"   (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' NoCommaFSep
NoCommaFSep FilePath -> FilePathNT
FilePathNT) forall (f :: * -> *) (g :: * -> *).
Lens
  (SourceRepositoryPackage f)
  (SourceRepositoryPackage g)
  (f FilePath)
  (g FilePath)
srpSubdirLens  -- note: NoCommaFSep is somewhat important for roundtrip, as "." is there...
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) forall {f :: * -> *}.
g (SourceRepositoryPackage f) (Maybe (NonEmpty FilePath))
pcc
  where
    pcc :: g (SourceRepositoryPackage f) (Maybe (NonEmpty FilePath))
pcc = 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" (forall sep a b. sep -> (a -> b) -> NonEmpty a -> NonEmpty' sep b a
alaNonEmpty' NoCommaFSep
NoCommaFSep FilePath -> Token
Token) forall (f :: * -> *).
Lens' (SourceRepositoryPackage f) (Maybe (NonEmpty FilePath))
srpCommandLensNE
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}