module Language.Elsa.Utils where
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Dequeue as Q
import Data.Hashable
import Data.Char (isSpace)
import Control.Exception
import Text.Printf
import System.Directory
import System.FilePath
import Debug.Trace (trace)
import System.Console.ANSI
groupBy :: (Eq k, Hashable k) => (a -> k) -> [a] -> [(k, [a])]
groupBy f = M.toList . L.foldl' (\m x -> inserts (f x) x m) M.empty
inserts :: (Eq k, Hashable k) => k -> v -> M.HashMap k [v] -> M.HashMap k [v]
inserts k v m = M.insert k (v : M.lookupDefault [] k m) m
dupBy :: (Eq k, Hashable k) => (a -> k) -> [a] -> [[a]]
dupBy f xs = [ xs' | (_, xs') <- groupBy f xs, 2 <= length xs' ]
trim :: String -> String
trim = f . f where f = reverse . dropWhile isSpace
trimEnd :: String -> String
trimEnd = reverse . dropWhile isSpace . reverse
ensurePath :: FilePath -> IO ()
ensurePath = createDirectoryIfMissing True . takeDirectory
safeReadFile :: FilePath -> IO (Either String String)
safeReadFile f = (Right <$> readFile f) `catch` handleIO f
handleIO :: FilePath -> IOException -> IO (Either String a)
handleIO f e = return . Left $ "Warning: Couldn't open " <> f <> ": " <> show e
traceShow :: (Show a) => String -> a -> a
traceShow msg x
| False
= trace (printf "TRACE: %s = %s" msg (show x)) x
| otherwise
= x
safeHead :: a -> [a] -> a
safeHead def [] = def
safeHead _ (x:_) = x
getRange :: Int -> Int -> [a] -> [a]
getRange i1 i2
= take (i2 - i1 + 1)
. drop (i1 - 1)
fromEither :: Either a a -> a
fromEither (Left x) = x
fromEither (Right x) = x
newtype Queue a = Q (Q.BankersDequeue a)
qEmpty :: Queue a
qEmpty = Q Q.empty
qInit :: a -> Queue a
qInit x = qPushes qEmpty [x]
qPushes :: Queue a -> [a] -> Queue a
qPushes (Q q) xs = Q (L.foldl' Q.pushFront q xs)
qPop :: Queue a -> Maybe (a, Queue a)
qPop (Q q) = case Q.popBack q of
Nothing -> Nothing
Just (x, q') -> Just (x, Q q')
data Mood = Happy | Sad
moodColor :: Mood -> Color
moodColor Sad = Red
moodColor Happy = Green
wrapStars :: String -> String
wrapStars msg = "\n**** " ++ msg ++ " " ++ replicate (74 - length msg) '*'
withColor :: Color -> IO () -> IO ()
withColor c act = do
setSGR [ SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid c]
act
setSGR [ Reset]
colorStrLn :: Mood -> String -> IO ()
colorStrLn c = withColor (moodColor c) . putStrLn