{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Originally Distribution.Client.SourceRepo
module Cabal.SourceRepo (
    -- * SourceRepo
    SourceRepositoryPackage (..),
    -- * Aliases
    SourceRepoList,
    SourceRepoMaybe,
    SourceRepoProxy,
    -- * Functions
    srpHoist,
    srpToProxy,
    srpFanOut,
    -- * Grammar
    sourceRepositoryPackageGrammar,
    ) where

import Control.DeepSeq       (NFData (..))
import Data.Functor.Identity (Identity)
import Data.List.NonEmpty    (NonEmpty (..))
import Data.Proxy            (Proxy (..))
import GHC.Generics          (Generic)

import Distribution.Compat.Lens           (Lens, Lens')
import Distribution.FieldGrammar
       (FieldGrammar, ParsecFieldGrammar', PrettyFieldGrammar', monoidalFieldAla, optionalFieldAla, uniqueField, uniqueFieldAla)
import Distribution.FieldGrammar.Newtypes (FilePathNT (..), List, NoCommaFSep (..), Token (..), alaList')
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)
    }
  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)

-- | @since 0.2.1
instance NFData (f FilePath) => NFData (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 #-}

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

sourceRepositoryPackageGrammar
    :: ( FieldGrammar c g, Applicative (g SourceRepoList)
       , c (List NoCommaFSep FilePathNT String)
       , c (Identity RepoType)
       )
    => g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (List NoCommaFSep FilePathNT FilePath), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar = forall (f :: * -> *).
RepoType
-> FilePath
-> Maybe FilePath
-> Maybe FilePath
-> f 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...
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}