{-# 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 -> 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)
    }
  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)

-- | @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 = 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 #-}

-------------------------------------------------------------------------------
-- 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 String), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar = RepoType
-> String
-> Maybe String
-> Maybe String
-> [String]
-> SourceRepoList
forall (f :: * -> *).
RepoType
-> String
-> Maybe String
-> Maybe String
-> f String
-> SourceRepositoryPackage f
SourceRepositoryPackage
    (RepoType
 -> String
 -> Maybe String
 -> Maybe String
 -> [String]
 -> SourceRepoList)
-> g SourceRepoList RepoType
-> g SourceRepoList
     (String
      -> Maybe String -> Maybe 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] -> SourceRepoList)
-> g SourceRepoList String
-> g SourceRepoList
     (Maybe String -> Maybe 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] -> SourceRepoList)
-> g SourceRepoList (Maybe String)
-> g SourceRepoList (Maybe 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] -> SourceRepoList)
-> g SourceRepoList (Maybe 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 -> 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] -> 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
<*> 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...
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}