{-|
  Copyright   :  (C) 2012-2016, University of Twente
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Assortment of utility function used in the Clash library
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Clash.Util
  ( module Clash.Util
  , SrcSpan
  , noSrcSpan
#if MIN_VERSION_transformers(0,6,0)
  , hoistMaybe
#endif
  )
where

import qualified Control.Exception    as Exception
import Control.Lens
import Control.Monad.State            (MonadState,StateT)
import qualified Control.Monad.State  as State
#if MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.Maybe      (hoistMaybe)
#else
import Control.Monad.Trans.Maybe      (MaybeT (..))
#endif
import Data.Hashable                  (Hashable)
import Data.HashMap.Lazy              (HashMap)
import qualified Data.HashMap.Lazy    as HashMapL
import qualified Data.List.Extra      as List
import Data.Maybe                     (fromMaybe, listToMaybe, catMaybes)
import Data.Map.Ordered               (OMap)
import qualified Data.Map.Ordered     as OMap

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Render.String
#else
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.String
#endif

import Data.Time.Clock                (UTCTime)
import qualified Data.Time.Clock      as Clock
import qualified Data.Time.Format     as Clock
import Data.Typeable                  (Typeable)
import Data.Version                   (Version)
import GHC.Base                       (Int(..),isTrue#,(==#),(+#))
import GHC.Integer.Logarithms         (integerLogBase#)
import qualified GHC.LanguageExtensions.Type as LangExt
import GHC.Stack                      (HasCallStack, callStack, prettyCallStack)
import Type.Reflection                (tyConPackage, typeRepTyCon, typeOf)
import qualified Language.Haskell.TH  as TH

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.SrcLoc               (SrcSpan, noSrcSpan)
#else
import SrcLoc                         (SrcSpan, noSrcSpan)
#endif

import Clash.Data.UniqMap (UniqMap)
import qualified Clash.Data.UniqMap as UniqMap
import Clash.Debug
import Clash.Unique

#ifdef CABAL
import qualified Paths_clash_lib      (version)
#endif

{- $setup
>>> :m -Prelude
>>> import Clash.Prelude
-}

data ClashException = ClashException SrcSpan String (Maybe String)

instance Show ClashException where
  show :: ClashException -> String
show (ClashException SrcSpan
_ String
s Maybe String
eM) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ShowS
forall a. a -> a
id Maybe String
eM

instance Exception.Exception ClashException

assertPanic
  :: String -> Int -> a
assertPanic :: String -> Int -> a
assertPanic String
file Int
ln = ClashException -> a
forall a e. Exception e => e -> a
Exception.throw
  (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
noSrcSpan (String
"ASSERT failed! file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ln) Maybe String
forall a. Maybe a
Nothing)

assertPprPanic
  :: HasCallStack => String -> Int -> Doc ann -> a
assertPprPanic :: String -> Int -> Doc ann -> a
assertPprPanic String
_file Int
_line Doc ann
msg = String -> Doc ann -> a
forall ann a. String -> Doc ann -> a
pprPanic String
"ASSERT failed!" Doc ann
doc
 where
  doc :: Doc ann
doc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep [ Doc ann
msg, Doc ann
forall ann. HasCallStack => Doc ann
callStackDoc ]

pprPanic
  :: String -> Doc ann -> a
pprPanic :: String -> Doc ann -> a
pprPanic String
heading Doc ann
prettyMsg = ClashException -> a
forall a e. Exception e => e -> a
Exception.throw
  (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
noSrcSpan (SimpleDocStream ann -> String
forall ann. SimpleDocStream ann -> String
renderString (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc ann
doc)) Maybe String
forall a. Maybe a
Nothing)
 where
  doc :: Doc ann
doc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep [String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
heading, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 Doc ann
prettyMsg]

callStackDoc
  :: HasCallStack => Doc ann
callStackDoc :: Doc ann
callStackDoc =
  Doc ann
"Call stack:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
4
    ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> [String]
lines (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack))))

warnPprTrace
  :: HasCallStack
  => Bool
  -- ^ Trigger warning?
  -> String
  -- ^ File name
  -> Int
  -- ^ Line number
  -> Doc ann
  -- ^ Message
  -> a
  -- ^ Pass value (like trace)
  -> a
warnPprTrace :: Bool -> String -> Int -> Doc ann -> a -> a
warnPprTrace Bool
_     String
_ Int
_ Doc ann
_ a
x | Bool -> Bool
not Bool
debugIsOn = a
x
warnPprTrace Bool
False String
_ Int
_ Doc ann
_ a
x = a
x
warnPprTrace Bool
True  String
file Int
ln Doc ann
msg a
x =
  (String -> a -> a) -> Doc ann -> Doc ann -> a -> a
forall a ann. (String -> a) -> Doc ann -> Doc ann -> a
pprDebugAndThen String -> a -> a
forall a. String -> a -> a
trace ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [Doc ann
forall ann. Doc ann
heading0, Doc ann
forall ann. Doc ann
heading1]) Doc ann
msg a
x
 where
  heading0 :: Doc ann
