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:
Joey Hess 2018-10-13 01:36:06 -04:00
parent aaa841e60a
commit 38d691a10f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
124 changed files with 81 additions and 12472 deletions

View file

@ -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) ->

View file

@ -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

View file

@ -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

View file

@ -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)
]

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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