wsedit can now open binary files (although not very gracefully), fixe…

…d the BOM sticking (and eventually stacking) around in UTF-16 / UTF-32 encoding.
SOwOphie · Jul 8, 2016 · a79c3ac · a79c3ac
1 parent 1e96a5c
commit a79c3ac
Show file tree

Hide file tree

Showing 4 changed files with 60 additions and 47 deletions.
diff --git a/WSEdit.hs b/WSEdit.hs
@@ -199,9 +199,8 @@ start = do
         exec :: Bool -> WSEdit ()
         exec b = do
             when b $ catchEditor load $ \e ->
-                quitComplain $ "An I/O error occured:\n\n"
+                quitComplain $ "An uncommon I/O error occured while loading:\n\n"
                             ++ show e
-                            ++ "\n\nAre you trying to open a binary file?"
 
             mainLoop
             drawExitFrame

diff --git a/WSEdit/Control/Global.hs b/WSEdit/Control/Global.hs
@@ -21,6 +21,7 @@ import Control.Exception           (SomeException, try)
 import Control.Monad               (when)
 import Control.Monad.IO.Class      (liftIO)
 import Control.Monad.RWS.Strict    (ask, get, modify, put)
+import Data.Char                   (chr)
 import Data.Maybe                  (fromMaybe)
 import Graphics.Vty                (Vty (shutdown))
 import Safe                        (fromJustNote)
@@ -32,8 +33,8 @@ import System.Directory            ( doesFileExist, getHomeDirectory
 import System.Exit                 (exitFailure)
 import System.IO                   ( IOMode (AppendMode, ReadMode, WriteMode)
                                    , NewlineMode
-                                   , hPutStr, hSetEncoding, hSetNewlineMode
-                                   , mkTextEncoding, withFile
+                                   , char8, hPutStr, hSetEncoding
+                                   , hSetNewlineMode, mkTextEncoding, withFile
                                    )
 import System.IO.Strict            (hGetContents)
 import Text.Show.Pretty            (ppShow)
@@ -222,44 +223,50 @@ load = alterState $ do
 
     s <- get
 
-    (if b
-        then liftIO $ readF p'
-        else return $ Just "") >>= \case
-        Nothing  -> quitComplain "File read error: unknown file encoding."
-        Just txt -> do
-            let l = fromMaybe (B.singleton (False, ""))
-                  $ B.fromList
-                  $ zip (repeat False)
-                  $ map (filter (/= '\r'))
-                  $ lines txt
-
-            put $ s
-                { edLines     = B.toFirst l
-                , fname       = p'
-                , cursorPos   = 1
-                , readOnly    = not w || readOnly s
-                , replaceTabs = if detectTabs s
-                                   then '\t' `notElem` txt
-                                   else replaceTabs s
-                }
-
-            setStatus $ case (b    , w    ) of
-                             (True , True ) -> "Loaded "
-                                            ++ show (length $ lines txt)
-                                            ++ " lines of text."
-
-                             (True , False) -> "Warning: file not writable, "
-                                            ++ "opening in read-only mode ..."
-
-                             (False, True ) -> "Warning: file "
-                                            ++ p'
-                                            ++ " not found, creating on "
-                                            ++ "save ..."
-
-                             (False, False) -> "Warning: cannot create file "
-                                            ++ p'
-                                            ++ " , check permissions and disk "
-                                            ++ "state."
+    (encSucc, txt) <- if b
+                         then liftIO $ readF p'
+                         else return $ (True, "")
+
+    let txt' = if encSucc
+                  then dropWhile (`elem` [chr 0xFFFE, chr 0xFEFF]) txt
+                  else txt
+
+        l    = fromMaybe (B.singleton (False, ""))
+             $ B.fromList
+             $ zip (repeat False)
+             $ map (filter (/= '\r'))
+             $ lines txt'
+
+    put $ s
+        { edLines     = B.toFirst l
+        , fname       = p'
+        , cursorPos   = 1
+        , readOnly    = not (encSucc && w && not (readOnly s))
+        , replaceTabs = if detectTabs s
+                           then '\t' `notElem` txt
+                           else replaceTabs s
+        }
+
+    setStatus $ case (b    , w    , encSucc) of
+                     (True , True , True   ) -> "Loaded "
+                                             ++ show (length $ lines txt)
+                                             ++ " lines of text."
+
+                     (True , False, True   ) -> "Warning: file not writable, "
+                                             ++ "opening in read-only mode ..."
+
+                     (True , _    , False  ) -> "Warning: unknown character "
+                                             ++ "encoding, opening raw..."
+
+                     (False, True , _      ) -> "Warning: file "
+                                             ++ p'
+                                             ++ " not found, creating on "
+                                             ++ "save ..."
+
+                     (False, False, _      ) -> "Warning: cannot create file "
+                                             ++ p'
+                                             ++ " , check permissions and disk "
+                                             ++ "state."
 
     -- Move the cursor to where it should be placed.
     uncurry moveCursor $ withPair dec dec $ loadPos s
@@ -270,12 +277,19 @@ load = alterState $ do
         dec :: Int -> Int
         dec n = n - 1
 
-        readF :: FilePath -> IO (Maybe String)
+        -- | Returns the string, plus whether the file encoding could safely be
+        --   determined.
+        readF :: FilePath -> IO (Bool, String)
         readF f = S.readFile f >>= detectEncoding >>= \case
-            Nothing -> return Nothing
+            Nothing -> withFile f ReadMode $ \h -> do
+                hSetEncoding h char8
+                s <- hGetContents h
+                return (False, s)
+
             Just  e -> withFile f ReadMode $ \h -> do
                 hSetEncoding h e
-                Just <$> hGetContents h
+                s <- hGetContents h
+                return (True, s)
 
 
 

diff --git a/WSEdit/Data.hs b/WSEdit/Data.hs
@@ -78,7 +78,7 @@ fqn = ("WSEdit.Data." ++)
 
 -- | Version number constant.
 version :: String
-version = "1.0.0.5 RC"
+version = "1.0.0.6 RC"
 
 -- | Upstream URL.
 upstream :: String

diff --git a/wsedit.cabal b/wsedit.cabal
@@ -1,5 +1,5 @@
 name:                wsedit
-version:             1.0.0.5
+version:             1.0.0.6
 synopsis:            A simple terminal source code editor.
 description:
 homepage: