{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}
module Cabal.Config (
    -- * Types
    Config (..),
    Repo (..),
    RepoName,
    -- * Parsing
    readConfig,
    findConfig,
    parseConfig,
    resolveConfig,
    -- * Hackage
    cfgRepoIndex,
    hackageHaskellOrg,
    ) where

import Control.DeepSeq          (NFData (..))
import Control.Exception        (throwIO)
import Data.ByteString          (ByteString)
import Data.Function            ((&))
import Data.Functor.Identity    (Identity (..))
import Data.List                (foldl')
import Data.List.NonEmpty       (NonEmpty)
import Data.Map                 (Map)
import Data.Maybe               (fromMaybe)
import Distribution.Compat.Lens (LensLike', over)
import GHC.Generics             (Generic)
import Network.URI              (URI)
import System.Directory         (getAppUserDataDirectory)
import System.Environment       (lookupEnv)
import System.FilePath          ((</>))

import qualified Data.ByteString               as BS
import qualified Data.Map.Strict               as M
import qualified Distribution.CabalSpecVersion as C
import qualified Distribution.FieldGrammar     as C
import qualified Distribution.Fields           as C
import qualified Distribution.Parsec           as C
import qualified Distribution.Utils.Generic    as C

import Cabal.Internal.Newtypes
import Cabal.Parse

infixl 1 <&>
(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-------------------------------------------------------------------------------
-- Read config
-------------------------------------------------------------------------------

-- | High level convenience function to find and read @~\/.cabal\/config@ file
--
-- May throw 'IOException' when file doesn't exist, and 'ParseError'
-- on parse error.
--
readConfig :: IO (Config Identity)
readConfig :: IO (Config Identity)
readConfig = do
    RepoName
fp <- IO RepoName
findConfig
    FieldName
bs <- RepoName -> IO FieldName
BS.readFile RepoName
fp
    (ParseError NonEmpty -> IO (Config Identity))
-> (Config Maybe -> IO (Config Identity))
-> Either (ParseError NonEmpty) (Config Maybe)
-> IO (Config Identity)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty -> IO (Config Identity)
forall e a. Exception e => e -> IO a
throwIO Config Maybe -> IO (Config Identity)
resolveConfig (RepoName
-> FieldName -> Either (ParseError NonEmpty) (Config Maybe)
parseConfig RepoName
fp FieldName
bs)

-------------------------------------------------------------------------------
-- Find config
-------------------------------------------------------------------------------

-- | Find the @~\/.cabal\/config@ file.
findConfig :: IO FilePath
findConfig :: IO RepoName
findConfig = do
    Maybe RepoName
env <- RepoName -> IO (Maybe RepoName)
lookupEnv RepoName
"CABAL_CONFIG"
    case Maybe RepoName
env of
        Just RepoName
p -> RepoName -> IO RepoName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RepoName
p
        Maybe RepoName
Nothing -> do
            RepoName
cabalDir <- IO RepoName
findCabalDir
            RepoName -> IO RepoName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoName
cabalDir RepoName -> RepoName -> RepoName
</> RepoName
"config")

-- | Find the @~\/.cabal@ dir.
findCabalDir :: IO FilePath
findCabalDir :: IO RepoName
findCabalDir = do
    Maybe RepoName
cabalDirVar <- RepoName -> IO (Maybe RepoName)
lookupEnv RepoName
"CABAL_DIR"
    IO RepoName
-> (RepoName -> IO RepoName) -> Maybe RepoName -> IO RepoName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RepoName -> IO RepoName
getAppUserDataDirectory RepoName
"cabal") RepoName -> IO RepoName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RepoName
cabalDirVar

-------------------------------------------------------------------------------
-- Config
-------------------------------------------------------------------------------

-- | Very minimal representation of @~\/.cabal\/config@ file.
data Config f = Config
    { forall (f :: * -> *). Config f -> Map RepoName Repo
cfgRepositories    :: Map RepoName Repo
    , forall (f :: * -> *). Config f -> f RepoName
cfgRemoteRepoCache :: f FilePath
    , forall (f :: * -> *). Config f -> f RepoName
cfgInstallDir      :: f FilePath
    , forall (f :: * -> *). Config f -> f RepoName
cfgStoreDir        :: f FilePath
    }
  deriving ((forall x. Config f -> Rep (Config f) x)
-> (forall x. Rep (Config f) x -> Config f) -> Generic (Config f)
forall x. Rep (Config f) x -> Config f
forall x. Config f -> Rep (Config f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Config f) x -> Config f
forall (f :: * -> *) x. Config f -> Rep (Config f) x
$cfrom :: forall (f :: * -> *) x. Config f -> Rep (Config f) x
from :: forall x. Config f -> Rep (Config f) x
$cto :: forall (f :: * -> *) x. Rep (Config f) x -> Config f
to :: forall x. Rep (Config f) x -> Config f
Generic)

deriving instance Show (f FilePath) => Show (Config f)

-- | @since 0.2.1
instance NFData (f FilePath) => NFData (Config f)

-- | Repository.
--
-- missing @root-keys@, @key-threshold@ which we don't need now.
--
data Repo = Repo
    { Repo -> URI
repoURL    :: URI
    , Repo -> Bool
repoSecure :: Bool -- ^ @since 0.2
    }
  deriving (Int -> Repo -> RepoName -> RepoName
[Repo] -> RepoName -> RepoName
Repo -> RepoName
(Int -> Repo -> RepoName -> RepoName)
-> (Repo -> RepoName)
-> ([Repo] -> RepoName -> RepoName)
-> Show Repo
forall a.
(Int -> a -> RepoName -> RepoName)
-> (a -> RepoName) -> ([a] -> RepoName -> RepoName) -> Show a
$cshowsPrec :: Int -> Repo -> RepoName -> RepoName
showsPrec :: Int -> Repo -> RepoName -> RepoName
$cshow :: Repo -> RepoName
show :: Repo -> RepoName
$cshowList :: [Repo] -> RepoName -> RepoName
showList :: [Repo] -> RepoName -> RepoName
Show, (forall x. Repo -> Rep Repo x)
-> (forall x. Rep Repo x -> Repo) -> Generic Repo
forall x. Rep Repo x -> Repo
forall x. Repo -> Rep Repo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Repo -> Rep Repo x
from :: forall x. Repo -> Rep Repo x
$cto :: forall x. Rep Repo x -> Repo
to :: forall x. Rep Repo x -> Repo
Generic)

-- | Repository name, bare 'String'.
type RepoName = String

-- | @since 0.2.1
instance NFData Repo

-------------------------------------------------------------------------------
-- Finding index
-------------------------------------------------------------------------------

-- | Find a @01-index.tar@ for particular repository
cfgRepoIndex
    :: Config Identity
    -> RepoName
    -> Maybe FilePath
cfgRepoIndex :: Config Identity -> RepoName -> Maybe RepoName
cfgRepoIndex Config Identity
cfg RepoName
repo
    | RepoName
repo RepoName -> Map RepoName Repo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Config Identity -> Map RepoName Repo
forall (f :: * -> *). Config f -> Map RepoName Repo
cfgRepositories Config Identity
cfg =
        RepoName -> Maybe RepoName
forall a. a -> Maybe a
Just (Identity RepoName -> RepoName
forall a. Identity a -> a
runIdentity (Config Identity -> Identity RepoName
forall (f :: * -> *). Config f -> f RepoName
cfgRemoteRepoCache Config Identity
cfg) RepoName -> RepoName -> RepoName
</> RepoName
repo RepoName -> RepoName -> RepoName
</> RepoName
"01-index.tar")
    | Bool
otherwise = Maybe RepoName
forall a. Maybe a
Nothing

-- | The default repository of haskell packages, <https://hackage.haskell.org/>.
hackageHaskellOrg :: RepoName
hackageHaskellOrg :: RepoName
hackageHaskellOrg = RepoName
"hackage.haskell.org"

-------------------------------------------------------------------------------
-- Parsing
-------------------------------------------------------------------------------

-- | Parse @~\/.cabal\/config@ file.
parseConfig :: FilePath -> ByteString -> Either (ParseError NonEmpty) (Config Maybe)
parseConfig :: RepoName
-> FieldName -> Either (ParseError NonEmpty) (Config Maybe)
parseConfig = ([Field Position] -> ParseResult (Config Maybe))
-> RepoName
-> FieldName
-> Either (ParseError NonEmpty) (Config Maybe)
forall a.
([Field Position] -> ParseResult a)
-> RepoName -> FieldName -> Either (ParseError NonEmpty) a
parseWith (([Field Position] -> ParseResult (Config Maybe))
 -> RepoName
 -> FieldName
 -> Either (ParseError NonEmpty) (Config Maybe))
-> ([Field Position] -> ParseResult (Config Maybe))
-> RepoName
-> FieldName
-> Either (ParseError NonEmpty) (Config Maybe)
forall a b. (a -> b) -> a -> b
$ \[Field Position]
fields0 -> do
    let (Fields Position
fields1, [[Section Position]]
sections) = [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields0
    let fields2 :: Fields Position
fields2 = (FieldName -> [NamelessField Position] -> Bool)
-> Fields Position -> Fields Position
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\FieldName
k [NamelessField Position]
_ -> FieldName
k FieldName -> [FieldName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldName]
knownFields) Fields Position
fields1
    Fields Position
-> [[Section Position]] -> ParseResult (Config Maybe)
forall {t :: * -> *}.
Foldable t =>
Fields Position
-> t [Section Position] -> ParseResult (Config Maybe)
parse Fields Position
fields2 [[Section Position]]
sections
  where
    knownFields :: [FieldName]
knownFields = ParsecFieldGrammar (Config Maybe) (Config Maybe) -> [FieldName]
forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList ParsecFieldGrammar (Config Maybe) (Config Maybe)
grammar

    parse :: Fields Position
-> t [Section Position] -> ParseResult (Config Maybe)
parse Fields Position
fields t [Section Position]
sections = do
        Config Maybe
cfg <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar (Config Maybe) (Config Maybe)
-> ParseResult (Config Maybe)
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields ParsecFieldGrammar (Config Maybe) (Config Maybe)
grammar
        (Config Maybe -> (Config Maybe -> Config Maybe) -> Config Maybe)
-> Config Maybe -> [Config Maybe -> Config Maybe] -> Config Maybe
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Config Maybe -> (Config Maybe -> Config Maybe) -> Config Maybe
forall a b. a -> (a -> b) -> b
(&) Config Maybe
cfg ([Config Maybe -> Config Maybe] -> Config Maybe)
-> ParseResult [Config Maybe -> Config Maybe]
-> ParseResult (Config Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Section Position -> ParseResult (Config Maybe -> Config Maybe))
-> [Section Position] -> ParseResult [Config Maybe -> Config Maybe]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Section Position -> ParseResult (Config Maybe -> Config Maybe)
forall (f :: * -> *).
Section Position -> ParseResult (Config f -> Config f)
parseSec (t [Section Position] -> [Section Position]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Section Position]
sections)

    parseSec :: C.Section C.Position -> C.ParseResult (Config f -> Config f)
    parseSec :: forall (f :: * -> *).
