module Highlight.Util where

import Prelude ()
import Prelude.Compat

import Control.Exception (IOException, try)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.State (MonadState, get, put)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafePackMallocCStringLen)
import Foreign.C (newCStringLen)
import System.Exit (ExitCode(ExitFailure), exitWith)
import System.IO (Handle, IOMode(ReadMode), hClose, hIsEOF, openBinaryFile)

-- | Convert a 'String' to a 'ByteString' with the encoding for the current
-- locale.
--
-- >>> convertStringToRawByteString "hello"
-- "hello"
convertStringToRawByteString :: MonadIO m => String -> m ByteString
convertStringToRawByteString :: String -> m ByteString
convertStringToRawByteString String
str = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
  CStringLen
cStringLen <- String -> IO CStringLen
newCStringLen String
str
  CStringLen -> IO ByteString
unsafePackMallocCStringLen CStringLen
cStringLen
{-# INLINABLE convertStringToRawByteString #-}

-- | Open a 'FilePath' in 'ReadMode'.
--
-- On success, return a 'Right' 'Handle':
--
-- >>> openFilePathForReading "README.md"
-- Right {handle: README.md}
--
-- On error, return a 'Left' 'IOException':
--
-- >>> openFilePathForReading "thisfiledoesntexist"
-- Left thisfiledoesntexist: openBinaryFile: does not exist ...
openFilePathForReading :: MonadIO m => FilePath -> m (Either IOException Handle)
openFilePathForReading :: String -> m (Either IOException Handle)
openFilePathForReading String
filePath =
  IO (Either IOException Handle) -> m (Either IOException Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Handle) -> m (Either IOException Handle))
-> (IO Handle -> IO (Either IOException Handle))
-> IO Handle
-> m (Either IOException Handle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Handle -> IO (Either IOException Handle)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Handle -> m (Either IOException Handle))
-> IO Handle -> m (Either IOException Handle)
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openBinaryFile String
filePath IOMode
ReadMode
{-# INLINABLE openFilePathForReading #-}

-- | Combine values in two 'Applicative's with '<>'.
--
-- >>> combineApplicatives (Just "hello") (Just " world")
-- Just "hello world"
--
-- >>> combineApplicatives (Just "hello") Nothing
-- Nothing
combineApplicatives :: (Applicative f, Semigroup a) => f a -> f a -> f a
combineApplicatives :: f a -> f a -> f a
combineApplicatives f a
action1 f a
action2 =
  a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> f a -> f (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
action1 f (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
action2
{-# INLINABLE combineApplicatives #-}

-- | Handle an 'IOException' that occurs when reading from a 'Handle'.  Check
-- if the 'IOException' is an EOF exception ('hIsEOF').  If so, then just close
-- the 'Handle'.  Otherwise, throw the 'IOException' that is passed in.
closeHandleIfEOFOrThrow :: MonadIO m => Handle -> IOException -> m ()
closeHandleIfEOFOrThrow :: Handle -> IOException -> m ()
closeHandleIfEOFOrThrow Handle
handle IOException
ioerr = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
isEOF <- Handle -> IO Bool
hIsEOF Handle
handle
  if Bool
isEOF
    then Handle -> IO ()
hClose Handle
handle
    else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
ioerr
{-# INLINABLE closeHandleIfEOFOrThrow #-}

-- | Call 'exitWith' with 'ExitFailure'
--
-- >>> die 10 "message"
-- ERROR: message
-- *** Exception: ExitFailure 10
die
  :: Int     -- ^ exit code
  -> String  -- ^ error message to print to console
  -> IO a
die :: Int -> String -> IO a
die Int
exitCode String
msg = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"ERROR: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
  ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
exitCode
{-# INLINABLE die #-}

-- | Perform an action when a list is non-null.
--
-- >>> whenNonNull [1,2,3] $ putStrLn "hello"
-- hello
-- >>> whenNonNull [] $ putStrLn "bye"
--
whenNonNull :: Monad m => [a] -> m () -> m ()
whenNonNull :: [a] -> m () -> m ()
whenNonNull [] m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenNonNull [a]
_ m ()
action = m ()
action
{-# INLINABLE whenNonNull #-}


-- | A variant of 'modify' in which the computation is strict in the
-- new state.
--
-- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@
--
-- This is used because 'modify'' is not available in the @tranformers-0.3.0.0@
-- package.
modify' :: MonadState s m => (s -> s) -> m ()
modify' :: (s -> s) -> m ()
modify' s -> s
f = do
  s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
  s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (s -> m ()) -> s -> m ()
forall a b. (a -> b) -> a -> b
$! s -> s
f s
s
{-# INLINE modify' #-}