diohsc 0.1.14 → 0.1.14.1

raw patch · 10 files changed

+50/−52 lines, 10 filesdep +hashabledep −data-hash

Dependencies added: hashable

Dependencies removed: data-hash

Files

• BStack.hs +1/−1
• ClientState.hs +1/−2
• Command.hs +1/−1
• LineClient.hs +5/−4
• Makefile +1/−1
• Marks.hs +10/−18
• ResolveTarget.hs +2/−2
• Version.hs +1/−1
• diohsc.cabal +5/−7
• diohsc.hs +23/−15

@@ -19,7 +19,7 @@ import qualified Data.Sequence as S import           Prelude       hiding (truncate) -data BStack a = BStack (Seq a) Int+data BStack a = BStack { stack :: Seq a, size :: Int }  fromList :: [a] -> BStack a fromList as = BStack (S.fromList as) $ length as

@@ -11,7 +11,6 @@ module ClientState where  import           Control.Monad.State (StateT, modify)-import           Data.Hash           (Hash) import           Text.Regex          (Regex)  import qualified Data.Map            as M@@ -48,7 +47,7 @@     { clientCurrent          :: Maybe HistoryItem     , clientJumpBack         :: Maybe HistoryItem     , clientLog              :: BStack.BStack T.Text-    , clientVisited          :: S.Set Hash+    , clientVisited          :: S.Set Int     , clientQueues           :: QueueMap     , clientActiveIdentities :: ActiveIdentities     , clientMarks            :: Marks

@@ -320,7 +320,7 @@             [ "{set} {link_desc_first} true: show link description before uri"             , "{set} {link_desc_first} false: show uri before link description" ]         "log_length" ->-            [ "{set} {log_length} N: set number of items to store in log"+            [ "{set} {log_length} N: set approximate number of items to store in log"             , "{set} {log_length} 0: clear log and disable logging"             , "See also: {log}" ]         "max_wrap_width" ->

@@ -26,7 +26,7 @@ import           Data.Bifunctor               (second) import qualified Data.ByteString.Lazy         as BL import           Data.Char                    (toLower)-import           Data.Hash                    (hash)+import           Data.Hashable                (hash) import           Data.IORef                   (modifyIORef, newIORef, readIORef) import           Data.List                    (intercalate, isPrefixOf,                                                isSuffixOf, sort, stripPrefix)@@ -269,7 +269,7 @@     bold = applyIf ansi withBoldStr      isVisited :: URI -> Bool-    isVisited uri = S.member (hash $ show uri) visited+    isVisited uri = S.member (hash . T.pack $ show uri) visited      requestOfUri = requestOfProxiesAndUri proxies @@ -310,7 +310,7 @@         let t = T.pack $ show uri         modify $ \s -> s             { clientLog = BStack.push maxLogLen t $ clientLog s-            , clientVisited = S.insert (hash $ show uri) $ clientVisited s }+            , clientVisited = S.insert (hash . T.pack $ show uri) $ clientVisited s }         unless ghost . liftIO $ maybe (return ()) (ignoreIOErr . (`T.hPutStrLn` t)) logH      preprocessQuery :: String -> ClientM String@@ -402,10 +402,11 @@      handleCommand [] ("mark", []) =         let ms = M.toAscList marks-            markLine (m, uriId) = let m' = showMinPrefix ansi (fst <$> ms) m+            markLine (m, Just uriId) = let m' = showMinPrefix ansi (fst <$> ms) m                 in T.pack $ "'" <> m' <>                     replicate (max 1 $ 16 - visibleLength (T.pack m')) ' ' <>                     showUriWithId uriId+            markLine (m, Nothing) = T.pack $ "'" <> m <> " [Failed to read mark]"         in doPage $ markLine <$> ms     handleCommand [] ("inventory",_) = do         ais <- gets clientActiveIdentities

@@ -1,4 +1,4 @@-VERSION=0.1.14+VERSION=0.1.14.1  GHCOPTS=-threaded -DICONV -DMAGIC -ignore-package regex-compat-tdfa 

