-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Functions to tail a log file, even if it gets rotated.
module LogView.Tail (
    log_filename
    -- * tail
    , Handle, open, tail
    , deserialize_line
    -- * magic
    , starting_msg, quitting_msg
) where
import           Prelude hiding (read, tail)
import qualified Control.Exception as Exception
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy
import qualified System.IO as IO
import qualified System.IO.Error as Error
import qualified System.Posix as Posix

import qualified Util.Log as Log
import qualified Util.Thread as Thread
import qualified App.Config as Config
import qualified App.Path as Path

import           Global


log_filename :: IO FilePath
log_filename :: IO FilePath
log_filename = do
    AppDir
app_dir <- IO AppDir
Path.get_app_dir
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppDir -> Relative -> FilePath
Path.to_absolute AppDir
app_dir (Relative
Config.log_dir Relative -> Relative -> Relative
Path.</> Relative
"seq.log")

-- * tail

-- | The Handle remembers the file and the last file size so it can detect when
-- the logs have been rotated.
data Handle = Handle !FilePath !IO.Handle !Integer deriving (Int -> Handle -> ShowS
[Handle] -> ShowS
Handle -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Handle] -> ShowS
$cshowList :: [Handle] -> ShowS
show :: Handle -> FilePath
$cshow :: Handle -> FilePath
showsPrec :: Int -> Handle -> ShowS
$cshowsPrec :: Int -> Handle -> ShowS
Show)

open :: FilePath
    -> Maybe Integer -- ^ No seek if Nothing, else seek n*200 bytes from end.
    -- TODO this should be the number of lines, but I'm too lazy to do that
    -- right.
    -> IO Handle
open :: FilePath -> Maybe Integer -> IO Handle
open FilePath
filename Maybe Integer
seek = do
    -- ReadWriteMode makes it create the file if it doesn't exist, and not
    -- die here.
    Handle
hdl <- FilePath -> IOMode -> IO Handle
IO.openFile FilePath
filename IOMode
IO.ReadWriteMode
    Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hdl BufferMode
IO.LineBuffering -- See read_line.
    case Maybe Integer
seek of
        Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Integer
n -> do
            Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
hdl SeekMode
IO.SeekFromEnd (-Integer
n forall a. Num a => a -> a -> a
* Integer
200)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n forall a. Eq a => a -> a -> Bool
/= Integer
0) forall a b. (a -> b) -> a -> b
$
                forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Handle -> IO FilePath
IO.hGetLine Handle
hdl -- make sure I'm at a line boundary
    Integer
size <- Handle -> IO Integer
IO.hFileSize Handle
hdl
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Handle -> Integer -> Handle
Handle FilePath
filename Handle
hdl Integer
size

tail :: Handle -> IO (Log.Msg, Handle)
tail :: Handle -> IO (Msg, Handle)
tail Handle
hdl = do
    (ByteString
line, Handle
hdl) <- Handle -> IO (ByteString, Handle)
read_line Handle
hdl
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Msg
deserialize_line ByteString
line, Handle
hdl)

deserialize_line :: ByteString.ByteString -> Log.Msg
deserialize_line :: ByteString -> Msg
deserialize_line ByteString
line = case ByteString -> Either FilePath Msg
Log.deserialize (ByteString -> ByteString
Lazy.fromStrict ByteString
line) of
    Left FilePath
err -> Stack => Priority -> Maybe Stack -> Text -> Msg
Log.msg Priority
Log.Error forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Text
"error parsing " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt ByteString
line
        forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
txt FilePath
err
    Right Msg
msg -> Msg
msg

-- | (handle, file size)
type TailState = (IO.Handle, Integer)

read_line :: Handle -> IO (ByteString.ByteString, Handle)
read_line :: Handle -> IO (ByteString, Handle)
read_line (Handle FilePath
filename Handle
hdl Integer
size) = (Handle, Integer) -> IO (ByteString, Handle)
go (Handle
hdl, Integer
size)
    where
    go :: (Handle, Integer) -> IO (ByteString, Handle)
