module Data.MyHelpers where
import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy (ByteString)
import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)
import Data.Char
import Data.Int
import Data.List
import qualified Data.Map as M
import Data.Map (Map, (!))
import Data.Maybe
import Prelude hiding (putStrLn)
import System.IO hiding (putStrLn,hPutStr)
import System.IO.Unsafe
import System.IO.UTF8
type ErrorMessage = String
infixr 1 <<
(<<) :: Monad m => m b -> m a -> m b
f << x = x >> f
fst3 :: (a,b,c) -> a
snd3 :: (a,b,c) -> b
thrd3 :: (a,b,c) -> c
fst3 (a,_,_) = a
snd3 (_,b,_) = b
thrd3 (_,_,c) = c
apFor2ple :: (a -> a -> a, b -> b -> b) -> (a,b) -> (a,b) -> (a,b)
apFor2ple (af,bf) (a1,b1) (a2,b2) = (af a1 a2, bf b1 b2)
liftTuple :: Monad m => (m a, m b) -> m (a, b)
lift2ple :: Monad m => (m a, m b) -> m (a, b)
lift3ple :: Monad m => (m a, m b, m c) -> m (a, b, c)
lift4ple :: Monad m => (m a, m b, m c, m d) -> m (a, b, c, d)
liftTuple (ma, mb) = do a <- ma
b <- mb
return (a,b)
lift2ple = liftTuple
lift3ple (ma, mb, mc) = do a <- ma
b <- mb
c <- mc
return (a,b,c)
lift4ple (ma, mb, mc, md) = do a <- ma
b <- mb
c <- mc
d <- md
return (a,b,c,d)
ap22ple :: (a, a) -> (a -> b) -> (b, b)
ap22ple (a1,a2) fa = (fa a1, fa a2)
ap22pleM :: Monad m => (a, a) -> (a -> m b) -> m (b, b)
ap22pleM ple f = lift2ple $ ap22ple ple f
ap23ple :: (a, a, a) -> (a -> b) -> (b, b, b)
ap23ple (a1,a2,a3) fa = (fa a1, fa a2, fa a3)
ap23pleM :: Monad m => (a, a, a) -> (a -> m b) -> m (b, b, b)
ap23pleM ple f = lift3ple $ ap23ple ple f
ap24ple :: (a, a, a, a) -> (a -> b) -> (b, b, b, b)
ap24ple (a1,a2,a3,a4) fa = (fa a1, fa a2, fa a3, fa a3)
ap24pleM :: Monad m => (a, a, a, a) -> (a -> m b) -> m (b, b, b, b)
ap24pleM ple f = lift4ple $ ap24ple ple f
apFrom2ple :: ((a -> b), (a -> c)) -> a -> (b, c)
apFrom2ple (f1,f2) a = (f1 a, f2 a)
apFrom3ple :: ((a -> b), (a -> c), (a -> d)) -> a -> (b, c, d)
apFrom3ple (f1,f2,f3) a = (f1 a, f2 a, f3 a)
apFrom4ple :: ((a -> b), (a -> c), (a -> d), (a -> e)) -> a -> (b, c, d, e)
apFrom4ple (f1,f2,f3,f4) a = (f1 a, f2 a, f3 a, f4 a)
liftEither6 :: Either er a -> Either er b -> Either er c -> Either er d -> Either er e -> Either er f -> Either er (a,b,c,d,e,f)
liftEither6 er_or_a er_or_b er_or_c er_or_d er_or_e er_or_f =
case er_or_a of
Left er -> Left er
Right a ->
case er_or_b of
Left er -> Left er
Right b ->
case er_or_c of
Left er -> Left er
Right c ->
case er_or_d of
Left er -> Left er
Right d ->
case er_or_e of
Left er -> Left er
Right e ->
case er_or_f of
Left er -> Left er
Right f -> Right (a,b,c,d,e,f)
liftEither5 :: Either er a -> Either er b -> Either er c -> Either er d -> Either er e -> Either er (a,b,c,d,e)
liftEither5 er_or_a er_or_b er_or_c er_or_d er_or_e =
case er_or_a of
Left er -> Left er
Right a ->
case er_or_b of
Left er -> Left er
Right b ->
case er_or_c of
Left er -> Left er
Right c ->
case er_or_d of
Left er -> Left er
Right d ->
case er_or_e of
Left er -> Left er
Right e -> Right (a,b,c,d,e)
liftEither2 :: Either er a -> Either er b -> Either er (a,b)
liftEither2 er_or_a er_or_b =
case er_or_a of
Left er -> Left er
Right a ->
case er_or_b of
Left er -> Left er
Right b -> Right (a,b)
isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _ = False
isRight :: Either a b -> Bool
isRight = not . isLeft
fromLeft :: Either a b -> a
fromLeft (Left a) = a
fromLeft _ = error "Error occurred, when applied fromLeft to Right!"
fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight _ = error "Error occurred, when applied fromLeft to Right!"
takeFromMap :: Ord k => k -> Map k a -> (Maybe a, Map k a)
takeFromMap k m =
let mb_a = M.lookup k m
in ( mb_a
, case isJust mb_a of
True -> M.delete k m
False -> m
)
partition_2 :: Ord k => (a -> Bool) -> (a -> b, a -> c) -> Map k a -> (Map k b, Map k c)
partition_2 p (true_f, false_f) m =
M.foldWithKey
(\ k a (true_map, false_map) ->
case p a of
True -> (M.insert k (true_f a) true_map, false_map)
False -> (true_map, M.insert k (false_f a) false_map)
)
(M.empty, M.empty)
m
unionWithKey_2 :: Ord k => (k -> (a, a) -> (a, b)) -> (b -> c -> c) -> c -> Map k a -> Map k a -> (Map k a, c)
unionWithKey_2 unifier side_result_accum_f accum_start m1 m2 =
foldr (\ (k, a1) (m_accum, side_result_accum) ->
case takeFromMap k m_accum of
(Nothing, _) -> (M.insert k a1 m_accum, side_result_accum)
(Just a2, rest_of_accum_map) ->
let (ar, side_result_add) = unifier k (a1, a2)
in (M.insert k ar rest_of_accum_map, side_result_accum_f side_result_add side_result_accum)
)
(m2, accum_start)
(M.toList m1)
unionWithKey_3 :: Ord k => (k -> (Maybe a, Maybe b) -> (c, d)) -> (d -> d -> d) -> d -> Map k a -> Map k b -> (Map k c, d)
unionWithKey_3 unifierF sideResultAccumF accum_start m1 m2 =
let (m1_result, accum1, m2_cut) = foldr
(\ (k, a) (m_accum, side_result_accum, m2_cut) ->
let (mb_b, new_m2_cut) = takeFromMap k m2_cut
(c, d) = unifierF k (Just a, mb_b)
new_side_result_accum = sideResultAccumF side_result_accum d
in (M.insert k c m_accum, new_side_result_accum, new_m2_cut)
)
(M.empty, accum_start, m2)
(M.toList m1)
(m2_result, accum2) = foldr
(\ (k, b) (m_accum, side_result_accum) ->
let (c, d) = unifierF k (Nothing, Just b)
new_side_result_accum = sideResultAccumF side_result_accum d
in (M.insert k c m_accum, new_side_result_accum)
)
(m1_result, accum1)
(M.toList m2_cut)
in (m2_result, accum2)
unionWithKey_4 :: Ord k => (k -> (Maybe a, Maybe b) -> (Maybe c, d)) -> (d -> d -> d) -> d -> Map k a -> Map k b -> (Map k c, d)
unionWithKey_4 unifierF sideResultAccumF accum_start m1 m2 =
let (m1_result, accum1, m2_cut) = foldr
(\ (k, a) (m_accum, side_result_accum, m2_cut) ->
let (mb_b, new_m2_cut) = takeFromMap k m2_cut
(mb_c, d) = unifierF k (Just a, mb_b)
new_side_result_accum = sideResultAccumF side_result_accum d
in ( case mb_c of
Just c -> M.insert k c m_accum
Nothing -> m_accum
, new_side_result_accum, new_m2_cut
)
)
(M.empty, accum_start, m2)
(M.toList m1)
(m2_result, accum2) = foldr
(\ (k, b) (m_accum, side_result_accum) ->
let (mb_c, d) = unifierF k (Nothing, Just b)
new_side_result_accum = sideResultAccumF side_result_accum d
in ( case mb_c of
Just c -> M.insert k c m_accum
Nothing -> m_accum
, new_side_result_accum
)
)
(m1_result, accum1)
(M.toList m2_cut)
in (m2_result, accum2)
lookupDeleteFromList :: Eq a => a -> [a] -> (Bool, [a])
lookupDeleteFromList e l =
let mship = elem e l
in ( mship
, case mship of
True -> delete e l
False -> l
)
from2DList :: Ord k => [(k, a)] -> M.Map k [a]
from2DList l = foldl (\ accum_map (k, e) -> M.unionWith (++) accum_map (M.singleton k [e])) M.empty l
str2Numeric :: (Num a, Ord a) => String -> Maybe a
str2Numeric s = _str2Numeric s 0
where
_str2Numeric [] i = Just i
_str2Numeric (sh:st) i | isDigit sh = let nexti = (i*10) + (fromIntegral $ digitToInt sh)
in case i > nexti of
False -> _str2Numeric st nexti
True -> Nothing
| otherwise = Nothing
cons2' :: Char -> Char -> Lazy.ByteString -> Lazy.ByteString
cons2' c1 c2 s = B.cons' c1 (B.cons' c2 s)
cons3' :: Char -> Char -> Char -> Lazy.ByteString -> Lazy.ByteString
cons3' c1 c2 c3 s = B.cons' c1 (cons2' c2 c3 s)
truncLiterary :: String -> Int -> String
truncLiterary str n = case length str > n of
True -> take (n 3) str ++ "..."
False -> str
truncLiteraryLBS :: Lazy.ByteString -> Int64 -> Lazy.ByteString
truncLiteraryLBS str n =
case B.length str > n of
True -> B.concat [B.take (n 3) str, B.pack "..."]
False -> str
dump :: String -> IO ()
dump a = do
h <- openFile "./dump.out.hs" AppendMode
hPutStr h a
hClose h
watch :: Show a => a -> a
watch a = unsafePerformIO $ do
putStrLn_paged 22 $ show a
return a
watchCond :: Show a => Bool -> a -> a
watchCond cond = if cond then watch else id
putStrLn_paged :: Int -> String -> IO ()
putStrLn_paged page_size s = f $ lines s
where
f lines_list =
let (to_print, to_next_itera) = splitAt page_size lines_list
in do putStrLn (concat $ intersperse "\n" to_print)
case null to_next_itera of
True -> return ()
False -> f to_next_itera << hGetChar stdin << putStrLn "\n-------Press any key to continue...-------"
traceShowPaged :: Show a => Int -> a -> b -> b
traceShowPaged n a b = unsafePerformIO $ do
putStrLn_paged n $ show a
return b
traceCond :: Show a => Bool -> Int -> a -> b -> b
traceCond cond n a b = if cond then traceShowPaged n a b else b