{-# LANGUAGE ExistentialQuantification, Rank2Types #-}

module Util(
    forceList,
    gzip, universeParentBi,
    exitMessage, exitMessageImpure,
    getContentsUTF8, wildcardMatch
    ) where

import System.Exit
import System.IO
import System.IO.Unsafe
import Unsafe.Coerce
import Data.Data
import Data.Generics.Uniplate.DataOnly
import System.FilePattern
import Data.List.Extra


---------------------------------------------------------------------
-- CONTROL.DEEPSEQ

forceList :: [a] -> [a]
forceList :: [a] -> [a]
forceList [a]
xs = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> [a] -> [a]
`seq` [a]
xs


---------------------------------------------------------------------
-- SYSTEM.IO

exitMessage :: String -> IO a
exitMessage :: String -> IO a
exitMessage String
msg = do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
    ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

exitMessageImpure :: String -> a
exitMessageImpure :: String -> a
exitMessageImpure = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (String -> IO a) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall a. String -> IO a
exitMessage


getContentsUTF8 :: IO String
getContentsUTF8 :: IO String
getContentsUTF8 = do
    Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdin TextEncoding
utf8
    IO String
getContents


---------------------------------------------------------------------
-- DATA.GENERICS

data Box = forall a . Data a => Box a

gzip :: Data a => (forall b . Data b => b -> b -> c) -> a -> a -> Maybe [c]
gzip :: (forall b. Data b => b -> b -> c) -> a -> a -> Maybe [c]
gzip forall b. Data b => b -> b -> c
f a
x a
y | a -> Constr
forall a. Data a => a -> Constr
toConstr a
x Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Constr
forall a. Data a => a -> Constr
toConstr a
y = Maybe [c]
forall a. Maybe a
Nothing
           | Bool
otherwise = [c] -> Maybe [c]
forall a. a -> Maybe a
Just ([c] -> Maybe [c]) -> [c] -> Maybe [c]
forall a b. (a -> b) -> a -> b
$ (Box -> Box -> c) -> [Box] -> [Box] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Box -> Box -> c
op ((forall d. Data d => d -> Box) -> a -> [Box]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall d. Data d => d -> Box
Box a
x) ((forall d. Data d => d -> Box) -> a -> [Box]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ forall d. Data d => d -> Box
Box a
y)
         -- unsafeCoerce is safe because gmapQ on the same constr gives the same fields
         -- in the same order
    where op :: Box -> Box -> c
op (Box a
x) (Box y) = a -> a -> c
forall b. Data b => b -> b -> c
f a
x (a -> a
forall a b. a -> b
unsafeCoerce a
y)


---------------------------------------------------------------------
-- DATA.GENERICS.UNIPLATE.OPERATIONS

universeParent :: Data a => a -> [(Maybe a, a)]
universeParent :: a -> [(Maybe a, a)]
universeParent a
x = (Maybe a
forall a. Maybe a
Nothing,a
x) (Maybe a, a) -> [(Maybe a, a)] -> [(Maybe a, a)]
forall a. a -> [a] -> [a]
: a -> [(Maybe a, a)]
forall a. Data a => a -> [(Maybe a, a)]
f a
x
    where
        f :: Data a => a -> [(Maybe a, a)]
        f :: a -> [(Maybe a, a)]
f a
x = [[(Maybe a, a)]] -> [(Maybe a, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(a -> Maybe a
forall a. a -> Maybe a
Just a
x, a
y) (Maybe a, a) -> [(Maybe a, a)] -> [(Maybe a, a)]
forall a. a -> [a] -> [a]
: a -> [(Maybe a, a)]
forall a. Data a => a -> [(Maybe a, a)]
f a
y | a
y <- a -> [a]
forall on. Uniplate on => on -> [on]
children a
x]

universeParentBi :: (Data a, Data b) => a -> [(Maybe b, b)]
universeParentBi :: a -> [(Maybe b, b)]
universeParentBi = (b -> [(Maybe b, b)]) -> [b] -> [(Maybe b, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap b -> [(Maybe b, b)]
forall a. Data a => a -> [(Maybe a, a)]
universeParent ([b] -> [(Maybe b, b)]) -> (a -> [b]) -> a -> [(Maybe b, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [b]
forall from to. Biplate from to => from -> [to]
childrenBi


---------------------------------------------------------------------
-- SYSTEM.FILEPATTERN

-- | Returns true if the pattern matches the string. For example:
--
-- >>> let isSpec = wildcardMatch "**.*Spec"
-- >>> isSpec "Example"
-- False
-- >>> isSpec "ExampleSpec"
-- True
-- >>> isSpec "Namespaced.ExampleSpec"
-- True
-- >>> isSpec "Deeply.Nested.ExampleSpec"
-- True
--
-- See this issue for details: <https://github.com/ndmitchell/hlint/issues/402>.
wildcardMatch :: FilePattern -> String -> Bool
wildcardMatch :: String -> String -> Bool
wildcardMatch String
p String
m = let f :: String -> String
f = String -> String -> String -> String
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace String
"." String
"/" in String -> String
f String
p String -> String -> Bool
?== String -> String
f String
m