43b4b7d43a
Various things that don't work on Android are just ifdefed out. * the webapp (needs template haskell for arm) * --include and --exclude globbing (needs libpcre, which is not ported; probably I'll make it use the pure haskell glob library instead) * annex.diskreserve checking (missing sys/statvfs.h) * timestamp preservation support (yawn) * S3 * WebDAV * XMPP The resulting 17mb binary has been tested on Android, and it is able to, at least, print its usage message.
63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
{- thread scheduling
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
- Copyright 2011 Bas van Dijk & Roel van Dijk
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.ThreadScheduler where
|
|
|
|
import Common
|
|
|
|
import Control.Concurrent
|
|
import System.Posix.Signals
|
|
#ifndef WITH_ANDROID
|
|
import System.Posix.Terminal
|
|
#endif
|
|
|
|
newtype Seconds = Seconds { fromSeconds :: Int }
|
|
deriving (Eq, Ord, Show)
|
|
|
|
{- 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)
|
|
where
|
|
oneSecond = 1000000 -- microseconds
|
|
|
|
{- 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 :: Integer -> 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
|
|
lock <- newEmptyMVar
|
|
check softwareTermination lock
|
|
#ifndef WITH_ANDROID
|
|
whenM (queryTerminal stdInput) $
|
|
check keyboardSignal lock
|
|
#endif
|
|
takeMVar lock
|
|
where
|
|
check sig lock = void $
|
|
installHandler sig (CatchOnce $ putMVar lock ()) Nothing
|