{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
module Util(
defaultExtensions,
gzip, universeParentBi,
exitMessage, exitMessageImpure
) where
import Data.List
import System.Exit
import System.IO
import System.IO.Unsafe
import Unsafe.Coerce
import Data.Data
import Data.Generics.Uniplate.Operations
import Language.Haskell.Exts.Extension
exitMessage :: String -> IO a
exitMessage msg = do
hPutStrLn stderr msg
exitWith $ ExitFailure 1
exitMessageImpure :: String -> a
exitMessageImpure = unsafePerformIO . exitMessage
data Box = forall a . Data a => Box a
gzip :: Data a => (forall b . Data b => b -> b -> c) -> a -> a -> Maybe [c]
gzip f x y | toConstr x /= toConstr y = Nothing
| otherwise = Just $ zipWith op (gmapQ Box x) (gmapQ Box y)
where op (Box x) (Box y) = f x (unsafeCoerce y)
universeParent :: Uniplate a => a -> [(Maybe a, a)]
universeParent x = (Nothing,x) : f x
where
f :: Uniplate a => a -> [(Maybe a, a)]
f x = concat [(Just x, y) : f y | y <- children x]
universeParentBi :: Biplate a b => a -> [(Maybe b, b)]
universeParentBi = concatMap universeParent . childrenBi
defaultExtensions :: [Extension]
defaultExtensions = [e | e@EnableExtension{} <- knownExtensions] \\ map EnableExtension badExtensions
badExtensions =
[Arrows
,TransformListComp
,XmlSyntax, RegularPatterns
,UnboxedTuples, UnboxedSums
,QuasiQuotes
,DoRec, RecursiveDo
,TypeApplications
]