content: {-# OPTIONS_HADDOCK not-home #-}
  
  {-# LANGUAGE AllowAmbiguousTypes   #-}
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE FlexibleInstances     #-}
  {-# LANGUAGE GADTs                 #-}
  {-# LANGUAGE KindSignatures        #-}
  {-# LANGUAGE MonoLocalBinds        #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE ScopedTypeVariables   #-}
  {-# LANGUAGE TypeApplications      #-}
  {-# LANGUAGE TypeOperators         #-}
  {-# LANGUAGE UndecidableInstances  #-}
  
  {-|
  Module      : Data.Generic.HKD.Construction
  Description : Convert to and from the generic HKD structure.
  Copyright   : (c) Tom Harding, 2019
  License     : MIT
  Maintainer  : tom.harding@habito.com
  Stability   : experimental
  -}
  module Data.Generic.HKD.Construction
    ( Construct (..)
    ) where
  
  import Data.Generic.HKD.Types (HKD (..), GHKD_)
  import Data.Kind (Type)
  import GHC.Generics
  
  -- | When working with the HKD representation, it is useful to have a way to
  -- convert to and from our original type. To do this, we can:
  --
  -- * @construct@ the original type from our HKD representation, and
  --
  -- * @deconstruct@ the original type /into/ our HKD representation.
  --
  -- As an example, we can try (unsuccessfully) to construct an @(Int, Bool)@
  -- tuple from an unpopulated partial structure.
  -- 
  -- >>> :set -XTypeApplications
  -- >>> import Data.Monoid (Last)
  --
  -- >>> construct (mempty @(HKD (Int, Bool) Last))
  -- Last {getLast = Nothing}
  --
  -- We can also /deconstruct/ a tuple into a partial structure:
  --
  -- >>> deconstruct @[] ("Hello", True)
  -- (,) ["Hello"] [True]
  --
  -- These two methods also satisfy the round-tripping property:
  --
  -- prop> construct (deconstruct x) == [ x :: (Int, Bool, String) ]
  class Construct (f :: Type -> Type) (structure :: Type) where
    construct   :: HKD structure f -> f structure
    deconstruct :: structure -> HKD structure f
  
  class GConstruct (f :: Type -> Type) (rep :: Type -> Type) where
    gconstruct   :: GHKD_ f rep p -> f (rep p)
    gdeconstruct :: rep p -> GHKD_ f rep p
  
  instance (Functor f, GConstruct f inner)
      => GConstruct f (M1 index meta inner) where
    gconstruct   = fmap M1 . gconstruct . unM1
    gdeconstruct = M1 . gdeconstruct @f . unM1
  
  instance (Applicative f, GConstruct f left, GConstruct f right)
      => GConstruct f (left :*: right) where
    gconstruct   (l :*: r) = (:*:) <$> gconstruct      l <*> gconstruct      r
    gdeconstruct (l :*: r) =           gdeconstruct @f l :*: gdeconstruct @f r
  
  instance Applicative f => GConstruct f (K1 index inner) where
    gconstruct (K1 x) = fmap K1 x
    gdeconstruct (K1 x) = K1 (pure x)
  
  instance (Applicative f, Generic structure, GConstruct f (Rep structure))
      => Construct f structure where
    construct   = fmap to . gconstruct . runHKD
    deconstruct = HKD . gdeconstruct @f . from
  