heading0 = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann
"WARNING: file", String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
file Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma, Doc ann
"line", Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
ln]
  heading1 :: Doc ann
heading1 = Doc ann
"WARNING CALLSTACK:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)

pprTrace
  :: String -> Doc ann -> a -> a
pprTrace :: String -> Doc ann -> a -> a
pprTrace String
str = (String -> a -> a) -> Doc ann -> Doc ann -> a -> a
forall a ann. (String -> a) -> Doc ann -> Doc ann -> a
pprDebugAndThen String -> a -> a
forall a. String -> a -> a
trace (String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
str)

pprTraceDebug
  :: String -> Doc ann -> a -> a
pprTraceDebug :: String -> Doc ann -> a -> a
pprTraceDebug String
str Doc ann
doc a
x
  | Bool
debugIsOn = String -> Doc ann -> a -> a
forall ann a. String -> Doc ann -> a -> a
pprTrace String
str Doc ann
doc a
x
  | Bool
otherwise = a
x

pprDebugAndThen
  :: (String -> a) -> Doc ann -> Doc ann -> a
pprDebugAndThen :: (String -> a) -> Doc ann -> Doc ann -> a
pprDebugAndThen String -> a
cont Doc ann
heading Doc ann
prettyMsg =
  String -> a
cont (SimpleDocStream ann -> String
forall ann. SimpleDocStream ann -> String
renderString (LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc ann
doc))
 where
  doc :: Doc ann
doc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep [Doc ann
heading, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 Doc ann
prettyMsg]

-- | A class that can generate unique numbers
class Monad m => MonadUnique m where
  -- | Get a new unique
  getUniqueM :: m Int

instance Monad m => MonadUnique (StateT Int m) where
  getUniqueM :: StateT Int m Int
getUniqueM = do
    Int
supply <- StateT Int m Int
forall s (m :: Type -> Type). MonadState s m => m s
State.get
    (Int -> Int) -> StateT Int m ()
forall s (m :: Type -> Type). MonadState s m => (s -> s) -> m ()
State.modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Int -> StateT Int m Int
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
supply

-- | Create a TH expression that returns the a formatted string containing the
-- name of the module 'curLoc' is spliced into, and the line where it was spliced.
curLoc :: TH.Q TH.Exp
curLoc :: Q Exp
curLoc = do
  (TH.Loc String
_ String
_ String
modName (Int
startPosL,Int
_) (Int, Int)
_) <- Q Loc
TH.location
  Lit -> Q Exp
TH.litE (String -> Lit
TH.StringL (String -> Lit) -> String -> Lit
forall a b. (a -> b) -> a -> b
$ String
modName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
startPosL String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): ")

-- | Cache the result of a monadic action
makeCached :: (MonadState s m, Hashable k, Eq k)
           => k -- ^ The key the action is associated with
           -> Lens' s (HashMap k v) -- ^ The Lens to the HashMap that is the cache
           -> m v -- ^ The action to cache
           -> m v
makeCached :: k -> Lens' s (HashMap k v) -> m v -> m v
makeCached k
key Lens' s (HashMap k v)
l m v
create = do
  HashMap k v
cache <- Getting (HashMap k v) s (HashMap k v) -> m (HashMap k v)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (HashMap k v) s (HashMap k v)
Lens' s (HashMap k v)
l
  case k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMapL.lookup k
key HashMap k v
cache of
    Just v
value -> v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value
    Maybe v
Nothing -> do
      v
value <- m v
create
      (HashMap k v -> Identity (HashMap k v)) -> s -> Identity s
Lens' s (HashMap k v)
l ((HashMap k v -> Identity (HashMap k v)) -> s -> Identity s)
-> (HashMap k v -> HashMap k v) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMapL.insert k
key v
value
      v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value

-- | Cache the result of a monadic action using a 'UniqMap'
makeCachedU
  :: (MonadState s m, Uniquable k)
  => k
  -- ^ Key the action is associated with
  -> Lens' s (UniqMap v)
  -- ^ Lens to the cache
  -> m v
  -- ^ Action to cache
  -> m v
makeCachedU :: k -> Lens' s (UniqMap v) -> m v -> m v
makeCachedU k
key Lens' s (UniqMap v)
l m v
create = do
  UniqMap v
