git-annex/Utility/ThreadScheduler.hs
Joey Hess 38d691a10f
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.
2018-10-13 01:41:11 -04:00

70 lines
1.8 KiB
Haskell

{- thread scheduling
-
- Copyright 2012, 2013 Joey Hess <id@joeyh.name>
- Copyright 2011 Bas van Dijk & Roel van Dijk
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.ThreadScheduler where
import Control.Monad
import Control.Concurrent
#ifndef mingw32_HOST_OS
import Control.Monad.IfElse
import System.Posix.IO
#endif
#ifndef mingw32_HOST_OS
import System.Posix.Signals
import System.Posix.Terminal
#endif
newtype Seconds = Seconds { fromSeconds :: Int }
deriving (Eq, Ord, Show)
type Microseconds = Integer
{- Runs an action repeatedly forever, sleeping at least the specified number
- of seconds in between. -}
runEvery :: Seconds -> IO a -> IO a
runEvery n a = forever $ do
threadDelaySeconds n
a
threadDelaySeconds :: Seconds -> IO ()
threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond)
{- Like threadDelay, but not bounded by an Int.
-
- There is no guarantee that the thread will be rescheduled promptly when the
- delay has expired, but the thread will never continue to run earlier than
- specified.
-
- Taken from the unbounded-delay package to avoid a dependency for 4 lines
- of code.
-}
unboundDelay :: Microseconds -> IO ()
unboundDelay time = do
let maxWait = min time $ toInteger (maxBound :: Int)
threadDelay $ fromInteger maxWait
when (maxWait /= time) $ unboundDelay (time - maxWait)
{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
#ifdef mingw32_HOST_OS
forever $ threadDelaySeconds (Seconds 6000)
#else
lock <- newEmptyMVar
let check sig = void $
installHandler sig (CatchOnce $ putMVar lock ()) Nothing
check softwareTermination
whenM (queryTerminal stdInput) $
check keyboardSignal
takeMVar lock
#endif
oneSecond :: Microseconds
oneSecond = 1000000