Fix Binary instance of Q to handle empty file paths (haskell/ghcide#707)

Author: cocreature

ghcide/ghcide.cabal

@@ -296,6 +296,7 @@ test-suite ghcide-tests
     build-depends:
         aeson,
         base,
+        binary,
         bytestring,
         containers,
         directory,

ghcide/src/Development/IDE/Core/Shake.hs

@@ -57,7 +57,9 @@ module Development.IDE.Core.Shake(
     ProgressEvent(..),
     DelayedAction, mkDelayedAction,
     IdeAction(..), runIdeAction,
-    mkUpdater
+    mkUpdater,
+    -- Exposed for testing.
+    Q(..),
     ) where
 
 import           Development.Shake hiding (ShakeValue, doesFileExist, Info)
@@ -792,7 +794,14 @@ isBadDependency x
 newtype Q k = Q (k, NormalizedFilePath)
     deriving (Eq,Hashable,NFData, Generic)
 
-instance Binary k => Binary (Q k)
+instance Binary k => Binary (Q k) where
+    put (Q (k, fp)) = put (k, fp)
+    get = do
+        (k, fp) <- get
+        -- The `get` implementation of NormalizedFilePath
+        -- does not handle empty file paths so we
+        -- need to handle this ourselves here.
+        pure (Q (k, toNormalizedFilePath' fp))
 
 instance Show k => Show (Q k) where
     show (Q (k, file)) = show k ++ "; " ++ fromNormalizedFilePath file

ghcide/test/exe/Main.hs

@@ -16,12 +16,14 @@ import qualified Control.Lens as Lens
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, Value)
+import qualified Data.Binary as Binary
 import Data.Foldable
 import Data.List.Extra
 import Data.Maybe
 import Data.Rope.UTF16 (Rope)
 import qualified Data.Rope.UTF16 as Rope
 import Development.IDE.Core.PositionMapping (fromCurrent, toCurrent)
+import Development.IDE.Core.Shake (Q(..))
 import Development.IDE.GHC.Util
 import qualified Data.Text as T
 import Data.Typeable
@@ -2832,6 +2834,8 @@ unitTests = do
      , testCase "from empty path URI" $ do
          let uri = Uri "file://"
          uriToFilePath' uri @?= Just ""
+     , testCase "Key with empty file path roundtrips via Binary"  $
+         Binary.decode (Binary.encode (Q ((), emptyFilePath))) @?= Q ((), emptyFilePath)
      ]
 
 positionMappingTests :: TestTree