cache <- Getting (UniqMap v) s (UniqMap v) -> m (UniqMap v)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (UniqMap v) s (UniqMap v)
Lens' s (UniqMap v)
l
  case k -> UniqMap v -> Maybe v
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup k
key UniqMap v
cache of
    Just v
value -> v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value
    Maybe v
Nothing -> do
      v
value <- m v
create
      (UniqMap v -> Identity (UniqMap v)) -> s -> Identity s
Lens' s (UniqMap v)
l ((UniqMap v -> Identity (UniqMap v)) -> s -> Identity s)
-> (UniqMap v -> UniqMap v) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= k -> v -> UniqMap v -> UniqMap v
forall a b. Uniquable a => a -> b -> UniqMap b -> UniqMap b
UniqMap.insert k
key v
value
      v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value

-- | Cache the result of a monadic action using a 'OMap'
makeCachedO
  :: (MonadState s m, Uniquable k)
  => k
  -- ^ Key the action is associated with
  -> Lens' s (OMap Unique v)
  -- ^ Lens to the cache
  -> m v
  -- ^ Action to cache
  -> m v
makeCachedO :: k -> Lens' s (OMap Int v) -> m v -> m v
makeCachedO k
key Lens' s (OMap Int v)
l m v
create = do
  OMap Int v
cache <- Getting (OMap Int v) s (OMap Int v) -> m (OMap Int v)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting (OMap Int v) s (OMap Int v)
Lens' s (OMap Int v)
l
  case Int -> OMap Int v -> Maybe v
forall k v. Ord k => k -> OMap k v -> Maybe v
OMap.lookup (k -> Int
forall a. Uniquable a => a -> Int
getUnique k
key) OMap Int v
cache of
    Just v
value -> v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value
    Maybe v
Nothing -> do
      v
value <- m v
create
      (OMap Int v -> Identity (OMap Int v)) -> s -> Identity s
Lens' s (OMap Int v)
l ((OMap Int v -> Identity (OMap Int v)) -> s -> Identity s)
-> (OMap Int v -> OMap Int v) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((OMap Int v -> (Int, v) -> OMap Int v)
-> (Int, v) -> OMap Int v -> OMap Int v
forall a b c. (a -> b -> c) -> b -> a -> c
flip OMap Int v -> (Int, v) -> OMap Int v
forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
(OMap.|>)) (k -> Int
forall a. Uniquable a => a -> Int
getUnique k
key, v
value)
      v -> m v
forall (m :: Type -> Type) a. Monad m => a -> m a
return v
value

-- | Same as 'indexNote' with last two arguments swapped
indexNote'
  :: HasCallStack
  => String
  -- ^ Error message to display
  -> Int
  -- ^ Index /n/
  -> [a]
  -- ^ List to index
  -> a
  -- ^ Error or element /n/
indexNote' :: String -> Int -> [a] -> a
indexNote' = ([a] -> Int -> a) -> Int -> [a] -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([a] -> Int -> a) -> Int -> [a] -> a)
-> (String -> [a] -> Int -> a) -> String -> Int -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [a] -> Int -> a
forall a. HasCallStack => String -> [a] -> Int -> a
indexNote

-- | Unsafe indexing, return a custom error message when indexing fails
indexNote
  :: HasCallStack
  => String
  -- ^ Error message to display
  -> [a]
  -- ^ List to index
  -> Int
  -- ^ Index /n/
  -> a
  -- ^ Error or element /n/
indexNote :: String -> [a] -> Int -> a
indexNote String
note = \[a]
xs Int
i -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
note) ([a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
List.indexMaybe [a]
xs Int
i)

clashLibVersion :: Version
#ifdef CABAL
clashLibVersion :: Version
clashLibVersion = Version
Paths_clash_lib.version
#else
clashLibVersion = error "development version"
#endif

-- | \x y -> floor (logBase x y), x > 1 && y > 0
flogBase :: Integer -> Integer -> Maybe Int
flogBase :: Integer -> Integer -> Maybe Int
flogBase Integer
x Integer
y | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# (Integer -> Integer -> Int#
integerLogBase# Integer
x Integer
y))
flogBase Integer
_ Integer
_ = Maybe Int
forall a. Maybe a
Nothing

-- | \x y -> ceiling (logBase x y), x > 1 && y > 0
clogBase :: Integer -> Integer -> Maybe Int
clogBase :: Integer -> Integer -> Maybe Int
clogBase Integer
x Integer
y | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 =
  case Integer
y of
    Integer
1 -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    Integer
_ -> let z1 :: Int#
z1 = Integer -> Integer -> Int#
integerLogBase# Integer
x Integer
y
             z2 :: Int#
z2 = Integer -> Integer -> Int#
integerLogBase# Integer
x (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
         in  if Int# -> Bool
isTrue# (Int#
z1 Int# -> Int# -> Int#
==# Int#
z2)
                then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# (Int#