@@ -9,19 +9,16 @@ -- along with this program.  If not, see http://www.gnu.org/licenses/.  {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Safe              #-} {-# LANGUAGE TupleSections     #-}  module Marks where -import           Control.Exception  (handle) import           Control.Monad      (guard, msum)-import           Data.Bifunctor     (second) import           Data.Char          (isAlphaNum)-import           Data.Either        (partitionEithers) import           Data.List          (isPrefixOf) import           System.Directory import           System.FilePath+import           System.IO.Unsafe   (unsafeInterleaveIO)  import qualified Data.ByteString    as BS import qualified Data.Map           as Map@@ -49,34 +46,29 @@         return . URIWithIdName uri . Just $ TS.unpack idName     , (`URIWithIdName` Nothing) <$> (parseUriAsAbsolute . escapeIRI $ TS.unpack s) ] -type Marks = Map.Map String URIWithIdName+type Marks = Map.Map String (Maybe URIWithIdName)  emptyMarks :: Marks emptyMarks = Map.empty  lookupMark :: String -> Marks -> Maybe URIWithIdName lookupMark s marks = do-    (s',uriId) <- Map.lookupGE s marks+    (s', Just uriId) <- Map.lookupGE s marks     guard $ s `isPrefixOf` s'     return uriId  insertMark :: String -> URIWithIdName -> Marks -> Marks-insertMark = Map.insert+insertMark s = Map.insert s . Just -loadMarks :: FilePath -> IO ([String], Marks)+loadMarks :: FilePath -> IO Marks loadMarks path =-    second Map.fromList . partitionEithers <$> (mapM loadMark =<< ignoreIOErr (listDirectory path))+    (Map.fromList <$>) $ mapM lazyKeyVal =<< ignoreIOErr (listDirectory path)     where-    loadMark :: FilePath -> IO (Either String (String, URIWithIdName))+    lazyKeyVal f = (f,) <$> unsafeInterleaveIO (loadMark f)+    loadMark :: FilePath -> IO (Maybe URIWithIdName)     loadMark filename =         let filepath = path </> filename-            onIOErr :: IOError -> IO (Either String a)-            onIOErr e = return . Left $-                "Error loading mark from " ++ path ++ ": " ++ show e--        in handle onIOErr $ maybe (Left $-                    "Failed to decode uri in:" ++ show filepath)-                (Right . (filename,)) . readUriWithId . TS.strip . TS.decodeUtf8 <$> BS.readFile filepath+        in ignoreIOErrAlt $ readUriWithId . TS.strip . TS.decodeUtf8 <$> BS.readFile filepath  markNameValid :: String -> Bool markNameValid = all isAlphaNum@@ -88,7 +80,7 @@ saveMark _ _ _ = pure ()  marksWithUri :: URI -> Marks -> [(String,URIWithIdName)]-marksWithUri uri = Map.toList . Map.filter ((==uri) . uriIdUri)+marksWithUri uri = Map.toList . Map.filter ((==uri) . uriIdUri) . Map.mapMaybe id  tempMarks :: [String] tempMarks = (:[]) <$> ['0'..'9']

@@ -13,7 +13,7 @@ module ResolveTarget (resolveTarget) where  import           Data.Char      (isUpper)-import           Data.Hash      (hash)+import           Data.Hashable  (hash) import           Data.Maybe import           Safe import           Text.Regex     (matchRegex, mkRegexWithOpts)@@ -158,6 +158,6 @@     matchPatternOn f patt = matchPattern patt . f      isVisited :: URI -> Bool-    isVisited uri = S.member (hash $ show uri) visited+    isVisited uri = S.member (hash . T.pack $ show uri) visited      loggedUris = catMaybes $ (parseAbsoluteUri . escapeIRI . T.unpack <$>) $ BStack.toList cLog

@@ -16,4 +16,4 @@ programName = "diohsc"  version :: String-version = "0.1.14"+version = "0.1.14.1"

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               diohsc-version:            0.1.14+version:            0.1.14.1 license:            GPL-3 license-file:       COPYING maintainer:         mbays@sdf.org@@ -26,11 +26,9 @@  flag libiconv     description:-        On windows: use libiconv for charset conversion-        (iconv is always used on POSIX systems, with no need for this flag)+        Use libiconv for charset conversion -    default:     False-    manual:      True+    default:     True  flag magic     description: Use libmagic to determine mimetypes of local files@@ -94,7 +92,7 @@         containers >=0.5.5.1 && <0.7,         cryptonite >=0.26 && <0.31,         data-default-class >=0.1.2.0 && <0.2,-        data-hash >=0.2.0.1 && <0.3,+        hashable >= 1.1 && <1.5,         directory >=1.2.1.0 && <1.4,         drunken-bishop >=0.1.0.0 && <0.2,         exceptions >=0.10.4 && <0.11,@@ -135,6 +133,6 @@     if flag(irilinks)         cpp-options: -DIRILinks -    if (!os(windows) || flag(libiconv))+    if flag(libiconv)         cpp-options:   -DICONV         build-depends: iconv >=0.4.1.3 && <0.5

