module Language.Haskell.Ghcid.Util(
ghciFlagsRequired, ghciFlagsRequiredVersioned,
ghciFlagsUseful, ghciFlagsUsefulVersioned,
dropPrefixRepeatedly,
outStr, outStrLn,
ignored,
allGoodMessage,
getModTime, getModTimeResolution, getShortTime
) where
import Control.Concurrent.Extra
import System.Time.Extra
import System.IO.Unsafe
import System.IO.Extra
import System.FilePath
import System.Info.Extra
import System.Console.ANSI
import Data.Version.Extra
import Data.List.Extra
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import System.IO.Error
import System.Directory
import Control.Exception
import Control.Monad.Extra
import Control.Applicative
import Prelude
ghciFlagsRequired :: [String]
ghciFlagsRequired =
["-fno-break-on-exception","-fno-break-on-error"
,"-v1"
]
ghciFlagsRequiredVersioned :: [String]
ghciFlagsRequiredVersioned =
["-fno-hide-source-paths"
]
ghciFlagsUseful :: [String]
ghciFlagsUseful =
["-ferror-spans"
,"-j"
]
ghciFlagsUsefulVersioned :: [String]
ghciFlagsUsefulVersioned =
["-fdiagnostics-color=always"
]
dropPrefixRepeatedly :: Eq a => [a] -> [a] -> [a]
dropPrefixRepeatedly [] s = s
dropPrefixRepeatedly pre s = maybe s (dropPrefixRepeatedly pre) $ stripPrefix pre s
{-# NOINLINE lock #-}
lock :: Lock
lock = unsafePerformIO newLock
outStr :: String -> IO ()
outStr msg = do
evaluate $ length $ show msg
withLock lock $ putStr msg
outStrLn :: String -> IO ()
outStrLn xs = outStr $ xs ++ "\n"
ignored :: IO () -> IO ()
ignored act = do
bar <- newBarrier
forkFinally act $ const $ signalBarrier bar ()
waitBarrier bar
allGoodMessage :: String
allGoodMessage = setSGRCode [SetColor Foreground Dull Green] ++ "All good" ++ setSGRCode []
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime file = handleJust
(\e -> if isDoesNotExistError e then Just () else Nothing)
(\_ -> return Nothing)
(Just <$> getModificationTime file)
getShortTime :: IO String
getShortTime = formatTime defaultTimeLocale "%H:%M:%S" <$> getZonedTime
getModTimeResolution :: IO Seconds
getModTimeResolution = return getModTimeResolutionCache
{-# NOINLINE getModTimeResolutionCache #-}
getModTimeResolutionCache :: Seconds
getModTimeResolutionCache = unsafePerformIO $ withTempDir $ \dir -> do
let file = dir </> "calibrate.txt"
mtime <- fmap maximum $ forM [1..3] $ \i -> fmap fst $ duration $ do
writeFile file $ show i
t1 <- getModificationTime file
flip loopM 0 $ \j -> do
writeFile file $ show (i,j)
t2 <- getModificationTime file
return $ if t1 == t2 then Left $ j+1 else Right ()
mtime <- return $ if compilerVersion < makeVersion [7,8] then max mtime 1 else mtime
putStrLn $ "Longest file modification time lag was " ++ show (ceiling (mtime * 1000)) ++ "ms"
return $ mtime + min 0.1 mtime