From 73bf0e9f1793e8dd6634da4525341fd8a862a01f Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 15 Feb 2023 07:43:52 +0300
Subject: [PATCH] fixed wrong-default-config-path

---
 .fixme/log                  |  4 +++-
 docs/devlog.md              |  2 ++
 hbs2-peer/app/PeerConfig.hs | 12 +++++++++---
 3 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/.fixme/log b/.fixme/log
index e176eed8..d5d33f91 100644
--- a/.fixme/log
+++ b/.fixme/log
@@ -153,4 +153,6 @@ fixme-merged "H9Hiq71jji" "DFYZXyqCyr"
 fixme-set "workflow" "backlog" "9v1QCP5JAL"
 fixme-set "workflow" "backlog" "G9xp6QQkRE"
 
-fixme-merged "AmtqsgpimE" "AEuRHd5sWC"
\ No newline at end of file
+fixme-merged "AmtqsgpimE" "AEuRHd5sWC"
+fixme-set "workflow" "wip" "DZyVAuBYzB"
+
diff --git a/docs/devlog.md b/docs/devlog.md
index fbd6f5fc..18246a93 100644
--- a/docs/devlog.md
+++ b/docs/devlog.md
@@ -1,6 +1,8 @@
 
 ## 2023-02-15
 
+FIXME: wrong-default-config-path
+
 TODO: make-key-optional-parameter
 
   -k should be an optional parameter
diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs
index 11b0bb74..30172876 100644
--- a/hbs2-peer/app/PeerConfig.hs
+++ b/hbs2-peer/app/PeerConfig.hs
@@ -77,9 +77,11 @@ peerConfigRead mbfp = do
 
   xdg <- peerConfigDefault
 
-  let cfgPath = fromMaybe xdg mbfp </> cfgName
+  let cfgPath = fromMaybe xdg mbfp
   let dir = takeDirectory cfgPath
 
+  debug $ "searching config" <+> pretty cfgPath
+
   here <- liftIO $ doesFileExist cfgPath
 
   if not here then do
@@ -91,7 +93,11 @@ peerConfigRead mbfp = do
     -- FIXME: config-parse-error-handling
     --  Handle parse errors
 
-    confData <- liftIO $ readFile cfgPath <&> parseTop
+    debug $ pretty cfgPath
+
+    confData <- liftIO $ readFile cfgPath <&> parseTop <&> either mempty id
+
+    debug $ pretty confData
 
     config <- flip transformBiM confData $ \case
                 List co (Key "key" [LitStrVal p]) -> do
@@ -104,7 +110,7 @@ peerConfigRead mbfp = do
 
                 x -> pure x
 
-    pure $ PeerConfig $ fromRight mempty config
+    pure $ PeerConfig config
 
 
 instance {-# OVERLAPPABLE #-} (IsString b, HasCfgKey a (Maybe b)) => HasCfgValue a (Maybe b) where