Misc.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
module Misc((|>), (&>), (&>=), (>>>), (>=>), (/#), (|*>), (<*|), aempty, andIfValidMV, andIfValidV, asString, asPath, asText, showText, concat, error, fromEither, headMaybe, lastMaybe, map, pam, (<&>), cartProduct, regexMatch, groupOn, length, mapMSequA, orElse, return', scalaGroupBy, putStrFlush, traceLabel, unsafeRead, listDirsRecursively, uncurry5, uncurry6) where

import External

import GHC.Real(Fractional((/)))

import Text.Regex.PCRE((=~))

import qualified Control.Applicative   as Apply
import qualified Control.Arrow         as CArrow
import qualified Control.Monad         as CMonad
import qualified Data.Either           as Either
import qualified Data.Foldable         as Foldable
import qualified Data.List             as List
import qualified Data.List.NonEmpty    as NE
import qualified Data.Text             as Text
import qualified Data.Text.IO          as TIO
import qualified Data.Text.Read        as DTR
import qualified GHC.Err               as Err
import qualified System.Directory      as SD
import qualified System.IO             as SIO

(/#) :: (Real a, Real b) => a -> b -> Double
a /# b = (realToFrac a) / (realToFrac b)

(|>) :: a -> (a -> b) -> b
a |> f = f a

(&>), (>>>) :: (a -> b) -> (b -> c) -> (a -> c)
(>>>) = (CArrow.>>>)
(&>)  = (>>>)

(&>=), (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
(>=>) = (CMonad.>=>)
(&>=) = (>=>)

infixl 2 >>>, >=>
infixl 1 |>

(<*|) :: (Monad m, Applicative a) => m (a x) -> m (a x) -> m (a x)
(<*|) a b =
  do
    va <- a
    vb <- b
    return $ va <* vb

(|*>) :: (Monad m, Applicative a) => m (a x) -> m (a x) -> m (a x)
(|*>) a b =
  do
    va <- a
    vb <- b
    return $ va *> vb

aempty :: Apply.Alternative f => f a
aempty = Apply.empty

asString :: Text -> String
asString = Text.unpack

asPath :: Text -> FilePath
asPath = asString

asText :: String -> Text
asText = Text.pack

showText :: Show a => a -> Text
showText = show &> asText

concat :: (Foldable t, MonadPlus m) => t (m a) -> m a
concat = Foldable.msum

error :: Text -> a
error = asString &> Err.error

map :: (Functor f) => (a -> b) -> f a -> f b
map = fmap

pam, (<&>) :: Functor f => f a -> (a -> b) -> f b
pam   = flip map
(<&>) = flip map

mapMSequA :: (Monad m, Applicative f, Traversable t) => (a -> m (f b)) -> t a -> m (f (t b))
mapMSequA f xs =
  do
    resVs <- mapM f xs
    return $ sequenceA resVs

andIfValidV :: Monad m => Validation f s1 -> (s1 -> m (Validation f s2)) -> m (Validation f s2)
v `andIfValidV` vm = validation (Failure &> return) vm v

andIfValidMV :: Monad m => m (Validation f s1) -> (s1 -> m (Validation f s2)) -> m (Validation f s2)
sVM `andIfValidMV` f =
  do
    sV <- sVM
    sV `andIfValidV` f

orElse :: Maybe a -> a -> a
orElse m x = maybe x id m

headMaybe :: Foldable t => t a -> Maybe a
headMaybe = Foldable.toList &> helper
  where
    helper    [] = Nothing
    helper (h:_) = Just h

lastMaybe :: Foldable t => t a -> Maybe a
lastMaybe = Foldable.toList &> helper
  where
    helper [] = Nothing
    helper xs = Just $ List.last xs

length :: Foldable t => t a -> Word
length = Foldable.length &> fromIntegral

cartProduct :: [a] -> [b] -> [(a, b)]
cartProduct xs ys = [(x, y) | x <- xs, y <- ys]

regexMatch :: Text -> Text -> Maybe [Text]
regexMatch regex text =
  case (Text.unpack text) =~ ("(?sm)" <> Text.unpack regex) :: [[String]] of
    []       -> Nothing
    captures -> Just [Text.pack group | (_full : groups) <- captures, group <- groups]

unsafeNonEmpty :: [a] -> NonEmpty a
unsafeNonEmpty = NE.nonEmpty &> maybe (error "`unsafeNonEmpty` is unsafe") id

fromEither :: Either a a -> a
fromEither = either id id

groupOn :: Ord criterion => (item -> criterion) -> [item] -> [NonEmpty item]
groupOn f = sort &> group &> (map $ unsafeNonEmpty)
  where
    sort  = List.sortBy (compare `on` f)
    group = List.groupBy ((==) `on` f)

return' :: (Monad m) => a -> m a
return' = (return $!)

scalaGroupBy :: Ord criterion => (item -> criterion) -> [item] -> [(criterion, NonEmpty item)]
scalaGroupBy f = (groupOn f) &> pair
  where
    pair  = tee $ NE.head &> f
    tee f = map $ f &&& id

-- Hack to make GHCI print this before the prompt --Jason B. (2/20/17)
putStrFlush :: Text -> IO ()
putStrFlush x = (TIO.putStr x) >>= (const $ SIO.hFlush SIO.stdout)

traceLabel :: (Show a) => Text -> a -> a
traceLabel label a = traceShow (label <> ": " <> (showText a)) a

unsafeRead :: Integral a => Text -> a
unsafeRead = DTR.decimal &> (Either.either (error "Well, that read *was* unsafe...") id) &> fst

listDirsRecursively :: FilePath -> IO [FilePath]
listDirsRecursively filepath =
  do
    paths    <- SD.listDirectory filepath
    dirs     <- paths |> ((map $ \x -> filepath <> "/" <> x) &> (filterM SD.doesDirectoryExist))
    children <- mapM listDirsRecursively dirs
    return $ dirs <> (concat children)

uncurry5 :: (a -> b -> c -> d -> e -> f) -> ((a, b, c, d, e) -> f)
uncurry5 f (a, b, c, d, e) = f a b c d e

uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> ((a, b, c, d, e, f) -> g)
uncurry6 g (a, b, c, d, e, f) = g a b c d e f