-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Missing instances from libraries.
module Util.Instances () where

import Data.Default (Default(..))
import Data.Vinyl (Dict(..), Rec(..), ReifyConstraint(reifyConstraint))
import Data.Vinyl.Functor as Vinyl (Compose(..), (:.))
import Fmt (Buildable(..))

instance Default Natural where
  def :: Natural
def = Natural
0

instance Buildable Natural where
  build :: Natural -> Builder
build = Buildable Integer => Integer -> Builder
forall p. Buildable p => p -> Builder
build @Integer (Integer -> Builder) -> (Natural -> Integer) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Buildable a => (Buildable (Identity a)) where
  build :: Identity a -> Builder
build (Identity a
x) = a -> Builder
forall p. Buildable p => p -> Builder
build a
x

-- I've added this orphan instance to @vinyl@,
-- so we'll be able to delete it in the future.
-- https://github.com/VinylRecords/Vinyl/pull/149
instance ReifyConstraint NFData f xs => NFData (Rec f xs) where
  rnf :: Rec f xs -> ()
rnf = Rec (Dict NFData :. f) xs -> ()
forall (elems :: [u]). Rec (Dict NFData :. f) elems -> ()
go (Rec (Dict NFData :. f) xs -> ())
-> (Rec f xs -> Rec (Dict NFData :. f) xs) -> Rec f xs -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u (c :: * -> Constraint) (f :: u -> *) (rs :: [u]).
ReifyConstraint c f rs =>
Rec f rs -> Rec (Dict c :. f) rs
forall (f :: u -> *) (rs :: [u]).
ReifyConstraint NFData f rs =>
Rec f rs -> Rec (Dict NFData :. f) rs
reifyConstraint @NFData
    where
      go :: forall elems. Rec (Dict NFData :. f) elems -> ()
      go :: Rec (Dict NFData :. f) elems -> ()
go Rec (Dict NFData :. f) elems
RNil = ()
      go (Vinyl.Compose (Dict f r
x) :& Rec (Dict NFData :. f) rs
xs) = f r -> ()
forall a. NFData a => a -> ()
rnf f r
x () -> () -> ()
`seq` Rec (Dict NFData :. f) rs -> ()
forall (elems :: [u]). Rec (Dict NFData :. f) elems -> ()
go Rec (Dict NFData :. f) rs
xs