Improve Windows support

.gitattributes

@@ -0,0 +1,14 @@
+* text=auto
+*.c text
+*.hs* text
+*.h text
+*.txt text
+*.sh text
+Makefile text
+*.md text
+LICENSE text
+README* text
+Changelog text
+*.y*ml text
+.git* text
+*.cabal text

System/Console/Haskeline/InputT.hs

@@ -11,13 +11,10 @@ import System.Console.Haskeline.Completion
 import System.Console.Haskeline.Backend
 import System.Console.Haskeline.Term
 
-import Control.Exception (IOException)
 import Control.Monad.Catch
 import Control.Monad.Fail as Fail
 import Control.Monad.Fix
 import Data.IORef
-import System.Directory(getHomeDirectory)
-import System.FilePath
 import System.IO
 
 -- | Application-specific customizations to the user interface.
@@ -194,12 +191,3 @@ useFile file = Behavior $ do
 -- If it cannot open the user's terminal, use file-style interaction, reading input from 'stdin'.
 preferTerm :: Behavior
 preferTerm = Behavior terminalRunTerm
-
-
--- | Read 'Prefs' from @~/.haskeline.@   If there is an error reading the file,
--- the 'defaultPrefs' will be returned.
-readPrefsFromHome :: IO Prefs
-readPrefsFromHome = handle (\(_::IOException) -> return defaultPrefs) $ do
-    home <- getHomeDirectory
-    readPrefs (home </> ".haskeline")
-

System/Console/Haskeline/Prefs.hs

@@ -2,26 +2,36 @@ module System.Console.Haskeline.Prefs(
                         Prefs(..),
                         defaultPrefs,
                         readPrefs,
+                        readPrefsFromHome,
                         CompletionType(..),
                         BellStyle(..),
                         EditMode(..),
                         HistoryDuplicates(..),
                         lookupKeyBinding
                         ) where
 
-import Control.Monad.Catch (handle)
+import Control.Monad.Catch(handle,MonadCatch)
+import Control.Monad(filterM, MonadPlus)
 import Control.Exception (IOException)
 import Data.Char(isSpace,toLower)
 import Data.List(foldl')
+import Data.Maybe(listToMaybe)
 import qualified Data.Map as Map
 import System.Console.Haskeline.Key
+import System.Directory(
+  getHomeDirectory, getXdgDirectory, XdgDirectory(XdgConfig), doesFileExist
+  )
+import System.FilePath((</>))
+import System.IO(hPutStrLn,stderr)
 
 {- |
-'Prefs' allow the user to customize the terminal-style line-editing interface.  They are
-read by default from @~/.haskeline@; to override that behavior, use
-'readPrefs' and @runInputTWithPrefs@.
+'Prefs' allow the user to customize the terminal-style line-editing interface.
+They are read by default from $XDG_CONFIG_HOME/haskeline/preferences,
+%APPDATA%/haskeline/preferences or ~/.haskeline.
+They can also be read from a specific file using 'readPrefsFromFile' and
+passed to 'runInputTWithPref'.
 
-Each line of a @.haskeline@ file defines
+Each line of a preferences file defines
 one field of the 'Prefs' datatype; field names are case-insensitive and
 unparseable lines are ignored.  For example:
 
@@ -124,16 +134,50 @@ addCustomKeySequence str = maybe id addKS maybeParse
 lookupKeyBinding :: Key -> Prefs -> [Key]
 lookupKeyBinding k = Map.findWithDefault [k] k . customBindings
 
+(<&>) :: Functor f => f a -> (a -> b) -> f b
+(<&>) = flip fmap
+
+getConfigurationPaths :: IO [FilePath]
+getConfigurationPaths = sequence [
+  getXdgDirectory XdgConfig "haskeline" <&> (</>"preferences"),
+  getHomeDirectory <&> (</>".haskeline")
+  ]
+
+filterPaths :: MonadPlus m => (a -> m Bool) -> m [a] -> m [a]
+filterPaths condition getPaths = getPaths >>= filterM condition
+
+getFirst :: Functor f => f [a] -> f (Maybe a)
+getFirst = fmap listToMaybe
+
 -- | Read 'Prefs' from a given file.  If there is an error reading the file,
 -- the 'defaultPrefs' will be returned.
 readPrefs :: FilePath -> IO Prefs
-readPrefs file = handle (\(_::IOException) -> return defaultPrefs) $ do
-    ls <- fmap lines $ readFile file
+readPrefs path = handle (\(_::IOException) -> do
+                           hPutStrLn stderr ("haskeline: can't read preferences from " ++ path ++ ".")
+                           return defaultPrefs) $ do
+    ls <- fmap lines $ readFile path
     return $! foldl' applyField defaultPrefs ls
   where
     applyField p l = case break (==':') l of
                 (name,val)  -> case lookup (map toLower $ trimSpaces name) settors of
                         Nothing -> p
                         Just set -> set (drop 1 val) p  -- drop initial ":", don't crash if val==""
     trimSpaces = dropWhile isSpace . reverse . dropWhile isSpace . reverse
-
+
+fallback :: IO Prefs
+fallback = do
+    hPutStrLn stderr
+        ("haskeline: IOException while looking for preferences,"
+      ++ "falling back to defaults.")
+    return defaultPrefs
+
+-- | Read 'Prefs' from $XDG_CONFIG_HOME/haskeline/preferences, %APPDATA%/haskeline/preferences or ~/.haskeline.
+readPreferences :: (MonadPlus m, MonadCatch m) => m Prefs -> (FilePath -> m Prefs) -> m (Maybe FilePath) -> m Prefs
+readPreferences exceptionHandler preferencesFromPath getPath = handle (\(_::IOException) -> exceptionHandler)
+    $ getPath >>= maybe (return defaultPrefs) preferencesFromPath
+
+findPreferencePath :: IO (Maybe FilePath)
+findPreferencePath = getFirst $ filterPaths doesFileExist getConfigurationPaths
+
+readPrefsFromHome :: IO Prefs
+readPrefsFromHome = readPreferences fallback readPrefs findPreferencePath