go state :: (Handle, Integer)
state@(Handle
hdl, Integer
size) = Handle -> IO Bool
IO.hIsEOF Handle
hdl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
            Integer
new_size <- Handle -> IO Integer
IO.hFileSize Handle
hdl
            -- Check if the file was truncated.
            (Handle, Integer)
state <- if Integer
new_size forall a. Ord a => a -> a -> Bool
< Integer
size
                then Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
hdl SeekMode
IO.AbsoluteSeek Integer
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Handle, Integer)
state
                else forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> Integer -> IO Bool
file_renamed FilePath
filename Integer
new_size)
                    (Handle -> Integer -> FilePath -> IO (Handle, Integer)
reopen Handle
hdl Integer
new_size FilePath
filename)
                    (Seconds -> IO ()
Thread.delay Seconds
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Handle, Integer)
state)
            (Handle, Integer) -> IO (ByteString, Handle)
go (Handle, Integer)
state
        Bool
False -> do
            -- Since hGetLine in its infinite wisdom chops the newline it's
            -- impossible to tell if this is a complete line or not.  I'll set
            -- LineBuffering and hope for the best.
            ByteString
line <- Handle -> IO ByteString
ByteString.hGetLine Handle
hdl
            Integer
new_size <- Handle -> IO Integer
IO.hFileSize Handle
hdl
            forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
line, FilePath -> Handle -> Integer -> Handle
Handle FilePath
filename Handle
hdl Integer
new_size)

-- | If the filename exists, open it and close the old file.
reopen :: IO.Handle -> Integer -> FilePath -> IO TailState
reopen :: Handle -> Integer -> FilePath -> IO (Handle, Integer)
reopen Handle
old Integer
size FilePath
filename = do
    Maybe Handle
fp <- forall a. FilePath -> IO a -> IO (Maybe a)
ignoreException FilePath
"reopen" (FilePath -> IOMode -> IO Handle
IO.openFile FilePath
filename IOMode
IO.ReadMode)
    case Maybe Handle
fp of
        Maybe Handle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
old, Integer
size)
        Just Handle
new -> do
            Handle -> IO ()
IO.hClose Handle
old
            Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
new BufferMode
IO.LineBuffering
            Integer
size <- Handle -> IO Integer
IO.hFileSize Handle
new
            forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
new, Integer
size)

ignoreException :: String -> IO a -> IO (Maybe a)
ignoreException :: forall a. FilePath -> IO a -> IO (Maybe a)
ignoreException FilePath
name IO a
action = forall e a. Exception e => IO a -> IO (Either e a)
Exception.try IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either SomeException a
result -> case Either SomeException a
result of
    Left SomeException
exc
        | Just IOError
e <- forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
exc, IOError -> Bool
Error.isDoesNotExistError IOError
e ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise -> do
            FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
": ignoring hopefully transient exception: "
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SomeException
exc
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Right a
val -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
val

-- | Check if it looks like the file has been renamed.
file_renamed :: FilePath -> Integer -> IO Bool
file_renamed :: FilePath -> Integer -> IO Bool
file_renamed FilePath
filename Integer
size = do
    -- I should really use inode, but ghc's crummy IO libs make that a pain,
    -- since handleToFd closes the handle.
    FileOffset
file_size <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe FileOffset
0 FileStatus -> FileOffset
Posix.fileSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall a. FilePath -> IO a -> IO (Maybe a)
ignoreException FilePath
"file_renamed" (FilePath -> IO FileStatus
Posix.getFileStatus FilePath
filename)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
file_size forall a. Eq a => a -> a -> Bool
/= Integer
size Bool -> Bool -> Bool
&& FileOffset
file_size forall a. Eq a => a -> a -> Bool
/= FileOffset
0

-- * magic

starting_msg :: Text
starting_msg :: Text
starting_msg = Text
"app starting"

quitting_msg :: Text
quitting_msg :: Text
quitting_msg = Text
"app quitting"