z1 Int# -> Int# -> Int#
+# Int#
1#))
                else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int# -> Int
I# Int#
z1)
clogBase Integer
_ Integer
_ = Maybe Int
forall a. Maybe a
Nothing

-- | Get the package id of the type of a value
--
-- >>> pkgIdFromTypeable (0 :: Unsigned 32)
-- "clash-prelude-...
--
pkgIdFromTypeable :: Typeable a => a -> String
pkgIdFromTypeable :: a -> String
pkgIdFromTypeable = TyCon -> String
tyConPackage (TyCon -> String) -> (a -> TyCon) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep a -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (TypeRep a -> TyCon) -> (a -> TypeRep a) -> a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf

reportTimeDiff :: UTCTime -> UTCTime -> String
reportTimeDiff :: UTCTime -> UTCTime -> String
reportTimeDiff UTCTime
end UTCTime
start
  | NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
Clock.nominalDay = Integer -> String
forall a. Show a => a -> String
show Integer
days String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"d" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Clock.formatTime TimeLocale
Clock.defaultTimeLocale String
fmt
    (Day -> DiffTime -> UTCTime
Clock.UTCTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) (Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
hms)))
  | Bool
otherwise = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Clock.formatTime TimeLocale
Clock.defaultTimeLocale String
fmt
    (Day -> DiffTime -> UTCTime
Clock.UTCTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) (Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
diff)))
 where
  diff :: NominalDiffTime
diff = UTCTime -> UTCTime -> NominalDiffTime
Clock.diffUTCTime UTCTime
end UTCTime
start
  (Integer
days,Integer
hms) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod @Integer (NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor NominalDiffTime
diff) (NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor NominalDiffTime
Clock.nominalDay)
  fmt :: String
fmt  | NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
3600
       = String
"%-Hh%-Mm%-Ss"
       | NominalDiffTime
diff NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
60
       = String
"%-Mm%-Ss"
       | Bool
otherwise
       = String
"%-S%03Qs"

-- | Left-biased choice on maybes
orElses :: [Maybe a] -> Maybe a
orElses :: [Maybe a] -> Maybe a
orElses = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([Maybe a] -> [a]) -> [Maybe a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes

-- These language extensions are used for
--  * the interactive session inside clashi
--  * compiling files with clash
--  * running output tests with runghc
--  * compiling (local) Template/Blackbox functions with Hint
--
-- When changing this list please update docs/developing-hardware/language.rst
wantedLanguageExtensions :: [LangExt.Extension]
wantedLanguageExtensions :: [Extension]
wantedLanguageExtensions =
  [ Extension
LangExt.BinaryLiterals
  , Extension
LangExt.ConstraintKinds
  , Extension
LangExt.DataKinds
  , Extension
LangExt.DeriveAnyClass
  , Extension
LangExt.DeriveGeneric
  , Extension
LangExt.DeriveLift
  , Extension
LangExt.DerivingStrategies
  , Extension
LangExt.ExplicitForAll
  , Extension
LangExt.ExplicitNamespaces
  , Extension
LangExt.FlexibleContexts
  , Extension
LangExt.FlexibleInstances
  , Extension
LangExt.KindSignatures
  , Extension
LangExt.MagicHash
  , Extension
LangExt.MonoLocalBinds
  , Extension
LangExt.NumericUnderscores
  , Extension
LangExt.QuasiQuotes
  , Extension
LangExt.ScopedTypeVariables
  , Extension
LangExt.TemplateHaskell
  , Extension
LangExt.TemplateHaskellQuotes
  , Extension
LangExt.TypeApplications
  , Extension
LangExt.TypeFamilies
  , Extension
LangExt.TypeOperators
  ]

unwantedLanguageExtensions :: [LangExt.Extension]
unwantedLanguageExtensions :: [Extension]
unwantedLanguageExtensions =
  [ Extension
LangExt.ImplicitPrelude
  , Extension
LangExt.StarIsType
  , Extension
LangExt.Strict
  , Extension
LangExt.StrictData
  ]

thenCompare :: Ordering -> Ordering -> Ordering
thenCompare :: Ordering -> Ordering -> Ordering
thenCompare Ordering
EQ Ordering
rel = Ordering
rel
thenCompare Ordering
rel Ordering
_  = Ordering
rel

#if !MIN_VERSION_transformers(0,6,0)
hoistMaybe :: (Applicative m) => Maybe b -> MaybeT m b
hoistMaybe :: Maybe b -> MaybeT m b
hoistMaybe = m (Maybe b) -> MaybeT m b
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b)
-> (Maybe b -> m (Maybe b)) -> Maybe b -> MaybeT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> m (Maybe b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
#endif