-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-orphans #-}

module Morley.Util.TypeTuple.Instances () where

import Data.Vinyl.Core (Rec(..))

import Morley.Util.TypeTuple.Class
import Morley.Util.TypeTuple.TH

-- $setup
-- >>> import Morley.Util.TypeTuple.Class
-- >>> import Data.Vinyl.Core (Rec(..))

concatMapM deriveRecFromTuple (0 : [2..25])
-- ↑ We skip 1-ary tuple because it is GHC.Tuple.Unit, and we don't want it.

instance RecFromTuple (Rec f '[a]) where
  type IsoRecTuple (Rec f '[a]) = f a
  recFromTuple :: IsoRecTuple (Rec f '[a]) -> Rec f '[a]
recFromTuple IsoRecTuple (Rec f '[a])
a = f a
IsoRecTuple (Rec f '[a])
a f a -> Rec f '[] -> Rec f '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec f '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
  tupleFromRec :: Rec f '[a] -> IsoRecTuple (Rec f '[a])
tupleFromRec (f r
a :& Rec f rs
RNil) = f r
IsoRecTuple (Rec f '[a])
a

-- $
-- >>> tupleFromRec (recFromTuple (Just 3) :: Rec Maybe '[Int]) == Just 3
-- True
-- >>> tupleFromRec (recFromTuple (Just 3, Just "a", Nothing) :: Rec Maybe '[Int, String, Bool]) == (Just 3, Just "a", Nothing)
-- True