{-# 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, FilePath)
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