SourceRepo.hs

{-# 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
    { srpType     :: !RepoType
    , srpLocation :: !String
    , srpTag      :: !(Maybe String)
    , srpBranch   :: !(Maybe String)
    , srpSubdir   :: !(f FilePath)
    , srpCommand  :: ![String]
    }
  deriving (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 nt s = s { srpSubdir = nt (srpSubdir s) }

srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
srpToProxy s = 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 s@SourceRepositoryPackage { srpSubdir = [] } =
    s { srpSubdir = Nothing } :| []
srpFanOut s@SourceRepositoryPackage { srpSubdir = d:ds } = f d :| map f ds where
    f subdir = s { srpSubdir = Just subdir }

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

srpTypeLens :: Lens' (SourceRepositoryPackage f) RepoType
srpTypeLens f s = fmap (\x -> s { srpType = x }) (f (srpType s))
{-# INLINE srpTypeLens #-}

srpLocationLens :: Lens' (SourceRepositoryPackage f) String
srpLocationLens f s = fmap (\x -> s { srpLocation = x }) (f (srpLocation s))
{-# INLINE srpLocationLens #-}

srpTagLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpTagLens f s = fmap (\x -> s { srpTag = x }) (f (srpTag s))
{-# INLINE srpTagLens #-}

srpBranchLens :: Lens' (SourceRepositoryPackage f) (Maybe String)
srpBranchLens f s = fmap (\x -> s { srpBranch = x }) (f (srpBranch s))
{-# INLINE srpBranchLens #-}

srpSubdirLens :: Lens (SourceRepositoryPackage f) (SourceRepositoryPackage g) (f FilePath) (g FilePath)
srpSubdirLens f s = fmap (\x -> s { srpSubdir = x }) (f (srpSubdir s))
{-# INLINE srpSubdirLens #-}

srpCommandLensNE :: Lens' (SourceRepositoryPackage f) (Maybe (NonEmpty String))
srpCommandLensNE f s = fmap (\x -> s { srpCommand = maybe [] toList x }) (f (nonEmpty (srpCommand 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 = SourceRepositoryPackage
    <$> uniqueField      "type"                                       srpTypeLens
    <*> uniqueFieldAla   "location" Token                             srpLocationLens
    <*> optionalFieldAla "tag"      Token                             srpTagLens
    <*> optionalFieldAla "branch"   Token                             srpBranchLens
    <*> monoidalFieldAla "subdir"   (alaList' NoCommaFSep FilePathNT) srpSubdirLens  -- note: NoCommaFSep is somewhat important for roundtrip, as "." is there...
    <*> fmap (maybe [] toList) pcc
  where
    pcc = optionalFieldAla "post-checkout-command" (alaNonEmpty' NoCommaFSep Token) srpCommandLensNE
{-# SPECIALIZE sourceRepositoryPackageGrammar :: ParsecFieldGrammar' SourceRepoList #-}
{-# SPECIALIZE sourceRepositoryPackageGrammar :: PrettyFieldGrammar' SourceRepoList #-}