module Data.GI.CodeGen.Util ( prime , parenthesize , padTo , withComment , ucFirst , lcFirst , modifyQualified , tshow , terror , utf8ReadFile , utf8WriteFile , splitOn , printWarning ) where import GHC.Stack (HasCallStack) #if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>)) #endif import Data.Char (toLower, toUpper) import qualified Data.ByteString as B import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO import qualified System.Console.ANSI as A import System.IO (stderr, hFlush) padTo :: Int -> Text -> Text padTo n s = s <> T.replicate (n - T.length s) " " withComment :: Text -> Text -> Text withComment a b = padTo 40 a <> "-- " <> b prime :: Text -> Text prime = (<> "'") parenthesize :: Text -> Text parenthesize s = "(" <> s <> ")" -- | Construct the `Text` representation of a showable. tshow :: Show a => a -> Text tshow = T.pack . show -- | Capitalize the first character of the given string. ucFirst :: Text -> Text ucFirst "" = "" ucFirst t = T.cons (toUpper $ T.head t) (T.tail t) -- | Make the first character of the given string lowercase. lcFirst :: Text -> Text lcFirst "" = "" lcFirst t = T.cons (toLower $ T.head t) (T.tail t) -- | Apply the given modification function to the given symbol. If the -- symbol is qualified the modification will only apply to the last -- component. modifyQualified :: (Text -> Text) -> Text -> Text modifyQualified f = T.intercalate "." . modify . T.splitOn "." where modify :: [Text] -> [Text] modify [] = [] modify (a:[]) = f a : [] modify (a:as) = a : modify as -- | Split a list into sublists delimited by the given element. splitOn :: Eq a => a -> [a] -> [[a]] splitOn x xs = go xs [] where go [] acc = [reverse acc] go (y : ys) acc = if x == y then reverse acc : go ys [] else go ys (y : acc) -- | Read a file assuming it is UTF-8 encoded. If decoding fails this -- calls `error`. utf8ReadFile :: FilePath -> IO T.Text utf8ReadFile fname = do bytes <- B.readFile fname case TE.decodeUtf8' bytes of Right text -> return text Left error -> terror ("Input file " <> tshow fname <> " seems not to be valid UTF-8. Error was:\n" <> tshow error) -- | Write the given `Text` into an UTF-8 encoded file. utf8WriteFile :: FilePath -> T.Text -> IO () utf8WriteFile fname text = B.writeFile fname (TE.encodeUtf8 text) -- | Print a (colored) warning message to stderr printWarning :: Text -> IO () printWarning warning = do inColour <- A.hSupportsANSIColor stderr if not inColour then TIO.hPutStrLn stderr warning else do A.hSetSGR stderr [A.SetConsoleIntensity A.BoldIntensity, A.SetColor A.Foreground A.Vivid A.Yellow] TIO.hPutStr stderr "Warning: " A.hSetSGR stderr [A.SetColor A.Foreground A.Vivid A.White] TIO.hPutStrLn stderr warning A.hSetSGR stderr [A.Reset] hFlush stderr -- | Throw an error with the given `Text`. terror :: HasCallStack => Text -> a terror errMsg = let fmt = A.setSGRCode [A.SetConsoleIntensity A.BoldIntensity, A.SetColor A.Foreground A.Vivid A.Red] ++ "ERROR: " ++ A.setSGRCode [A.SetColor A.Foreground A.Vivid A.White] ++ T.unpack errMsg ++ A.setSGRCode [A.SetConsoleIntensity A.NormalIntensity, A.SetColor A.Foreground A.Vivid A.Blue] ++ "\nPlease report this at https://github.com/haskell-gi/haskell-gi/issues" ++ A.setSGRCode [A.Reset] in error fmt