    {-|
      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 :: forall a. 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 :: forall ann a. HasCallStack => 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 :: forall ann a. 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 ann. 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 :: forall ann. HasCallStack => 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 ann. 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 :: forall ann a.
    HasCallStack =>
    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 ann. 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 ann. 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 ann. 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 :: forall ann a. 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 ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    str)

    pprTraceDebug
      :: String -> Doc ann -> a -> a
    pprTraceDebug :: forall ann a. 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 :: forall a ann. (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 a. a -> StateT Int m a
    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
    forall (m :: Type -> Type). Quote m => Lit -> m 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 :: forall s (m :: Type -> Type) k v.
    (MonadState s m, Hashable k, Eq k) =>
    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 a. a -> m a
    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 a. a -> m a
    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 :: forall s (m :: Type -> Type) k v.
    (MonadState s m, Uniquable k) =>
    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 a. a -> m a
    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 a. a -> m a
    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 :: forall s (m :: Type -> Type) k v.
    (MonadState s m, Uniquable k) =>
    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 a. a -> m a
    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 a. a -> m a
    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' :: forall a. HasCallStack => 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 :: forall a. HasCallStack => 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 :: forall a. Typeable a => 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) = forall a. Integral a => a -> a -> (a, a)
    divMod @Integer (NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor NominalDiffTime
    diff) (NominalDiffTime -> Integer
    forall b. Integral b => NominalDiffTime -> b
    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 :: forall a. [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 = MaybeT . pure
    #endif