merging sqlite and bs branches
Since the sqlite branch uses blobs extensively, there are some performance benefits, ByteStrings now get stored and retrieved w/o conversion in some cases like in Database.Export.
This commit is contained in:
commit
2f9a80d803
266 changed files with 2860 additions and 1325 deletions
|
@ -5,6 +5,8 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Applicative (
|
||||
(<$$>),
|
||||
) where
|
||||
|
|
21
Utility/Attoparsec.hs
Normal file
21
Utility/Attoparsec.hs
Normal file
|
@ -0,0 +1,21 @@
|
|||
{- attoparsec utility functions
|
||||
-
|
||||
- Copyright 2019 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2007-2015 Bryan O'Sullivan
|
||||
-
|
||||
- License: BSD-3-clause
|
||||
-}
|
||||
|
||||
module Utility.Attoparsec where
|
||||
|
||||
import qualified Data.Attoparsec.ByteString as A
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
-- | Parse and decode an unsigned octal number.
|
||||
--
|
||||
-- This parser does not accept a leading @\"0o\"@ string.
|
||||
octal :: Integral a => A.Parser a
|
||||
octal = B.foldl' step 0 `fmap` A.takeWhile1 isOctDigit
|
||||
where
|
||||
isOctDigit w = w >= 48 && w <= 55
|
||||
step a w = a * 8 + fromIntegral (w - 48)
|
|
@ -4,6 +4,7 @@
|
|||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.FileSize (
|
||||
FileSize,
|
||||
|
@ -32,7 +33,10 @@ getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
|
|||
getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
|
||||
#endif
|
||||
|
||||
{- Gets the size of the file, when its FileStatus is already known. -}
|
||||
{- Gets the size of the file, when its FileStatus is already known.
|
||||
-
|
||||
- On windows, uses getFileSize. Otherwise, the FileStatus contains the
|
||||
- size, so this does not do any work. -}
|
||||
getFileSize' :: FilePath -> FileStatus -> IO FileSize
|
||||
#ifndef mingw32_HOST_OS
|
||||
getFileSize' _ s = return $ fromIntegral $ fileSize s
|
||||
|
|
|
@ -24,6 +24,7 @@ module Utility.Hash (
|
|||
blake2b_512,
|
||||
blake2bp_512,
|
||||
md5,
|
||||
md5s,
|
||||
prop_hashes_stable,
|
||||
Mac(..),
|
||||
calcMac,
|
||||
|
@ -106,6 +107,9 @@ blake2bp_512 = hashlazy
|
|||
md5 :: L.ByteString -> Digest MD5
|
||||
md5 = hashlazy
|
||||
|
||||
md5s :: S.ByteString -> Digest MD5
|
||||
md5s = hash
|
||||
|
||||
{- Check that all the hashes continue to hash the same. -}
|
||||
prop_hashes_stable :: Bool
|
||||
prop_hashes_stable = all (\(hasher, result) -> hasher foo == result)
|
||||
|
|
|
@ -23,6 +23,7 @@ module Utility.InodeCache (
|
|||
readInodeCache,
|
||||
showInodeCache,
|
||||
genInodeCache,
|
||||
genInodeCache',
|
||||
toInodeCache,
|
||||
|
||||
InodeCacheKey,
|
||||
|
@ -46,6 +47,7 @@ module Utility.InodeCache (
|
|||
import Common
|
||||
import Utility.TimeStamp
|
||||
import Utility.QuickCheck
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import System.PosixCompat.Types
|
||||
import Data.Time.Clock.POSIX
|
||||
|
@ -187,6 +189,10 @@ genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
|
|||
genInodeCache f delta = catchDefaultIO Nothing $
|
||||
toInodeCache delta f =<< getFileStatus f
|
||||
|
||||
genInodeCache' :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
|
||||
genInodeCache' f delta = catchDefaultIO Nothing $
|
||||
toInodeCache delta (fromRawFilePath f) =<< R.getFileStatus f
|
||||
|
||||
toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
|
||||
toInodeCache (TSDelta getdelta) f s
|
||||
| isRegularFile s = do
|
||||
|
|
|
@ -12,6 +12,7 @@ module Utility.Misc (
|
|||
readFileStrict,
|
||||
separate,
|
||||
firstLine,
|
||||
firstLine',
|
||||
segment,
|
||||
segmentDelim,
|
||||
massReplace,
|
||||
|
@ -28,6 +29,7 @@ import Data.Char
|
|||
import Data.List
|
||||
import System.Exit
|
||||
import Control.Applicative
|
||||
import qualified Data.ByteString as S
|
||||
import Prelude
|
||||
|
||||
{- A version of hgetContents that is not lazy. Ensures file is
|
||||
|
@ -56,6 +58,11 @@ separate c l = unbreak $ break c l
|
|||
firstLine :: String -> String
|
||||
firstLine = takeWhile (/= '\n')
|
||||
|
||||
firstLine' :: S.ByteString -> S.ByteString
|
||||
firstLine' = S.takeWhile (/= nl)
|
||||
where
|
||||
nl = fromIntegral (ord '\n')
|
||||
|
||||
{- Splits a list into segments that are delimited by items matching
|
||||
- a predicate. (The delimiters are not included in the segments.)
|
||||
- Segments may be empty. -}
|
||||
|
|
|
@ -43,6 +43,7 @@ import Utility.Monad
|
|||
import Utility.UserInfo
|
||||
import Utility.Directory
|
||||
import Utility.Split
|
||||
import Utility.FileSystemEncoding
|
||||
|
||||
{- Simplifies a path, removing any "." component, collapsing "dir/..",
|
||||
- and removing the trailing path separator.
|
||||
|
@ -200,20 +201,21 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
|
|||
- we stop preserving ordering at that point. Presumably a user passing
|
||||
- that many paths in doesn't care too much about order of the later ones.
|
||||
-}
|
||||
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
|
||||
segmentPaths :: [RawFilePath] -> [RawFilePath] -> [[RawFilePath]]
|
||||
segmentPaths [] new = [new]
|
||||
segmentPaths [_] new = [new] -- optimisation
|
||||
segmentPaths (l:ls) new = found : segmentPaths ls rest
|
||||
where
|
||||
(found, rest) = if length ls < 100
|
||||
then partition (l `dirContains`) new
|
||||
else break (\p -> not (l `dirContains` p)) new
|
||||
then partition inl new
|
||||
else break (not . inl) new
|
||||
inl f = fromRawFilePath l `dirContains` fromRawFilePath f
|
||||
|
||||
{- This assumes that it's cheaper to call segmentPaths on the result,
|
||||
- than it would be to run the action separately with each path. In
|
||||
- the case of git file list commands, that assumption tends to hold.
|
||||
-}
|
||||
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
|
||||
runSegmentPaths :: ([RawFilePath] -> IO [RawFilePath]) -> [RawFilePath] -> IO [[RawFilePath]]
|
||||
runSegmentPaths a paths = segmentPaths paths <$> a paths
|
||||
|
||||
{- Converts paths in the home directory to use ~/ -}
|
||||
|
|
|
@ -1,4 +1,11 @@
|
|||
{- Portability shim around System.Posix.Files.ByteString
|
||||
-
|
||||
- On unix, this makes syscalls using RawFilesPaths as efficiently as
|
||||
- possible.
|
||||
-
|
||||
- On Windows, filenames are in unicode, so RawFilePaths have to be
|
||||
- decoded. So this library will work, but less efficiently than using
|
||||
- FilePath would.
|
||||
-
|
||||
- Copyright 2019 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
|
@ -10,19 +17,20 @@
|
|||
module Utility.RawFilePath (
|
||||
RawFilePath,
|
||||
readSymbolicLink,
|
||||
getFileStatus,
|
||||
) where
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Utility.FileSystemEncoding (RawFilePath)
|
||||
import System.Posix.Files.ByteString
|
||||
import System.Posix.ByteString.FilePath
|
||||
#else
|
||||
import qualified Data.ByteString as B
|
||||
import System.IO.Error
|
||||
|
||||
type RawFilePath = B.ByteString
|
||||
import qualified System.PosixCompat as P
|
||||
import Utility.FileSystemEncoding
|
||||
|
||||
readSymbolicLink :: RawFilePath -> IO RawFilePath
|
||||
readSymbolicLink _ = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
|
||||
where
|
||||
x = "Utility.RawFilePath.readSymbolicLink: not supported"
|
||||
readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
|
||||
|
||||
getFileStatus :: RawFilePath -> IO FileStatus
|
||||
getFileStatus = P.getFileStatus . fromRawFilePath
|
||||
#endif
|
||||
|
|
|
@ -7,7 +7,23 @@
|
|||
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.SafeCommand where
|
||||
module Utility.SafeCommand (
|
||||
CommandParam(..),
|
||||
toCommand,
|
||||
boolSystem,
|
||||
boolSystem',
|
||||
boolSystemEnv,
|
||||
safeSystem,
|
||||
safeSystem',
|
||||
safeSystemEnv,
|
||||
shellWrap,
|
||||
shellEscape,
|
||||
shellUnEscape,
|
||||
segmentXargsOrdered,
|
||||
segmentXargsUnordered,
|
||||
prop_isomorphic_shellEscape,
|
||||
prop_isomorphic_shellEscape_multiword,
|
||||
) where
|
||||
|
||||
import System.Exit
|
||||
import Utility.Process
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Utility.Scheduled.QuickCheck where
|
||||
module Utility.Scheduled.QuickCheck (prop_schedule_roundtrips) where
|
||||
|
||||
import Utility.Scheduled
|
||||
import Utility.QuickCheck
|
||||
|
|
|
@ -7,7 +7,11 @@
|
|||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Shell where
|
||||
module Utility.Shell (
|
||||
shellPath,
|
||||
shebang,
|
||||
findShellCommand,
|
||||
) where
|
||||
|
||||
import Utility.SafeCommand
|
||||
#ifdef mingw32_HOST_OS
|
||||
|
|
|
@ -7,7 +7,12 @@
|
|||
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Split where
|
||||
module Utility.Split (
|
||||
split,
|
||||
splitc,
|
||||
replace,
|
||||
dropFromEnd,
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Split (splitOn)
|
||||
|
@ -29,6 +34,6 @@ splitc c s = case break (== c) s of
|
|||
replace :: Eq a => [a] -> [a] -> [a] -> [a]
|
||||
replace old new = intercalate new . split old
|
||||
|
||||
-- | Only traverses the list once while dropping the last n characters.
|
||||
-- | Only traverses the list once while dropping the last n items.
|
||||
dropFromEnd :: Int -> [a] -> [a]
|
||||
dropFromEnd n l = zipWith const l (drop n l)
|
||||
|
|
|
@ -5,7 +5,24 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.SshConfig where
|
||||
module Utility.SshConfig (
|
||||
SshConfig(..),
|
||||
Comment(..),
|
||||
SshSetting(..),
|
||||
Indent,
|
||||
Host,
|
||||
Key,
|
||||
Value,
|
||||
parseSshConfig,
|
||||
genSshConfig,
|
||||
findHostConfigKey,
|
||||
addToHostConfig,
|
||||
modifyUserSshConfig,
|
||||
changeUserSshConfig,
|
||||
writeSshConfig,
|
||||
setSshConfigMode,
|
||||
sshDir,
|
||||
) where
|
||||
|
||||
import Common
|
||||
import Utility.UserInfo
|
||||
|
|
|
@ -11,7 +11,17 @@
|
|||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module Utility.TList where
|
||||
module Utility.TList (
|
||||
TList,
|
||||
newTList,
|
||||
getTList,
|
||||
setTList,
|
||||
takeTList,
|
||||
readTList,
|
||||
consTList,
|
||||
snocTList,
|
||||
appendTList,
|
||||
) where
|
||||
|
||||
import Common
|
||||
|
||||
|
|
|
@ -7,7 +7,13 @@
|
|||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Utility.Tense where
|
||||
module Utility.Tense (
|
||||
Tense(..),
|
||||
TenseChunk(..),
|
||||
TenseText,
|
||||
renderTense,
|
||||
tenseWords,
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
|
@ -52,6 +58,3 @@ tenseWords = TenseText . go []
|
|||
go c ((Tensed w1 w2):ws) =
|
||||
go (Tensed (addspace w1) (addspace w2) : c) ws
|
||||
addspace w = T.append w " "
|
||||
|
||||
unTensed :: Text -> TenseText
|
||||
unTensed t = TenseText [UnTensed t]
|
||||
|
|
|
@ -5,7 +5,11 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.ThreadLock where
|
||||
module Utility.ThreadLock (
|
||||
Lock,
|
||||
newLock,
|
||||
withLock,
|
||||
) where
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
|
||||
|
|
|
@ -8,7 +8,14 @@
|
|||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.ThreadScheduler where
|
||||
module Utility.ThreadScheduler (
|
||||
Seconds(..),
|
||||
Microseconds,
|
||||
runEvery,
|
||||
threadDelaySeconds,
|
||||
waitForTermination,
|
||||
oneSecond,
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Concurrent
|
||||
|
|
|
@ -5,7 +5,11 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.TimeStamp where
|
||||
module Utility.TimeStamp (
|
||||
parserPOSIXTime,
|
||||
parsePOSIXTime,
|
||||
formatPOSIXTime,
|
||||
) where
|
||||
|
||||
import Utility.Data
|
||||
|
||||
|
|
|
@ -8,7 +8,13 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Tmp where
|
||||
module Utility.Tmp (
|
||||
Template,
|
||||
viaTmp,
|
||||
withTmpFile,
|
||||
withTmpFileIn,
|
||||
relatedTemplate,
|
||||
) where
|
||||
|
||||
import System.IO
|
||||
import System.FilePath
|
||||
|
|
|
@ -8,7 +8,10 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Tmp.Dir where
|
||||
module Utility.Tmp.Dir (
|
||||
withTmpDir,
|
||||
withTmpDirIn,
|
||||
) where
|
||||
|
||||
import Control.Monad.IfElse
|
||||
import System.FilePath
|
||||
|
|
|
@ -7,7 +7,17 @@
|
|||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Tor where
|
||||
module Utility.Tor (
|
||||
OnionPort,
|
||||
OnionAddress(..),
|
||||
OnionSocket,
|
||||
UniqueIdent,
|
||||
AppName,
|
||||
connectHiddenService,
|
||||
addHiddenService,
|
||||
getHiddenServiceSocketFile,
|
||||
torIsInstalled,
|
||||
) where
|
||||
|
||||
import Common
|
||||
import Utility.ThreadScheduler
|
||||
|
|
|
@ -5,7 +5,11 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.Tuple where
|
||||
module Utility.Tuple (
|
||||
fst3,
|
||||
snd3,
|
||||
thd3,
|
||||
) where
|
||||
|
||||
fst3 :: (a,b,c) -> a
|
||||
fst3 (a,_,_) = a
|
||||
|
|
|
@ -5,7 +5,14 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.Verifiable where
|
||||
module Utility.Verifiable (
|
||||
Secret,
|
||||
HMACDigest,
|
||||
Verifiable(..),
|
||||
mkVerifiable,
|
||||
verify,
|
||||
prop_verifiable_sane,
|
||||
) where
|
||||
|
||||
import Data.ByteString.UTF8 (fromString)
|
||||
import qualified Data.ByteString as S
|
||||
|
|
|
@ -7,7 +7,14 @@
|
|||
|
||||
{-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-}
|
||||
|
||||
module Utility.WebApp where
|
||||
module Utility.WebApp (
|
||||
browserProc,
|
||||
runWebApp,
|
||||
webAppSessionBackend,
|
||||
checkAuthToken,
|
||||
insertAuthToken,
|
||||
writeHtmlShim,
|
||||
) where
|
||||
|
||||
import Common
|
||||
import Utility.Tmp
|
||||
|
@ -19,11 +26,9 @@ import qualified Network.Wai as Wai
|
|||
import Network.Wai.Handler.Warp
|
||||
import Network.Wai.Handler.WarpTLS
|
||||
import Network.HTTP.Types
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import Network.Socket
|
||||
import "crypto-api" Crypto.Random
|
||||
import qualified Web.ClientSession as CS
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
|
@ -119,9 +124,6 @@ getSocket h = do
|
|||
listen sock maxListenQueue
|
||||
return sock
|
||||
|
||||
lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
|
||||
lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
|
||||
|
||||
{- Rather than storing a session key on disk, use a random key
|
||||
- that will only be valid for this run of the webapp. -}
|
||||
webAppSessionBackend :: Yesod.Yesod y => y -> IO (Maybe Yesod.SessionBackend)
|
||||
|
@ -188,7 +190,6 @@ insertAuthToken extractAuthToken predicate webapp root pathbits params =
|
|||
writeHtmlShim :: String -> String -> FilePath -> IO ()
|
||||
writeHtmlShim title url file = viaTmp writeFileProtected file $ genHtmlShim title url
|
||||
|
||||
{- TODO: generate this static file using Yesod. -}
|
||||
genHtmlShim :: String -> String -> String
|
||||
genHtmlShim title url = unlines
|
||||
[ "<html>"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue