module Language.Haskell.Ghcid.Util(
ghciFlagsRequired, ghciFlagsRequiredVersioned,
ghciFlagsUseful, ghciFlagsUsefulVersioned,
dropPrefixRepeatedly,
takeRemainder,
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 :: [String]
ghciFlagsRequired =
[String
"-fno-break-on-exception",String
"-fno-break-on-error"
,String
"-v1"
]
ghciFlagsRequiredVersioned :: [String]
ghciFlagsRequiredVersioned :: [String]
ghciFlagsRequiredVersioned =
[String
"-fno-hide-source-paths"
]
ghciFlagsUseful :: [String]
ghciFlagsUseful :: [String]
ghciFlagsUseful =
[String
"-ferror-spans"
,String
"-j"
]
ghciFlagsUsefulVersioned :: [String]
ghciFlagsUsefulVersioned :: [String]
ghciFlagsUsefulVersioned =
[String
"-fdiagnostics-color=always"
]
dropPrefixRepeatedly :: Eq a => [a] -> [a] -> [a]
dropPrefixRepeatedly :: forall a. Eq a => [a] -> [a] -> [a]
dropPrefixRepeatedly [] [a]
s = [a]
s
dropPrefixRepeatedly [a]
pre [a]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
s (forall a. Eq a => [a] -> [a] -> [a]
dropPrefixRepeatedly [a]
pre) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
pre [a]
s
{-# NOINLINE lock #-}
lock :: Lock
lock :: Lock
lock = forall a. IO a -> a
unsafePerformIO IO Lock
newLock
outStr :: String -> IO ()
outStr :: String -> IO ()
outStr String
msg = do
forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
msg
forall a. Lock -> IO a -> IO a
withLock Lock
lock forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
msg
outStrLn :: String -> IO ()
outStrLn :: String -> IO ()
outStrLn String
xs = String -> IO ()
outStr forall a b. (a -> b) -> a -> b
$ String
xs forall a. [a] -> [a] -> [a]
++ String
"\n"
ignored :: IO () -> IO ()
ignored :: IO () -> IO ()
ignored IO ()
act = do
Barrier ()
bar <- forall a. IO (Barrier a)
newBarrier
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally IO ()
act forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Partial => Barrier a -> a -> IO ()
signalBarrier Barrier ()
bar ()
forall a. Barrier a -> IO a
waitBarrier Barrier ()
bar
allGoodMessage :: String
allGoodMessage :: String
allGoodMessage = [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green] forall a. [a] -> [a] -> [a]
++ String
"All good" forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode []
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime :: String -> IO (Maybe UTCTime)
getModTime String
file = forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust
(\IOError
e -> if IOError -> Bool
isDoesNotExistError IOError
e then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)
(\()
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
file)
takeRemainder :: Int -> [a] -> (Int, [a])
takeRemainder :: forall a. Int -> [a] -> (Int, [a])
takeRemainder Int
n [a]
xs = let ys :: [a]
ys = forall a. Int -> [a] -> [a]
take Int
n [a]
xs in (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys, [a]
ys)
getShortTime :: IO String
getShortTime :: IO String
getShortTime = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime
getModTimeResolution :: IO Seconds
getModTimeResolution :: IO Seconds
getModTimeResolution = forall (f :: * -> *) a. Applicative f => a -> f a
pure Seconds
getModTimeResolutionCache
{-# NOINLINE getModTimeResolutionCache #-}
getModTimeResolutionCache :: Seconds
getModTimeResolutionCache :: Seconds
getModTimeResolutionCache = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. (String -> IO a) -> IO a
withTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
let file :: String
file = String
dir String -> String -> String
</> String
"calibrate.txt"
Seconds
mtime <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Integer
1..Integer
3] forall a b. (a -> b) -> a -> b
$ \Integer
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => m a -> m (Seconds, a)
duration forall a b. (a -> b) -> a -> b
$ do
String -> String -> IO ()
writeFile String
file forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
i
UTCTime
t1 <- String -> IO UTCTime
getModificationTime String
file
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(a -> m (Either a b)) -> a -> m b
loopM Integer
0 forall a b. (a -> b) -> a -> b
$ \Integer
j -> do
String -> String -> IO ()
writeFile String
file forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Integer
i,Integer
j)
UTCTime
t2 <- String -> IO UTCTime
getModificationTime String
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if UTCTime
t1 forall a. Eq a => a -> a -> Bool
== UTCTime
t2 then forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Integer
jforall a. Num a => a -> a -> a
+Integer
1 else forall a b. b -> Either a b
Right ()
Seconds
mtime <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Version
compilerVersion forall a. Ord a => a -> a -> Bool
< [Int] -> Version
makeVersion [Int
7,Int
8] then forall a. Ord a => a -> a -> a
max Seconds
mtime Seconds
1 else Seconds
mtime
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Longest file modification time lag was " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Seconds
mtime forall a. Num a => a -> a -> a
* Seconds
1000)) forall a. [a] -> [a] -> [a]
++ String
"ms"
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seconds
mtime forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
min Seconds
0.1 Seconds
mtime