@@ -12,14 +12,16 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}  module Main where  import           Control.Monad.Catch import           Control.Monad.State -import           Data.Hash                (hash)+import           Data.Hashable            (hash) import           Data.Maybe+import           Data.Semigroup           (Any (..)) import qualified Data.Set                 as S import qualified Data.Text.Lazy           as T import qualified Data.Text.Lazy.IO        as T@@ -30,6 +32,7 @@ import           System.Exit import           System.FilePath import           System.IO+import           System.IO.Unsafe         (unsafeInterleaveIO)   import qualified BStack@@ -64,13 +67,15 @@     outTerm <- hIsTerminalDevice stdout     let ansi = NoAnsi `notElem` opts && (outTerm || Ansi `elem` opts) -    let argCommands (ScriptFile "-") = warnIOErrAlt $+    let argCommands :: Opt -> IO (Any, [String])+        argCommands (ScriptFile "-") = ((Any True,) <$>) . warnIOErrAlt $             (T.unpack . T.strip <$>) . T.lines <$> T.getContents-        argCommands (ScriptFile f) = warnIOErrAlt $ (T.unpack <$>) <$> readFileLines f-        argCommands (OptCommand c) = return [c]-        argCommands _ = return []-    optCommands <- concat <$> mapM argCommands opts-    let repl = (null optCommands && Batch `notElem` opts) || Prompt `elem` opts+        argCommands (ScriptFile f) = ((Any True,) <$>) . warnIOErrAlt $+            (T.unpack <$>) <$> readFileLines f+        argCommands (OptCommand c) = return (Any True, [c])+        argCommands _ = return (Any False, [])+    (Any commandsInOpts, optCommands) <- mconcat <$> mapM argCommands opts+    let repl = (not commandsInOpts && Batch `notElem` opts) || Prompt `elem` opts     let interactive = Batch `notElem` opts && (repl || Interactive `elem` opts)      let argToUri arg = doesPathExist arg >>= \case@@ -102,16 +107,16 @@             (listToMaybe [ h | SocksHost h <- opts ])             . fromMaybe "1080" $ listToMaybe [ p | SocksPort p <- opts ] -    requestContext <- initRequestContext callbacks userDataDir ghost socksProxy-    (warnings, marks) <- loadMarks marksPath-    displayWarning warnings+    requestContext <- unsafeInterleaveIO $ initRequestContext callbacks userDataDir ghost socksProxy+    marks <- unsafeInterleaveIO $ loadMarks marksPath     let hlSettings = (HL.defaultSettings::HL.Settings ClientM)             { HL.complete = HL.noCompletion             , HL.historyFile = if ghost then Nothing else Just cmdHistoryPath             } -    cLog <- BStack.fromList . reverse <$> readFileLines logPath-    let visited = S.fromList $ hash . T.unpack <$> BStack.toList cLog+    logLines <- reverse <$> readFileLines logPath+    let cLog = BStack.fromList logLines+    let visited = S.fromList $ hash <$> logLines      let openLog :: IO (Maybe Handle)         openLog = ignoreIOErrAlt $ Just <$> do@@ -130,6 +135,9 @@             endState <- (`execStateT` initState) . HL.runInputT hlSettings $                 lineClient clientOptions initialCommands repl             closeLog logH-            -- |reread file rather than just writing clientLog, in case another instance has also-            -- been appending to the log.-            unless ghost . warnIOErr $ truncateToEnd (clientConfMaxLogLen $ clientConfig endState) logPath+            let maxlen = clientConfMaxLogLen $ clientConfig endState+                curlen = BStack.size $ clientLog endState+            when (not ghost && curlen > maxlen + maxlen `div` 10) . warnIOErr $+                -- |reread file rather than just writing clientLog, in case+                -- another instance has also been appending to the log.+                truncateToEnd maxlen logPath