{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds         #-}
{-# LANGUAGE TypeFamilies      #-}

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

-- | Orphan instances for external types/classes.

module Cardano.Prelude.Orphans
  ()
where

import           Cardano.Prelude.Base
import           Data.Tagged          (Tagged (Tagged))
import           Formatting.Buildable (Buildable (..))

import qualified Formatting           as F

--------------------------------------------------------------------------------
-- Buildable
--------------------------------------------------------------------------------

-- | This orphan instance is sometimes useful and why not have it?
instance Buildable () where
  build :: () -> Builder
build ()
_ = Builder
"()"

instance (Typeable s, Buildable a) => Buildable (Tagged s a) where
  build :: Tagged s a -> Builder
build tt :: Tagged s a
tt@(Tagged a
v) = Format Builder (TypeRep -> a -> Builder) -> TypeRep -> a -> Builder
forall a. Format Builder a -> a
F.bprint
    (Format (TypeRep -> a -> Builder) (TypeRep -> a -> Builder)
"Tagged " Format (TypeRep -> a -> Builder) (TypeRep -> a -> Builder)
-> Format Builder (TypeRep -> a -> Builder)
-> Format Builder (TypeRep -> a -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
F.% Format (a -> Builder) (TypeRep -> a -> Builder)
forall a r. Show a => Format r (a -> r)
F.shown Format (a -> Builder) (TypeRep -> a -> Builder)
-> Format Builder (a -> Builder)
-> Format Builder (TypeRep -> a -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
F.% Format (a -> Builder) (a -> Builder)
" " Format (a -> Builder) (a -> Builder)
-> Format Builder (a -> Builder) -> Format Builder (a -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
F.% Format Builder (a -> Builder)
forall a r. Buildable a => Format r (a -> r)
F.build)
    TypeRep
ts
    a
v
   where
    ts :: TypeRep
ts    = Proxy s -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy s
proxy
    proxy :: Proxy s
proxy = (Proxy s -> Tagged s a -> Proxy s
forall a b. a -> b -> a
const Proxy s
forall k (t :: k). Proxy t
Proxy :: Tagged s a -> Proxy s) Tagged s a
tt