Section Position -> ParseResult (Config f -> Config f)
parseSec (C.MkSection (C.Name Position
_pos FieldName
name) [C.SecArgName Position
_pos' FieldName
secName] [Field Position]
fields) | FieldName
name FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"repository" = do
        let repoName :: RepoName
repoName = FieldName -> RepoName
C.fromUTF8BS FieldName
secName
        let fields' :: Fields Position
fields' = (Fields Position, [[Section Position]]) -> Fields Position
forall a b. (a, b) -> a
fst ((Fields Position, [[Section Position]]) -> Fields Position)
-> (Fields Position, [[Section Position]]) -> Fields Position
forall a b. (a -> b) -> a -> b
$ [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields
        Repo
repo <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar Repo Repo
-> ParseResult Repo
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields' ParsecFieldGrammar Repo Repo
repoGrammar
        (Config f -> Config f) -> ParseResult (Config f -> Config f)
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Config f -> Config f) -> ParseResult (Config f -> Config f))
-> (Config f -> Config f) -> ParseResult (Config f -> Config f)
forall a b. (a -> b) -> a -> b
$ ASetter
  (Config f) (Config f) (Map RepoName Repo) (Map RepoName Repo)
-> (Map RepoName Repo -> Map RepoName Repo) -> Config f -> Config f
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Config f) (Config f) (Map RepoName Repo) (Map RepoName Repo)
forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (Map RepoName Repo)
cfgRepositoriesL ((Map RepoName Repo -> Map RepoName Repo) -> Config f -> Config f)
-> (Map RepoName Repo -> Map RepoName Repo) -> Config f -> Config f
forall a b. (a -> b) -> a -> b
$ RepoName -> Repo -> Map RepoName Repo -> Map RepoName Repo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RepoName
repoName Repo
repo

    parseSec Section Position
