removed the old Android app
Running git-annex linux builds in termux seems to work well enough that the only reason to keep the Android app would be to support Android 4-5, which the old Android app supported, and which I don't know if the termux method works on (although I see no reason why it would not). According to [1], Android 4-5 remains on around 29% of devices, down from 51% one year ago. [1] https://www.statista.com/statistics/271774/share-of-android-platforms-on-mobile-devices-with-android-os/ This is a rather large commit, but mostly very straightfoward removal of android ifdefs and patches and associated cruft. Also, removed support for building with very old ghc < 8.0.1, and with yesod < 1.4.3, and without concurrent-output, which were only being used by the cross build. Some documentation specific to the Android app (screenshots etc) needs to be updated still. This commit was sponsored by Brett Eisenberg on Patreon.
This commit is contained in:
parent
aaa841e60a
commit
38d691a10f
124 changed files with 81 additions and 12472 deletions
|
@ -11,7 +11,7 @@ module Utility.Batch where
|
|||
|
||||
import Common
|
||||
|
||||
#if defined(linux_HOST_OS) || defined(__ANDROID__)
|
||||
#if defined(linux_HOST_OS)
|
||||
import Control.Concurrent.Async
|
||||
import System.Posix.Process
|
||||
#endif
|
||||
|
@ -29,7 +29,7 @@ import qualified Control.Exception as E
|
|||
- systems, the action is simply ran.
|
||||
-}
|
||||
batch :: IO a -> IO a
|
||||
#if defined(linux_HOST_OS) || defined(__ANDROID__)
|
||||
#if defined(linux_HOST_OS)
|
||||
batch a = wait =<< batchthread
|
||||
where
|
||||
batchthread = asyncBound $ do
|
||||
|
@ -51,11 +51,7 @@ getBatchCommandMaker = do
|
|||
#ifndef mingw32_HOST_OS
|
||||
nicers <- filterM (inPath . fst)
|
||||
[ ("nice", [])
|
||||
#ifndef __ANDROID__
|
||||
-- Android's ionice does not allow specifying a command,
|
||||
-- so don't use it.
|
||||
, ("ionice", ["-c3"])
|
||||
#endif
|
||||
, ("nocache", [])
|
||||
]
|
||||
return $ \(command, params) ->
|
||||
|
|
|
@ -5,8 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.CopyFile (
|
||||
copyFileExternal,
|
||||
createLinkOrCopy,
|
||||
|
@ -32,7 +30,6 @@ copyFileExternal meta src dest = do
|
|||
removeFile dest
|
||||
boolSystem "cp" $ params ++ [File src, File dest]
|
||||
where
|
||||
#ifndef __ANDROID__
|
||||
params = map snd $ filter fst
|
||||
[ (BuildInfo.cp_reflink_auto, Param "--reflink=auto")
|
||||
, (allmeta && BuildInfo.cp_a, Param "-a")
|
||||
|
@ -41,9 +38,6 @@ copyFileExternal meta src dest = do
|
|||
, (not allmeta && BuildInfo.cp_preserve_timestamps
|
||||
, Param "--preserve=timestamps")
|
||||
]
|
||||
#else
|
||||
params = if allmeta then [] else []
|
||||
#endif
|
||||
allmeta = meta == CopyAllMetaData
|
||||
|
||||
{- Create a hard link if the filesystem allows it, and fall back to copying
|
||||
|
|
|
@ -13,8 +13,6 @@ module Utility.DiskFree (
|
|||
getDiskSize
|
||||
) where
|
||||
|
||||
#ifndef __ANDROID__
|
||||
|
||||
import System.DiskSpace
|
||||
import Utility.Applicative
|
||||
import Utility.Exception
|
||||
|
@ -24,15 +22,3 @@ getDiskFree = catchMaybeIO . getAvailSpace
|
|||
|
||||
getDiskSize :: FilePath -> IO (Maybe Integer)
|
||||
getDiskSize = fmap diskTotal <$$> catchMaybeIO . getDiskUsage
|
||||
|
||||
#else
|
||||
|
||||
#warning Building without disk free space checking support
|
||||
|
||||
getDiskFree :: FilePath -> IO (Maybe Integer)
|
||||
getDiskFree _ = return Nothing
|
||||
|
||||
getDiskSize :: FilePath -> IO (Maybe Integer)
|
||||
getDiskSize _ = return Nothing
|
||||
|
||||
#endif
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Exception (
|
||||
|
@ -29,11 +29,7 @@ module Utility.Exception (
|
|||
import Control.Monad.Catch as X hiding (Handler)
|
||||
import qualified Control.Monad.Catch as M
|
||||
import Control.Exception (IOException, AsyncException)
|
||||
#ifdef MIN_VERSION_GLASGOW_HASKELL
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
|
||||
import Control.Exception (SomeAsyncException)
|
||||
#endif
|
||||
#endif
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class (liftIO, MonadIO)
|
||||
import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
|
||||
|
@ -46,15 +42,7 @@ import Utility.Data
|
|||
- where there's a problem that the user is excpected to see in some
|
||||
- circumstances. -}
|
||||
giveup :: [Char] -> a
|
||||
#ifdef MIN_VERSION_base
|
||||
#if MIN_VERSION_base(4,9,0)
|
||||
giveup = errorWithoutStackTrace
|
||||
#else
|
||||
giveup = error
|
||||
#endif
|
||||
#else
|
||||
giveup = error
|
||||
#endif
|
||||
|
||||
{- Catches IO errors and returns a Bool -}
|
||||
catchBoolIO :: MonadCatch m => m Bool -> m Bool
|
||||
|
@ -95,11 +83,7 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
|
|||
catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
|
||||
catchNonAsync a onerr = a `catches`
|
||||
[ M.Handler (\ (e :: AsyncException) -> throwM e)
|
||||
#ifdef MIN_VERSION_GLASGOW_HASKELL
|
||||
#if MIN_VERSION_GLASGOW_HASKELL(7,10,0,0)
|
||||
, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
|
||||
#endif
|
||||
#endif
|
||||
, M.Handler (\ (e :: SomeException) -> onerr e)
|
||||
]
|
||||
|
||||
|
|
|
@ -5,8 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Lsof where
|
||||
|
||||
import Common
|
||||
|
@ -54,13 +52,6 @@ query opts =
|
|||
|
||||
type LsofParser = String -> [(FilePath, LsofOpenMode, ProcessInfo)]
|
||||
|
||||
parse :: LsofParser
|
||||
#ifdef __ANDROID__
|
||||
parse = parseDefault
|
||||
#else
|
||||
parse = parseFormatted
|
||||
#endif
|
||||
|
||||
{- Parsing null-delimited output like:
|
||||
-
|
||||
- pPID\0cCMDLINE\0
|
||||
|
@ -71,8 +62,8 @@ parse = parseFormatted
|
|||
- Where each new process block is started by a pid, and a process can
|
||||
- have multiple files open.
|
||||
-}
|
||||
parseFormatted :: LsofParser
|
||||
parseFormatted s = bundle $ go [] $ lines s
|
||||
parse :: LsofParser
|
||||
parse s = bundle $ go [] $ lines s
|
||||
where
|
||||
bundle = concatMap (\(fs, p) -> map (\(f, m) -> (f, m, p)) fs)
|
||||
|
||||
|
@ -110,14 +101,3 @@ parseFormatted s = bundle $ go [] $ lines s
|
|||
splitnull = splitc '\0'
|
||||
|
||||
parsefail = error $ "failed to parse lsof output: " ++ show s
|
||||
|
||||
{- Parses lsof's default output format. -}
|
||||
parseDefault :: LsofParser
|
||||
parseDefault = mapMaybe parseline . drop 1 . lines
|
||||
where
|
||||
parseline l = case words l of
|
||||
(command : spid : _user : _fd : _type : _device : _size : _node : rest) ->
|
||||
case readish spid of
|
||||
Nothing -> Nothing
|
||||
Just pid -> Just (unwords rest, OpenUnknown, ProcessInfo pid command)
|
||||
_ -> Nothing
|
||||
|
|
|
@ -5,7 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Utility.Mounts (getMounts, Mntent(..)) where
|
||||
|
@ -16,11 +15,7 @@ import System.MountPoints (Mntent(..))
|
|||
import Utility.Exception
|
||||
|
||||
getMounts :: IO [Mntent]
|
||||
#ifndef __ANDROID__
|
||||
getMounts = System.MountPoints.getMounts
|
||||
-- That will crash when the linux build is running on Android,
|
||||
-- so fall back to this.
|
||||
`catchNonAsync` const System.MountPoints.getProcMounts
|
||||
#else
|
||||
getMounts = System.MountPoints.getProcMounts
|
||||
#endif
|
||||
|
|
|
@ -20,21 +20,11 @@ import Utility.PartialPrelude
|
|||
import System.FilePath
|
||||
#endif
|
||||
|
||||
shellPath_portable :: FilePath
|
||||
shellPath_portable = "/bin/sh"
|
||||
shellPath :: FilePath
|
||||
shellPath = "/bin/sh"
|
||||
|
||||
shellPath_local :: FilePath
|
||||
#ifndef __ANDROID__
|
||||
shellPath_local = shellPath_portable
|
||||
#else
|
||||
shellPath_local = "/system/bin/sh"
|
||||
#endif
|
||||
|
||||
shebang_portable :: String
|
||||
shebang_portable = "#!" ++ shellPath_portable
|
||||
|
||||
shebang_local :: String
|
||||
shebang_local = "#!" ++ shellPath_local
|
||||
shebang :: String
|
||||
shebang = "#!" ++ shellPath
|
||||
|
||||
-- | On Windows, shebang is not handled by the kernel, so to support
|
||||
-- shell scripts etc, have to look at the program being run and
|
||||
|
|
|
@ -18,10 +18,8 @@ import System.Posix.IO
|
|||
#endif
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Posix.Signals
|
||||
#ifndef __ANDROID__
|
||||
import System.Posix.Terminal
|
||||
#endif
|
||||
#endif
|
||||
|
||||
newtype Seconds = Seconds { fromSeconds :: Int }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
@ -63,10 +61,8 @@ waitForTermination = do
|
|||
let check sig = void $
|
||||
installHandler sig (CatchOnce $ putMVar lock ()) Nothing
|
||||
check softwareTermination
|
||||
#ifndef __ANDROID__
|
||||
whenM (queryTerminal stdInput) $
|
||||
check keyboardSignal
|
||||
#endif
|
||||
takeMVar lock
|
||||
#endif
|
||||
|
||||
|
|
|
@ -13,7 +13,7 @@ module Utility.Touch (
|
|||
touch
|
||||
) where
|
||||
|
||||
#if ! defined(mingw32_HOST_OS) && ! defined(__ANDROID__)
|
||||
#if ! defined(mingw32_HOST_OS)
|
||||
|
||||
#if MIN_VERSION_unix(2,7,0)
|
||||
|
||||
|
|
|
@ -47,8 +47,8 @@ myUserName = myVal env userName
|
|||
#endif
|
||||
|
||||
myUserGecos :: IO (Maybe String)
|
||||
-- userGecos crashes on Android and is not available on Windows.
|
||||
#if defined(__ANDROID__) || defined(mingw32_HOST_OS)
|
||||
-- userGecos is not available on Windows.
|
||||
#if defined(mingw32_HOST_OS)
|
||||
myUserGecos = return Nothing
|
||||
#else
|
||||
myUserGecos = eitherToMaybe <$> myVal [] userGecos
|
||||
|
|
|
@ -30,9 +30,6 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
|||
import Blaze.ByteString.Builder (Builder)
|
||||
import Control.Arrow ((***))
|
||||
import Control.Concurrent
|
||||
#ifdef __ANDROID__
|
||||
import Data.Endian
|
||||
#endif
|
||||
|
||||
localhost :: HostName
|
||||
localhost = "localhost"
|
||||
|
@ -42,11 +39,6 @@ browserProc :: String -> CreateProcess
|
|||
#ifdef darwin_HOST_OS
|
||||
browserProc url = proc "open" [url]
|
||||
#else
|
||||
#ifdef __ANDROID__
|
||||
-- Warning: The `am` command does not work very reliably on Android.
|
||||
browserProc url = proc "am"
|
||||
["start", "-a", "android.intent.action.VIEW", "-d", url]
|
||||
#else
|
||||
#ifdef mingw32_HOST_OS
|
||||
-- Warning: On Windows, no quoting or escaping of the url seems possible,
|
||||
-- so spaces in it will cause problems. One approach is to make the url
|
||||
|
@ -57,7 +49,6 @@ browserProc url = proc "cmd" ["/c start " ++ url]
|
|||
browserProc url = proc "xdg-open" [url]
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
{- Binds to a socket on localhost, or possibly a different specified
|
||||
- hostname or address, and runs a webapp on it.
|
||||
|
@ -69,19 +60,11 @@ runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr
|
|||
runWebApp tlssettings h app observer = withSocketsDo $ do
|
||||
sock <- getSocket h
|
||||
void $ forkIO $ go webAppSettings sock app
|
||||
sockaddr <- fixSockAddr <$> getSocketName sock
|
||||
sockaddr <- getSocketName sock
|
||||
observer sockaddr
|
||||
where
|
||||
go = (maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)
|
||||
|
||||
fixSockAddr :: SockAddr -> SockAddr
|
||||
#ifdef __ANDROID__
|
||||
{- On Android, the port is currently incorrectly returned in network
|
||||
- byte order, which is wrong on little endian systems. -}
|
||||
fixSockAddr (SockAddrInet (PortNum port) addr) = SockAddrInet (PortNum $ swapEndian port) addr
|
||||
#endif
|
||||
fixSockAddr addr = addr
|
||||
|
||||
-- disable buggy sloworis attack prevention code
|
||||
webAppSettings :: Settings
|
||||
webAppSettings = setTimeout halfhour defaultSettings
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
{- Yesod stuff, that's typically found in the scaffolded site.
|
||||
-
|
||||
- Also a bit of a compatability layer to make it easier to support yesod
|
||||
- 1.1-1.4 in the same code base.
|
||||
- Also a bit of a compatability layer for older versions of yesod.
|
||||
-
|
||||
- Copyright 2012-2014 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
|
@ -13,28 +12,18 @@
|
|||
module Utility.Yesod
|
||||
( module Y
|
||||
, liftH
|
||||
#ifndef __NO_TH__
|
||||
, widgetFile
|
||||
, hamletTemplate
|
||||
#endif
|
||||
#if ! MIN_VERSION_yesod_core(1,2,20)
|
||||
, withUrlRenderer
|
||||
#endif
|
||||
) where
|
||||
|
||||
import Yesod as Y
|
||||
import Yesod.Form.Bootstrap3 as Y hiding (bfs)
|
||||
#ifndef __NO_TH__
|
||||
import Yesod.Default.Util
|
||||
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||
import Data.Default (def)
|
||||
import Text.Hamlet hiding (Html)
|
||||
#endif
|
||||
#if ! MIN_VERSION_yesod(1,4,0)
|
||||
import Data.Text (Text)
|
||||
#endif
|
||||
|
||||
#ifndef __NO_TH__
|
||||
widgetFile :: String -> Q Exp
|
||||
widgetFile = widgetFileNoReload $ def
|
||||
{ wfsHamletSettings = defaultHamletSettings
|
||||
|
@ -44,7 +33,6 @@ widgetFile = widgetFileNoReload $ def
|
|||
|
||||
hamletTemplate :: FilePath -> FilePath
|
||||
hamletTemplate f = globFile "hamlet" f
|
||||
#endif
|
||||
|
||||
{- Lift Handler to Widget -}
|
||||
#if MIN_VERSION_yesod_core(1,6,0)
|
||||
|
@ -53,8 +41,3 @@ liftH :: HandlerFor site a -> WidgetFor site a
|
|||
liftH :: Monad m => HandlerT site m a -> WidgetT site m a
|
||||
#endif
|
||||
liftH = handlerToWidget
|
||||
|
||||
#if ! MIN_VERSION_yesod_core(1,2,20)
|
||||
withUrlRenderer :: MonadHandler m => ((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output) -> m output
|
||||
withUrlRenderer = giveUrlRenderer
|
||||
#endif
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue