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 :: forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> [(k, [a])]
groupBy a -> k
f = forall k v. HashMap k v -> [(k, v)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\HashMap k [a]
m a
x -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k [v] -> HashMap k [v]
inserts (a -> k
f a
x) a
x HashMap k [a]
m) forall k v. HashMap k v
M.empty

inserts :: (Eq k, Hashable k) => k -> v -> M.HashMap k [v] -> M.HashMap k [v]
inserts :: forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k [v] -> HashMap k [v]
inserts k
k v
v HashMap k [v]
m = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert k
k (v
v forall a. a -> [a] -> [a]
: forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault [] k
k HashMap k [v]
m) HashMap k [v]
m

dupBy :: (Eq k, Hashable k) => (a -> k) -> [a] -> [[a]]
dupBy :: forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> [[a]]
dupBy a -> k
f [a]
xs = [ [a]
xs' | (k
_, [a]
xs') <- forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> [(k, [a])]
groupBy a -> k
f [a]
xs, Int
2 forall a. Ord a => a -> a -> Bool
<= forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs' ]

trim :: String -> String
trim :: [Char] -> [Char]
trim = [Char] -> [Char]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
f  where f :: [Char] -> [Char]
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

trimEnd :: String -> String
trimEnd :: [Char] -> [Char]
trimEnd = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

ensurePath :: FilePath -> IO ()
ensurePath :: [Char] -> IO ()
ensurePath = Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeDirectory

safeReadFile :: FilePath -> IO (Either String String)
safeReadFile :: [Char] -> IO (Either [Char] [Char])
safeReadFile [Char]
f = (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
f) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. [Char] -> IOException -> IO (Either [Char] a)
handleIO [Char]
f

handleIO :: FilePath -> IOException -> IO (Either String a)
handleIO :: forall a. [Char] -> IOException -> IO (Either [Char] a)
handleIO [Char]
f IOException
e = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: Couldn't open " forall a. Semigroup a => a -> a -> a
<> [Char]
f forall a. Semigroup a => a -> a -> a
<> [Char]
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show IOException
e

traceShow :: (Show a) => String -> a -> a
traceShow :: forall a. Show a => [Char] -> a -> a
traceShow [Char]
msg a
x
  | Bool
False
  = forall a. [Char] -> a -> a
trace (forall r. PrintfType r => [Char] -> r
printf [Char]
"TRACE: %s = %s" [Char]
msg (forall a. Show a => a -> [Char]
show a
x)) a
x
  | Bool
otherwise
  = a
x

safeHead :: a -> [a] -> a
safeHead :: forall a. a -> [a] -> a
safeHead a
def []    = a
def
safeHead a
_   (a
x:[a]
_) = a
x

getRange :: Int -> Int -> [a] -> [a]
getRange :: forall a. Int -> Int -> [a] -> [a]
getRange Int
i1 Int
i2
  = forall a. Int -> [a] -> [a]
take (Int
i2 forall a. Num a => a -> a -> a
- Int
i1 forall a. Num a => a -> a -> a
+ Int
1)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (Int
i1 forall a. Num a => a -> a -> a
- Int
1)

fromEither :: Either a a -> a
fromEither :: forall a. Either a a -> a
fromEither (Left a
x)  = a
x
fromEither (Right a
x) = a
x

--------------------------------------------------------------------------------
-- | Queue ---------------------------------------------------------------------
--------------------------------------------------------------------------------

newtype Queue a = Q (Q.BankersDequeue a)

qEmpty :: Queue a
qEmpty :: forall a. Queue a
qEmpty = forall a. BankersDequeue a -> Queue a
Q forall (q :: * -> *) a. Dequeue q => q a
Q.empty

qInit :: a -> Queue a
qInit :: forall a. a -> Queue a
qInit a
x = forall a. Queue a -> [a] -> Queue a
qPushes forall a. Queue a
qEmpty [a
x]

qPushes :: Queue a -> [a] -> Queue a
qPushes :: forall a. Queue a -> [a] -> Queue a
qPushes (Q BankersDequeue a
q) [a]
xs = forall a. BankersDequeue a -> Queue a
Q (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' forall (q :: * -> *) a. Dequeue q => q a -> a -> q a
Q.pushFront BankersDequeue a
q [a]
xs)

qPop :: Queue a -> Maybe (a, Queue a)
qPop :: forall a. Queue a -> Maybe (a, Queue a)
qPop (Q BankersDequeue a
q) = case forall (q :: * -> *) a. Dequeue q => q a -> Maybe (a, q a)
Q.popBack BankersDequeue a
q of
               Maybe (a, BankersDequeue a)
Nothing      -> forall a. Maybe a
Nothing
               Just (a
x, BankersDequeue a
q') -> forall a. a -> Maybe a
Just (a
x, forall a. BankersDequeue a -> Queue a
Q BankersDequeue a
q')


data Mood = Happy | Sad 

moodColor :: Mood -> Color
moodColor :: Mood -> Color
moodColor Mood
Sad   = Color
Red 
moodColor Mood
Happy = Color
Green

wrapStars :: String -> String
wrapStars :: [Char] -> [Char]
wrapStars [Char]
msg = [Char]
"\n**** " forall a. [a] -> [a] -> [a]
++ [Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
74 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
msg) Char
'*'

withColor :: Color -> IO () -> IO ()
withColor :: Color -> IO () -> IO ()
withColor Color
c IO ()
act = do 
  [SGR] -> IO ()
setSGR [ ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity, ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c]
  IO ()
act
  [SGR] -> IO ()
setSGR [ SGR
Reset]

colorStrLn :: Mood -> String -> IO ()
colorStrLn :: Mood -> [Char] -> IO ()
colorStrLn Mood
c = Color -> IO () -> IO ()
withColor (Mood -> Color
moodColor Mood
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn