mirror of https://github.com/voidlizard/hbs2
Refactoring
This commit is contained in:
parent
cadcfc38f1
commit
343417c5d8
|
@ -135,7 +135,7 @@ peerConfigRead mbfp = do
|
|||
|
||||
confData' <- parseConf cfgPath
|
||||
|
||||
knownPeersFiles <- mapM (liftIO . canonicalizePath . (dir </>)) (cfgValue @PeerKnownPeersFile $ PeerConfig confData')
|
||||
knownPeersFiles <- mapM (canonicalizePath' dir) (cfgValue @PeerKnownPeersFile $ PeerConfig confData')
|
||||
|
||||
knownPeersConfData <- concat <$> mapM parseConf knownPeersFiles
|
||||
|
||||
|
@ -143,23 +143,21 @@ peerConfigRead mbfp = do
|
|||
|
||||
-- debug $ pretty confData
|
||||
|
||||
config <- flip transformBiM confData $ \case
|
||||
List co (Key "key" [LitStrVal p]) -> do
|
||||
kp <- liftIO $ canonicalizePath (dir </> Text.unpack p)
|
||||
pure $ List @C co [Symbol co "key", Literal co (mkLit (Text.pack kp)) ]
|
||||
|
||||
List co (Key "storage" [LitStrVal p]) -> do
|
||||
kp <- liftIO $ canonicalizePath (dir </> Text.unpack p)
|
||||
pure $ List @C co [Symbol co "storage", Literal co (mkLit (Text.pack kp)) ]
|
||||
|
||||
List co (Key "download-log" [LitStrVal p]) -> do
|
||||
kp <- liftIO $ canonicalizePath (dir </> Text.unpack p)
|
||||
pure $ List @C co [Symbol co "download-log", Literal co (mkLit (Text.pack kp)) ]
|
||||
|
||||
x -> pure x
|
||||
config <- transformBiM (canonicalizeConfPaths ["key", "storage", "download"] dir) confData
|
||||
|
||||
pure $ PeerConfig config
|
||||
where
|
||||
canonicalizePath' :: MonadIO m => FilePath -> FilePath -> m FilePath
|
||||
canonicalizePath' dir = liftIO . canonicalizePath . (dir </>)
|
||||
|
||||
canonicalizeConfPaths :: MonadIO m => [Id] -> FilePath -> Syntax C -> m (Syntax C)
|
||||
canonicalizeConfPaths keys dir x@(List co (Key k [LitStrVal path])) =
|
||||
if k `elem` keys
|
||||
then do
|
||||
canonicalPath <- canonicalizePath' dir $ Text.unpack path
|
||||
pure $ List @C co [Symbol co k, Literal co (mkLit (Text.pack canonicalPath))]
|
||||
else pure x
|
||||
canonicalizeConfPaths _ _ x = pure x
|
||||
|
||||
instance {-# OVERLAPPABLE #-} (IsString b, HasCfgKey a (Maybe b)) => HasCfgValue a (Maybe b) where
|
||||
cfgValue (PeerConfig syn) = val
|
||||
|
|
Loading…
Reference in New Issue