285 lines
6.6 KiB
Haskell
285 lines
6.6 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Language.Haskell.Brittany.Internal.Prelude
|
|
( module E
|
|
, module Language.Haskell.Brittany.Internal.Prelude
|
|
) where
|
|
|
|
import Control.Applicative as E (Alternative(..), Applicative(..))
|
|
import Control.Arrow as E ((&&&), (***), (<<<), (>>>), first, second)
|
|
import Control.Concurrent as E (forkIO, forkOS, threadDelay)
|
|
import Control.Concurrent.Chan as E (Chan)
|
|
import Control.Concurrent.MVar as E
|
|
(MVar, newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, takeMVar)
|
|
import Control.Exception as E (assert, bracket, evaluate)
|
|
import Control.Monad as E
|
|
( (<$!>)
|
|
, (<=<)
|
|
, (=<<)
|
|
, (>=>)
|
|
, Functor(..)
|
|
, Monad(..)
|
|
, MonadPlus(..)
|
|
, filterM
|
|
, forM
|
|
, forM_
|
|
, forever
|
|
, guard
|
|
, join
|
|
, liftM
|
|
, liftM2
|
|
, liftM3
|
|
, liftM4
|
|
, liftM5
|
|
, mapM
|
|
, mapM_
|
|
, replicateM
|
|
, replicateM_
|
|
, sequence
|
|
, sequence_
|
|
, unless
|
|
, void
|
|
, when
|
|
)
|
|
import Control.Monad.Extra as E
|
|
(allM, andM, anyM, ifM, notM, orM, unlessM, whenM)
|
|
import Control.Monad.IO.Class as E (MonadIO(..))
|
|
import Control.Monad.ST as E (ST)
|
|
import Control.Monad.Trans.Class as E (lift)
|
|
import Control.Monad.Trans.Maybe as E (MaybeT(..))
|
|
import Control.Monad.Trans.MultiRWS as E
|
|
(MonadMultiReader(..), MonadMultiState(..), MonadMultiWriter(..), mGet)
|
|
import Data.Bifunctor as E (bimap)
|
|
import Data.Bool as E (Bool(..))
|
|
import Data.Char as E (Char, chr, ord)
|
|
import Data.Data as E (toConstr)
|
|
import Data.Either as E (Either(..), either)
|
|
import Data.Foldable as E (asum, fold, foldl', foldr')
|
|
import Data.Function as E ((&), fix)
|
|
import Data.Functor as E (($>))
|
|
import Data.Functor.Identity as E (Identity(..))
|
|
import Data.IORef as E (IORef)
|
|
import Data.Int as E (Int)
|
|
import Data.List as E
|
|
( all
|
|
, break
|
|
, drop
|
|
, dropWhile
|
|
, elem
|
|
, filter
|
|
, find
|
|
, intercalate
|
|
, intersperse
|
|
, isPrefixOf
|
|
, isSuffixOf
|
|
, iterate
|
|
, length
|
|
, mapAccumL
|
|
, mapAccumR
|
|
, maximum
|
|
, minimum
|
|
, null
|
|
, partition
|
|
, repeat
|
|
, replicate
|
|
, sortBy
|
|
, sum
|
|
, take
|
|
, takeWhile
|
|
, transpose
|
|
, uncons
|
|
, unzip
|
|
, zip
|
|
, zip3
|
|
, zipWith
|
|
)
|
|
import Data.List.Extra as E (nubOrd, stripSuffix)
|
|
import Data.List.NonEmpty as E (NonEmpty(..), nonEmpty)
|
|
import Data.Map as E (Map)
|
|
import Data.Maybe as E
|
|
(Maybe(..), catMaybes, fromMaybe, listToMaybe, maybe, maybeToList)
|
|
import Data.Monoid as E
|
|
( All(..)
|
|
, Alt(..)
|
|
, Any(..)
|
|
, Endo(..)
|
|
, Monoid(..)
|
|
, Product(..)
|
|
, Sum(..)
|
|
, mconcat
|
|
)
|
|
import Data.Ord as E (Down(..), Ordering(..), comparing)
|
|
import Data.Proxy as E (Proxy(..))
|
|
import Data.Ratio as E ((%), Ratio, Rational, denominator, numerator)
|
|
import Data.Semigroup as E ((<>), Semigroup(..), Last(Last))
|
|
import Data.Sequence as E (Seq)
|
|
import Data.Set as E (Set)
|
|
import Data.String as E (String)
|
|
import Data.Text as E (Text)
|
|
import Data.Tree as E (Tree(..))
|
|
import Data.Tuple as E (swap)
|
|
import Data.Typeable as E (Typeable)
|
|
import Data.Version as E (showVersion)
|
|
import Data.Void as E (Void)
|
|
import Data.Word as E (Word, Word32)
|
|
import Debug.Trace as E
|
|
( trace
|
|
, traceIO
|
|
, traceId
|
|
, traceM
|
|
, traceShow
|
|
, traceShowId
|
|
, traceShowM
|
|
, traceStack
|
|
)
|
|
import Foreign.ForeignPtr as E (ForeignPtr)
|
|
import Foreign.Storable as E (Storable)
|
|
import GHC.Exts as E (Constraint)
|
|
import GHC.Hs.Extension as E (GhcPs)
|
|
import GHC.Stack as E (HasCallStack)
|
|
import GHC.Types.Name.Reader as E (RdrName)
|
|
import Prelude as E
|
|
( ($)
|
|
, ($!)
|
|
, (&&)
|
|
, (++)
|
|
, (.)
|
|
, (<$>)
|
|
, Double
|
|
, Enum(..)
|
|
, Eq(..)
|
|
, Float
|
|
, Floating(..)
|
|
, Foldable
|
|
, Fractional(..)
|
|
, Integer
|
|
, Integral(..)
|
|
, Num(..)
|
|
, Ord(..)
|
|
, RealFloat(..)
|
|
, RealFrac(..)
|
|
, Show(..)
|
|
, Traversable
|
|
, (^)
|
|
, and
|
|
, any
|
|
, const
|
|
, error
|
|
, flip
|
|
, foldr
|
|
, foldr1
|
|
, fromIntegral
|
|
, fst
|
|
, head
|
|
, id
|
|
, map
|
|
, not
|
|
, or
|
|
, otherwise
|
|
, print
|
|
, putStr
|
|
, putStrLn
|
|
, realToFrac
|
|
, reverse
|
|
, seq
|
|
, snd
|
|
, subtract
|
|
, traverse
|
|
, uncurry
|
|
, undefined
|
|
, (||)
|
|
)
|
|
import System.IO as E (IO, hFlush, stdout)
|
|
import Text.Read as E (readMaybe)
|
|
|
|
import qualified Data.Strict.Maybe as Strict
|
|
import Control.DeepSeq (NFData, force)
|
|
import System.IO (hPutStrLn, stderr, hPutStr)
|
|
import qualified Data.Data
|
|
import GHC.Types.SrcLoc ( RealSrcLoc )
|
|
import qualified GHC.Utils.Misc
|
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
|
import qualified Data.Sequence as Seq
|
|
|
|
|
|
|
|
instance Applicative Strict.Maybe where
|
|
pure = Strict.Just
|
|
Strict.Just f <*> Strict.Just x = Strict.Just (f x)
|
|
_ <*> _ = Strict.Nothing
|
|
|
|
instance Monad Strict.Maybe where
|
|
Strict.Nothing >>= _ = Strict.Nothing
|
|
Strict.Just x >>= f = f x
|
|
|
|
instance Alternative Strict.Maybe where
|
|
empty = Strict.Nothing
|
|
x <|> Strict.Nothing = x
|
|
_ <|> x = x
|
|
|
|
traceFunctionWith
|
|
:: String -> (a -> String) -> (b -> String) -> (a -> b) -> (a -> b)
|
|
traceFunctionWith name s1 s2 f x = trace traceStr y
|
|
where
|
|
y = f x
|
|
traceStr = name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y
|
|
|
|
(<&!>) :: Monad m => m a -> (a -> b) -> m b
|
|
(<&!>) = flip (<$!>)
|
|
|
|
putStrErrLn :: String -> IO ()
|
|
putStrErrLn s = hPutStrLn stderr s
|
|
|
|
putStrErr :: String -> IO ()
|
|
putStrErr s = hPutStr stderr s
|
|
|
|
printErr :: Show a => a -> IO ()
|
|
printErr = putStrErrLn . show
|
|
|
|
errorIf :: Bool -> a -> a
|
|
errorIf False = id
|
|
errorIf True = error "errorIf"
|
|
|
|
errorIfNote :: Maybe String -> a -> a
|
|
errorIfNote Nothing = id
|
|
errorIfNote (Just x) = error x
|
|
|
|
(<&>) :: Functor f => f a -> (a -> b) -> f b
|
|
(<&>) = flip fmap
|
|
infixl 4 <&>
|
|
|
|
(.>) :: (a -> b) -> (b -> c) -> (a -> c)
|
|
f .> g = g . f
|
|
infixl 9 .>
|
|
|
|
evaluateDeep :: NFData a => a -> IO a
|
|
evaluateDeep = evaluate . force
|
|
|
|
instance Data.Data.Data RealSrcLoc where
|
|
-- don't traverse?
|
|
toConstr _ = GHC.Utils.Misc.abstractConstr "RealSrcLoc"
|
|
gunfold _ _ = error "gunfold"
|
|
dataTypeOf _ = GHC.Utils.Misc.mkNoRepType "RealSrcLoc"
|
|
|
|
-- TODO: move to uniplate upstream?
|
|
-- aka `transform`
|
|
transformUp :: Uniplate.Uniplate on => (on -> on) -> (on -> on)
|
|
transformUp f = g where g = f . Uniplate.descend g
|
|
_transformDown :: Uniplate.Uniplate on => (on -> on) -> (on -> on)
|
|
_transformDown f = g where g = Uniplate.descend g . f
|
|
transformDownMay :: Uniplate.Uniplate on => (on -> Maybe on) -> (on -> on)
|
|
transformDownMay f = g where g x = maybe x (Uniplate.descend g) $ f x
|
|
_transformDownRec :: Uniplate.Uniplate on => (on -> Maybe on) -> (on -> on)
|
|
_transformDownRec f = g where g x = maybe (Uniplate.descend g x) g $ f x
|
|
|
|
-- i should really put that into multistate..
|
|
mModify :: MonadMultiState s m => (s -> s) -> m ()
|
|
mModify f = mGet >>= mSet . f
|
|
|
|
tellDebugMess :: MonadMultiWriter (Seq String) m => String -> m ()
|
|
tellDebugMess s = mTell $ Seq.singleton s
|
|
|
|
tellDebugMessShow
|
|
:: forall a m . (MonadMultiWriter (Seq String) m, Show a) => a -> m ()
|
|
tellDebugMessShow = tellDebugMess . show
|