_ = (Config f -> Config f) -> ParseResult (Config f -> Config f)
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return Config f -> Config f
forall a. a -> a
id

grammar :: C.ParsecFieldGrammar (Config Maybe) (Config Maybe)
grammar :: ParsecFieldGrammar (Config Maybe) (Config Maybe)
grammar = Map RepoName Repo
-> Maybe RepoName
-> Maybe RepoName
-> Maybe RepoName
-> Config Maybe
forall (f :: * -> *).
Map RepoName Repo
-> f RepoName -> f RepoName -> f RepoName -> Config f
Config Map RepoName Repo
forall a. Monoid a => a
mempty
    (Maybe RepoName
 -> Maybe RepoName -> Maybe RepoName -> Config Maybe)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar
     (Config Maybe) (Maybe RepoName -> Maybe RepoName -> Config Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> (RepoName -> FilePathNT)
-> ALens' (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
forall b a s.
(Parsec b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> ParsecFieldGrammar 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)
C.optionalFieldAla FieldName
"remote-repo-cache" RepoName -> FilePathNT
C.FilePathNT ALens' (Config Maybe) (Maybe RepoName)
forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgRemoteRepoCacheL
    ParsecFieldGrammar
  (Config Maybe) (Maybe RepoName -> Maybe RepoName -> Config Maybe)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar
     (Config Maybe) (Maybe RepoName -> Config Maybe)
forall a b.
ParsecFieldGrammar (Config Maybe) (a -> b)
-> ParsecFieldGrammar (Config Maybe) a
-> ParsecFieldGrammar (Config Maybe) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (RepoName -> FilePathNT)
-> ALens' (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
forall b a s.
(Parsec b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> ParsecFieldGrammar 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)
C.optionalFieldAla FieldName
"installdir"        RepoName -> FilePathNT
C.FilePathNT ALens' (Config Maybe) (Maybe RepoName)
forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgInstallDirL
    ParsecFieldGrammar (Config Maybe) (Maybe RepoName -> Config Maybe)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar (Config Maybe) (Config Maybe)
forall a b.
ParsecFieldGrammar (Config Maybe) (a -> b)
-> ParsecFieldGrammar (Config Maybe) a
-> ParsecFieldGrammar (Config Maybe) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (RepoName -> FilePathNT)
-> ALens' (Config Maybe) (Maybe RepoName)
-> ParsecFieldGrammar (Config Maybe) (Maybe RepoName)
forall b a s.
(Parsec b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> ParsecFieldGrammar 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)
C.optionalFieldAla FieldName
"store-dir"         RepoName -> FilePathNT
C.FilePathNT ALens' (Config Maybe) (Maybe RepoName)
forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgStoreDirL

repoGrammar :: C.ParsecFieldGrammar Repo Repo
repoGrammar :: ParsecFieldGrammar Repo Repo
repoGrammar = URI -> Bool -> Repo
Repo
    (URI -> Bool -> Repo)
-> ParsecFieldGrammar Repo URI
-> ParsecFieldGrammar Repo (Bool -> Repo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> (URI -> WrappedURI)
-> ALens' Repo URI
-> ParsecFieldGrammar Repo URI
forall b a s.
(Parsec b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> ParsecFieldGrammar 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
C.uniqueFieldAla  FieldName
"url"    URI -> WrappedURI
WrapURI ALens' Repo URI
forall (f :: * -> *). Functor f => LensLike' f Repo URI
repoURLL
    ParsecFieldGrammar Repo (Bool -> Repo)
-> ParsecFieldGrammar Repo Bool -> ParsecFieldGrammar Repo Repo
forall a b.
ParsecFieldGrammar Repo (a -> b)
-> ParsecFieldGrammar Repo a -> ParsecFieldGrammar Repo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' Repo Bool -> Bool -> ParsecFieldGrammar Repo Bool
forall s.
FieldName -> ALens' s Bool -> Bool -> ParsecFieldGrammar s Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
C.booleanFieldDef FieldName
"secure"         ALens' Repo Bool
forall (f :: * -> *). Functor f => LensLike' f Repo Bool
repoSecureL Bool
False

-------------------------------------------------------------------------------
-- Resolving
-------------------------------------------------------------------------------

-- | Fill the default in @~\/.cabal\/config@  file.
resolveConfig :: Config Maybe -> IO (Config Identity)
resolveConfig :: Config Maybe -> IO (Config Identity)
resolveConfig Config Maybe
cfg = do
    RepoName
c <- IO RepoName
findCabalDir
    Config Identity -> IO (Config Identity)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config Maybe
cfg
        { cfgRemoteRepoCache = Identity $ fromMaybe (c </> "packages") (cfgRemoteRepoCache cfg)
        , cfgInstallDir      = Identity $ fromMaybe (c </> "bin")      (cfgInstallDir cfg)
        , cfgStoreDir        = Identity $ fromMaybe (c </> "store")    (cfgStoreDir cfg)
        }

-------------------------------------------------------------------------------
-- Lenses
-------------------------------------------------------------------------------

cfgRepositoriesL :: Functor f => LensLike' f (Config g) (Map String Repo)
cfgRepositoriesL :: forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (Map RepoName Repo)
cfgRepositoriesL Map RepoName Repo -> f (Map RepoName Repo)
f Config g
cfg = Map RepoName Repo -> f (Map RepoName Repo)
f (Config g -> Map RepoName Repo
forall (f :: * -> *). Config f -> Map RepoName Repo
cfgRepositories Config g
cfg) f (Map RepoName Repo)
-> (Map RepoName Repo -> Config g) -> f (Config g)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Map RepoName Repo
x -> Config g
cfg { cfgRepositories = x }

cfgRemoteRepoCacheL :: Functor f => LensLike' f (Config g) (g FilePath)
cfgRemoteRepoCacheL :: forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgRemoteRepoCacheL g RepoName -> f (g RepoName)
f Config g
cfg = g RepoName -> f (g RepoName)
f (Config g -> g RepoName
forall (f :: * -> *). Config f -> f RepoName
cfgRemoteRepoCache Config g
cfg) f (g RepoName) -> (g RepoName -> Config g) -> f (Config g)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \g RepoName
x -> Config g
cfg { cfgRemoteRepoCache = x }

cfgInstallDirL :: Functor f => LensLike' f (Config g) (g FilePath)
cfgInstallDirL :: forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgInstallDirL g RepoName -> f (g RepoName)
f Config g
cfg = g RepoName -> f (g RepoName)
f (Config g -> g RepoName
forall (f :: * -> *). Config f -> f RepoName
cfgInstallDir Config g
cfg) f (g RepoName) -> (g RepoName -> Config g) -> f (Config g)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \g RepoName
x -> Config g
cfg { cfgInstallDir = x }

cfgStoreDirL :: Functor f => LensLike' f (Config g) (g FilePath)
cfgStoreDirL :: forall (f :: * -> *) (g :: * -> *).
Functor f =>
LensLike' f (Config g) (g RepoName)
cfgStoreDirL g RepoName -> f (g RepoName)
f Config g
cfg = g RepoName -> f (g RepoName)
f (Config g -> g RepoName
forall (f :: * -> *). Config f -> f RepoName
cfgStoreDir Config g
cfg) f (g RepoName) -> (g RepoName -> Config g) -> f (Config g)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \g RepoName
x -> Config g
cfg { cfgStoreDir = x }

repoURLL :: Functor f => LensLike' f Repo URI
repoURLL :: forall (f :: * -> *). Functor f => LensLike' f Repo URI
repoURLL URI -> f URI
f Repo
s = URI -> f URI
f (Repo -> URI
repoURL Repo
s) f URI -> (URI -> Repo) -> f Repo
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \URI
x -> Repo
s { repoURL = x }

repoSecureL :: Functor f => LensLike' f Repo Bool
repoSecureL :: forall (f :: * -> *). Functor f => LensLike' f Repo Bool
repoSecureL Bool -> f Bool
f Repo
s = Bool -> f Bool
f (Repo -> Bool
repoSecure Repo
s) f Bool -> (Bool -> Repo) -> f Repo
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
x -> Repo
s { repoSecure = x }