{-# LANGUAGE CPP, LambdaCase, PackageImports #-}
module Hledger.Utils.IO (
pshow,
pshow',
pprint,
pprint',
pager,
setupPager,
getTerminalHeightWidth,
getTerminalHeight,
getTerminalWidth,
progArgs,
outputFileOption,
hasOutputFile,
colorOption,
useColorOnStdout,
useColorOnStderr,
color,
bgColor,
colorB,
bgColorB,
bold',
faint',
black',
red',
green',
yellow',
blue',
magenta',
cyan',
white',
brightBlack',
brightRed',
brightGreen',
brightYellow',
brightBlue',
brightMagenta',
brightCyan',
brightWhite',
rgb',
terminalIsLight,
terminalLightness,
terminalFgColor,
terminalBgColor,
error',
usageError,
embedFileRelative,
expandHomePath,
expandPath,
expandGlob,
sortByModTime,
readFileOrStdinPortably,
readFileStrictly,
readFilePortably,
readHandlePortably,
getCurrentLocalTime,
getCurrentZonedTime,
)
where
import qualified Control.Exception as C (evaluate)
import Control.Monad (when, forM)
import Data.Colour.RGBSpace (RGB(RGB))
import Data.Colour.RGBSpace.HSL (lightness)
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
import Data.List hiding (uncons)
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Clock (getCurrentTime)
import Data.Time.LocalTime
(LocalTime, ZonedTime, getCurrentTimeZone, utcToLocalTime, utcToZonedTime)
import Data.Word (Word8, Word16)
import Language.Haskell.TH.Syntax (Q, Exp)
import String.ANSI
import System.Console.ANSI (Color(..),ColorIntensity(..),
ConsoleLayer(..), SGR(..), hSupportsANSIColor, setSGRCode, getLayerColor)
import System.Console.Terminal.Size (Window (Window), size)
import System.Directory (getHomeDirectory, getModificationTime)
import System.Environment (getArgs, lookupEnv, setEnv)
import System.FilePath (isRelative, (</>))
import System.IO
(Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
openFile, stdin, stdout, stderr, universalNewlineMode, utf8_bom, hIsTerminalDevice)
import System.IO.Unsafe (unsafePerformIO)
#ifndef mingw32_HOST_OS
import System.Pager (printOrPage)
#endif
import Text.Pretty.Simple
(CheckColorTty(..), OutputOptions(..),
defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt)
import Hledger.Utils.Text (WideBuilder(WideBuilder))
import "Glob" System.FilePath.Glob (glob)
import Data.Functor ((<&>))
prettyopts :: OutputOptions
prettyopts =
(if Bool
useColorOnStderr then OutputOptions
defaultOutputOptionsDarkBg else OutputOptions
defaultOutputOptionsNoColor)
{ outputOptionsIndentAmount = 2
}
prettyoptsNoColor :: OutputOptions
prettyoptsNoColor =
OutputOptions
defaultOutputOptionsNoColor
{ outputOptionsIndentAmount=2
}
pshow :: Show a => a -> String
pshow :: forall a. Show a => a -> String
pshow = Text -> String
TL.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> a -> Text
forall a. Show a => OutputOptions -> a -> Text
pShowOpt OutputOptions
prettyopts
pshow' :: Show a => a -> String
pshow' :: forall a. Show a => a -> String
pshow' = Text -> String
TL.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> a -> Text
forall a. Show a => OutputOptions -> a -> Text
pShowOpt OutputOptions
prettyoptsNoColor
pprint :: Show a => a -> IO ()
pprint :: forall a. Show a => a -> IO ()
pprint = CheckColorTty -> OutputOptions -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt (if Bool
useColorOnStderr then CheckColorTty
CheckColorTty else CheckColorTty
NoCheckColorTty) OutputOptions
prettyopts
pprint' :: Show a => a -> IO ()
pprint' :: forall a. Show a => a -> IO ()
pprint' = CheckColorTty -> OutputOptions -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt CheckColorTty
NoCheckColorTty OutputOptions
prettyoptsNoColor
pager :: String -> IO ()
#ifdef mingw32_HOST_OS
pager = putStrLn
#else
printOrPage' :: String -> IO ()
printOrPage' String
s = do
Bool
dumbterm <- (Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"dumb") (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"TERM"
if Bool
dumbterm then String -> IO ()
putStrLn String
s else Text -> IO ()
printOrPage (String -> Text
T.pack String
s)
= String -> IO ()
printOrPage'
#endif
getTerminalHeightWidth :: IO (Maybe (Int,Int))
getTerminalHeightWidth :: IO (Maybe (Int, Int))
getTerminalHeightWidth = (Maybe (Window Int) -> Maybe (Int, Int))
-> IO (Maybe (Window Int)) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Window Int -> (Int, Int))
-> Maybe (Window Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window Int -> (Int, Int)
forall {b}. Window b -> (b, b)
unwindow) IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
size
where unwindow :: Window b -> (b, b)
unwindow (Window b
h b
w) = (b
h,b
w)
getTerminalHeight :: IO (Maybe Int)
getTerminalHeight :: IO (Maybe Int)
getTerminalHeight = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Int) -> Maybe Int)
-> IO (Maybe (Int, Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Int, Int))
getTerminalHeightWidth
getTerminalWidth :: IO (Maybe Int)
getTerminalWidth :: IO (Maybe Int)
getTerminalWidth = ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> Maybe Int)
-> IO (Maybe (Int, Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Int, Int))
getTerminalHeightWidth
setupPager :: IO ()
= do
let
addR :: String -> IO ()
addR String
var = do
Maybe String
mv <- String -> IO (Maybe String)
lookupEnv String
var
String -> String -> IO ()
setEnv String
var (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe String
mv of
Maybe String
Nothing -> String
"R"
Just String
v -> (Char
'R'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v)
String -> IO ()
addR String
"LESS"
String -> IO ()
addR String
"MORE"
{-# NOINLINE progArgs #-}
progArgs :: [String]
progArgs :: [String]
progArgs = IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO IO [String]
getArgs
outputFileOption :: Maybe String
outputFileOption :: Maybe String
outputFileOption =
let args :: [String]
args = [String]
progArgs in
case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-o" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) [String]
args of
(Char
'-':Char
'o':v :: String
v@(Char
_:String
_)):[String]
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
String
"-o":String
v:[String]
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
[String]
_ ->
case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--output-file") [String]
args of
String
"--output-file":String
v:[String]
_ -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
[String]
_ ->
case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--output-file=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
[Char
'-':Char
'-':Char
'o':Char
'u':Char
't':Char
'p':Char
'u':Char
't':Char
'-':Char
'f':Char
'i':Char
'l':Char
'e':Char
'=':String
v] -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
[String]
_ -> Maybe String
forall a. Maybe a
Nothing
hasOutputFile :: Bool
hasOutputFile :: Bool
hasOutputFile = Maybe String
outputFileOption Maybe String -> [Maybe String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"-"]
ifAnsi :: (a -> a) -> a -> a
ifAnsi a -> a
f = if Bool
useColorOnStdout then a -> a
f else a -> a
forall a. a -> a
id
bold' :: String -> String
bold' :: String -> String
bold' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
bold
faint' :: String -> String
faint' :: String -> String
faint' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
faint
black' :: String -> String
black' :: String -> String
black' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
black
red' :: String -> String
red' :: String -> String
red' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
red
green' :: String -> String
green' :: String -> String
green' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
green
yellow' :: String -> String
yellow' :: String -> String
yellow' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
yellow
blue' :: String -> String
blue' :: String -> String
blue' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
blue
magenta' :: String -> String
magenta' :: String -> String
magenta' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
magenta
cyan' :: String -> String
cyan' :: String -> String
cyan' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
cyan
white' :: String -> String
white' :: String -> String
white' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
white
brightBlack' :: String -> String
brightBlack' :: String -> String
brightBlack' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightBlack
brightRed' :: String -> String
brightRed' :: String -> String
brightRed' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightRed
brightGreen' :: String -> String
brightGreen' :: String -> String
brightGreen' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightGreen
brightYellow' :: String -> String
brightYellow' :: String -> String
brightYellow' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightYellow
brightBlue' :: String -> String
brightBlue' :: String -> String
brightBlue' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightBlue
brightMagenta' :: String -> String
brightMagenta' :: String -> String
brightMagenta' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightMagenta
brightCyan' :: String -> String
brightCyan' :: String -> String
brightCyan' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightCyan
brightWhite' :: String -> String
brightWhite' :: String -> String
brightWhite' = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi String -> String
brightWhite
rgb' :: Word8 -> Word8 -> Word8 -> String -> String
rgb' :: Word8 -> Word8 -> Word8 -> String -> String
rgb' Word8
r Word8
g Word8
b = (String -> String) -> String -> String
forall {a}. (a -> a) -> a -> a
ifAnsi (Word8 -> Word8 -> Word8 -> String -> String
rgb Word8
r Word8
g Word8
b)
colorOption :: String
colorOption :: String
colorOption =
let args :: [String]
args = [String]
progArgs in
case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--color") [String]
args of
String
"--color":String
v:[String]
_ -> String
v
[String]
_ ->
case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--color=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
[Char
'-':Char
'-':Char
'c':Char
'o':Char
'l':Char
'o':Char
'r':Char
'=':String
v] -> String
v
[String]
_ ->
case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--colour") [String]
args of
String
"--colour":String
v:[String]
_ -> String
v
[String]
_ ->
case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--colour=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
[Char
'-':Char
'-':Char
'c':Char
'o':Char
'l':Char
'o':Char
'u':Char
'r':Char
'=':String
v] -> String
v
[String]
_ -> String
""
useColorOnStdout :: Bool
useColorOnStdout :: Bool
useColorOnStdout = Bool -> Bool
not Bool
hasOutputFile Bool -> Bool -> Bool
&& Handle -> Bool
useColorOnHandle Handle
stdout
useColorOnStderr :: Bool
useColorOnStderr :: Bool
useColorOnStderr = Handle -> Bool
useColorOnHandle Handle
stderr
useColorOnHandle :: Handle -> Bool
useColorOnHandle :: Handle -> Bool
useColorOnHandle Handle
h = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
Bool
no_color <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
Bool
supports_color <- Handle -> IO Bool
hSupportsANSIColor Handle
h
let coloroption :: String
coloroption = String
colorOption
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
coloroption String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"always",String
"yes"]
Bool -> Bool -> Bool
|| (String
coloroption String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"never",String
"no"] Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
no_color Bool -> Bool -> Bool
&& Bool
supports_color)
color :: ColorIntensity -> Color -> String -> String
color :: ColorIntensity -> Color -> String -> String
color ColorIntensity
int Color
col String
s = [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
int Color
col] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode []
bgColor :: ColorIntensity -> Color -> String -> String
bgColor :: ColorIntensity -> Color -> String -> String
bgColor ColorIntensity
int Color
col String
s = [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Background ColorIntensity
int Color
col] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode []
colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
colorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
colorB ColorIntensity
int Color
col (WideBuilder Builder
s Int
w) =
Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString ([SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
int Color
col]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString ([SGR] -> String
setSGRCode [])) Int
w
bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
bgColorB :: ColorIntensity -> Color -> WideBuilder -> WideBuilder
bgColorB ColorIntensity
int Color
col (WideBuilder Builder
s Int
w) =
Builder -> Int -> WideBuilder
WideBuilder (String -> Builder
TB.fromString ([SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Background ColorIntensity
int Color
col]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString ([SGR] -> String
setSGRCode [])) Int
w
terminalIsLight :: Maybe Bool
terminalIsLight :: Maybe Bool
terminalIsLight = (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.5) (Float -> Bool) -> Maybe Float -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Float
terminalLightness
terminalLightness :: Maybe Float
terminalLightness :: Maybe Float
terminalLightness = RGB Float -> Float
forall a. (Fractional a, Ord a) => RGB a -> a
lightness (RGB Float -> Float) -> Maybe (RGB Float) -> Maybe Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsoleLayer -> Maybe (RGB Float)
terminalColor ConsoleLayer
Background
terminalBgColor :: Maybe (RGB Float)
terminalBgColor :: Maybe (RGB Float)
terminalBgColor = ConsoleLayer -> Maybe (RGB Float)
terminalColor ConsoleLayer
Background
terminalFgColor :: Maybe (RGB Float)
terminalFgColor :: Maybe (RGB Float)
terminalFgColor = ConsoleLayer -> Maybe (RGB Float)
terminalColor ConsoleLayer
Foreground
{-# NOINLINE terminalColor #-}
terminalColor :: ConsoleLayer -> Maybe (RGB Float)
terminalColor :: ConsoleLayer -> Maybe (RGB Float)
terminalColor = IO (Maybe (RGB Float)) -> Maybe (RGB Float)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (RGB Float)) -> Maybe (RGB Float))
-> (ConsoleLayer -> IO (Maybe (RGB Float)))
-> ConsoleLayer
-> Maybe (RGB Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsoleLayer -> IO (Maybe (RGB Float))
getLayerColor'
getLayerColor' :: ConsoleLayer -> IO (Maybe (RGB Float))
getLayerColor' :: ConsoleLayer -> IO (Maybe (RGB Float))
getLayerColor' ConsoleLayer
l = do
Bool
inemacs <- Bool -> Bool
not(Bool -> Bool) -> (Maybe String -> Bool) -> Maybe String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe String -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"INSIDE_EMACS"
Bool
interactive <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
Bool
supportscolor <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
if Bool
inemacs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
interactive Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
supportscolor then Maybe (RGB Float) -> IO (Maybe (RGB Float))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (RGB Float)
forall a. Maybe a
Nothing
else (RGB Word16 -> RGB Float)
-> Maybe (RGB Word16) -> Maybe (RGB Float)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RGB Word16 -> RGB Float
forall a. Fractional a => RGB Word16 -> RGB a
fractionalRGB (Maybe (RGB Word16) -> Maybe (RGB Float))
-> IO (Maybe (RGB Word16)) -> IO (Maybe (RGB Float))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsoleLayer -> IO (Maybe (RGB Word16))
getLayerColor ConsoleLayer
l
where
fractionalRGB :: (Fractional a) => RGB Word16 -> RGB a
fractionalRGB :: forall a. Fractional a => RGB Word16 -> RGB a
fractionalRGB (RGB Word16
r Word16
g Word16
b) = a -> a -> a -> RGB a
forall a. a -> a -> a -> RGB a
RGB (Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
r a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
65535) (Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
65535) (Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
65535)
error' :: String -> a
error' :: forall a. String -> a
error' = String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
usageError :: String -> a
usageError :: forall a. String -> a
usageError = String -> a
forall a. String -> a
error' (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (use -h to see usage)")
expandHomePath :: FilePath -> IO FilePath
expandHomePath :: String -> IO String
expandHomePath = \case
(Char
'~':Char
'/':String
p) -> (String -> String -> String
</> String
p) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory
(Char
'~':Char
'\\':String
p) -> (String -> String -> String
</> String
p) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory
(Char
'~':String
_) -> IOError -> IO String
forall a. IOError -> IO a
ioError (IOError -> IO String) -> IOError -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"~USERNAME in paths is not supported"
String
p -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
expandPath :: FilePath -> FilePath -> IO FilePath
expandPath :: String -> String -> IO String
expandPath String
_ String
"-" = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-"
expandPath String
curdir String
p = (if String -> Bool
isRelative String
p then (String
curdir String -> String -> String
</>) else String -> String
forall a. a -> a
id) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
expandHomePath String
p
expandGlob :: FilePath -> FilePath -> IO [FilePath]
expandGlob :: String -> String -> IO [String]
expandGlob String
curdir String
p = String -> String -> IO String
expandPath String
curdir String
p IO String -> (String -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO [String]
glob IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [String] -> [String]
forall a. Ord a => [a] -> [a]
sort
sortByModTime :: [FilePath] -> IO [FilePath]
sortByModTime :: [String] -> IO [String]
sortByModTime [String]
fs = do
[(UTCTime, String)]
ftimes <- [String]
-> (String -> IO (UTCTime, String)) -> IO [(UTCTime, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
fs ((String -> IO (UTCTime, String)) -> IO [(UTCTime, String)])
-> (String -> IO (UTCTime, String)) -> IO [(UTCTime, String)]
forall a b. (a -> b) -> a -> b
$ \String
f -> do {UTCTime
t <- String -> IO UTCTime
getModificationTime String
f; (UTCTime, String) -> IO (UTCTime, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
t,String
f)}
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ((UTCTime, String) -> String) -> [(UTCTime, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (UTCTime, String) -> String
forall a b. (a, b) -> b
snd ([(UTCTime, String)] -> [String])
-> [(UTCTime, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(UTCTime, String)] -> [(UTCTime, String)]
forall a. [a] -> [a]
reverse ([(UTCTime, String)] -> [(UTCTime, String)])
-> [(UTCTime, String)] -> [(UTCTime, String)]
forall a b. (a -> b) -> a -> b
$ [(UTCTime, String)] -> [(UTCTime, String)]
forall a. Ord a => [a] -> [a]
sort [(UTCTime, String)]
ftimes
readFileStrictly :: FilePath -> IO T.Text
readFileStrictly :: String -> IO Text
readFileStrictly String
f = String -> IO Text
readFilePortably String
f IO Text -> (Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t -> Int -> IO Int
forall a. a -> IO a
C.evaluate (Text -> Int
T.length Text
t) IO Int -> IO Text -> IO Text
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
readFilePortably :: FilePath -> IO T.Text
readFilePortably :: String -> IO Text
readFilePortably String
f = String -> IOMode -> IO Handle
openFile String
f IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
readHandlePortably
readFileOrStdinPortably :: String -> IO T.Text
readFileOrStdinPortably :: String -> IO Text
readFileOrStdinPortably String
f = String -> IOMode -> IO Handle
openFileOrStdin String
f IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
readHandlePortably
where
openFileOrStdin :: String -> IOMode -> IO Handle
openFileOrStdin :: String -> IOMode -> IO Handle
openFileOrStdin String
"-" IOMode
_ = Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin
openFileOrStdin String
f' IOMode
m = String -> IOMode -> IO Handle
openFile String
f' IOMode
m
readHandlePortably :: Handle -> IO T.Text
readHandlePortably :: Handle -> IO Text
readHandlePortably Handle
h = do
Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
h NewlineMode
universalNewlineMode
Maybe TextEncoding
menc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> String
forall a. Show a => a -> String
show Maybe TextEncoding
menc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"UTF-8") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8_bom
Handle -> IO Text
T.hGetContents Handle
h
embedFileRelative :: FilePath -> Q Exp
embedFileRelative :: String -> Q Exp
embedFileRelative String
f = String -> Q String
makeRelativeToProject String
f Q String -> (String -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Q Exp
embedStringFile
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime :: IO LocalTime
getCurrentLocalTime = do
UTCTime
t <- IO UTCTime
getCurrentTime
TimeZone
tz <- IO TimeZone
getCurrentTimeZone
LocalTime -> IO LocalTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> IO LocalTime) -> LocalTime -> IO LocalTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
t
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime :: IO ZonedTime
getCurrentZonedTime = do
UTCTime
t <- IO UTCTime
getCurrentTime
TimeZone
tz <- IO TimeZone
getCurrentTimeZone
ZonedTime -> IO ZonedTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonedTime -> IO ZonedTime) -> ZonedTime -> IO ZonedTime
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
t