From 69c995891e2e9391b940ef1aa543028979870b3a Mon Sep 17 00:00:00 2001
From: Will Donnelly <will.donnelly@gmail.com>
Date: Fri, 24 Jul 2009 10:21:28 -0500
Subject: [PATCH] Works on Windows now.

---
 System/IO/Storage.hs | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/System/IO/Storage.hs b/System/IO/Storage.hs
index 6e53186..cbf57fa 100644
--- a/System/IO/Storage.hs
+++ b/System/IO/Storage.hs
@@ -19,6 +19,7 @@ after using a store, as a precaution against the (very unlikely) situation
 where a program manages to access ghost data from a previous invocation.
 
 -}
+{-# LANGUAGE CPP #-}
 module System.IO.Storage
     ( putValue
     , getValue
@@ -34,20 +35,32 @@ import System.Directory     ( getTemporaryDirectory, createDirectoryIfMissing
                             , doesFileExist, getDirectoryContents, removeFile
                             , removeDirectory, removeDirectoryRecursive )
 import System.Environment   ( getProgName )
-import System.Posix.Process ( getProcessID )
 import Data.List            ( (\\) )
 import Data.Maybe           ( fromMaybe )
 
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+
+getIdentifier = do progName <- getProgName
+                   return . stripChars $ "kv-store-" ++ progName ++ "-pid-hack"
+  where stripChars = filter (not . (`elem`"<>"))
+
+#else
+
+import System.Posix.Process ( getProcessID )
+getIdentifier = do progName <- getProgName
+                   procID   <- getProcessID
+                   return $ "kv-store-" ++ progName ++ "-" ++ procID
+
+#endif
+
 -- | We generate the storage path from the program name combined
 --   with the PID. We basically just have to hope we don't get
 --   the same *both* before the temp dir gets cleared.
 getStoragePath :: String -> IO String
 getStoragePath db = do
-    progName <- getProgName
-    procID   <- getProcessID
-    let fullName = "kv-store" ++ "-" ++ progName ++ "-" ++ (show procID)
+    identifier <- getIdentifier
     tempPath <- getTemporaryDirectory
-    return $ tempPath </> fullName </> db
+    return $ tempPath </> identifier </> db
 
 -- | Stores a value
 putValue :: Show a => String -> String -> a -> IO ()