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)

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

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

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')