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

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

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

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