{-# 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
    { SourceRepositoryPackage f -> RepoType
srpType     :: !RepoType
    , SourceRepositoryPackage f -> String
srpLocation :: !String
    , SourceRepositoryPackage f -> Maybe String
srpTag      :: !(Maybe String)
    , SourceRepositoryPackage f -> Maybe String
srpBranch   :: !(Maybe String)
    , SourceRepositoryPackage f -> f String
srpSubdir   :: !(f FilePath)
    , 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
$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 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 String
srpSubdir = f String -> g String
forall x. f x -> g x
nt (SourceRepositoryPackage f -> f String
forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir SourceRepositoryPackage f
s) }

srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy SourceRepositoryPackage f
s = SourceRepositoryPackage f
s { srpSubdir :: Proxy String
srpSubdir = Proxy String
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 :: SourceRepositoryPackage []
-> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut s :: SourceRepositoryPackage []
s@SourceRepositoryPackage { srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir = [] } =
    SourceRepositoryPackage []
s { srpSubdir :: Maybe String
srpSubdir = Maybe String
forall a. Maybe a
Nothing } SourceRepositoryPackage Maybe
-> [SourceRepositoryPackage Maybe]
-> NonEmpty (SourceRepositoryPackage Maybe)
forall a. a -> [a] -> NonEmpty a
:| []
srpFanOut s :: SourceRepositoryPackage []
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 = SourceRepositoryPackage []
s { srpSubdir :: Maybe String
srpSubdir = String -> Maybe String
forall a. a -> Maybe a
Just String
subdir }

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

srpTypeLens :: Lens' (SourceRepositoryPackage f) RepoType
srpTypeLens :: 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 (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 (SourceRepositoryPackage f -> RepoType
forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType SourceRepositoryPackage f
s))
{-# INLINE srpTypeLens #-}

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