{-|
A convenience class for retrieving the first field of any constructor in a
datatype.

The primary usage for this class is generic derivation:

    data D a = D a () String deriving Generic
    instance FirstParameter (D a) a

Note that _the deriver does not check you are requesting a valid/safe instance._
Invalid instances propagate the error to runtime. Fixing this requires a lot
more type-level work. (The generic-lens library has a general solution, but it's
slow and memory-consuming.)
-}

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FunctionalDependencies #-}

module Language.Fortran.Util.FirstParameter(FirstParameter(..), GFirstParameter(..)) where

import GHC.Generics

class FirstParameter a e | a -> e where
  getFirstParameter :: a -> e
  setFirstParameter :: e -> a -> a

  default getFirstParameter :: (Generic a, GFirstParameter (Rep a) e) => a -> e
  getFirstParameter = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
f a -> e
getFirstParameter' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

  default setFirstParameter :: (Generic a, GFirstParameter (Rep a) e) => e -> a -> a
  setFirstParameter e
e = forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
e -> f a -> f a
setFirstParameter' e
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

class GFirstParameter f e where
  getFirstParameter' :: f a -> e
  setFirstParameter' :: e -> f a -> f a

instance {-# OVERLAPPING #-} GFirstParameter (K1 i e) e where
  getFirstParameter' :: forall (a :: k). K1 i e a -> e
getFirstParameter' (K1 e
a) = e
a
  setFirstParameter' :: forall (a :: k). e -> K1 i e a -> K1 i e a
setFirstParameter' e
e (K1 e
_)  = forall k i c (p :: k). c -> K1 i c p
K1 e
e

instance {-# OVERLAPPABLE #-} GFirstParameter (K1 i a) e where
  getFirstParameter' :: forall (a :: k). K1 i a a -> e
getFirstParameter' K1 i a a
_ = forall a. HasCallStack => a
undefined
  setFirstParameter' :: forall (a :: k). e -> K1 i a a -> K1 i a a
setFirstParameter' e
_ K1 i a a
_ = forall a. HasCallStack => a
undefined

instance GFirstParameter a e => GFirstParameter (M1 i c a) e where
  getFirstParameter' :: forall (a :: k). M1 i c a a -> e
getFirstParameter' (M1 a a
a) = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
f a -> e
getFirstParameter' a a
a
  setFirstParameter' :: forall (a :: k). e -> M1 i c a a -> M1 i c a a
setFirstParameter' e
e (M1 a a
a) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
e -> f a -> f a
setFirstParameter' e
e a a
a

instance (GFirstParameter a e, GFirstParameter b e) => GFirstParameter (a :+: b) e where
  getFirstParameter' :: forall (a :: k). (:+:) a b a -> e
getFirstParameter' (L1 a a
a) = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
f a -> e
getFirstParameter' a a
a
  getFirstParameter' (R1 b a
a) = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
f a -> e
getFirstParameter' b a
a

  setFirstParameter' :: forall (a :: k). e -> (:+:) a b a -> (:+:) a b a
setFirstParameter' e
e (L1 a a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
e -> f a -> f a
setFirstParameter' e
e a a
a
  setFirstParameter' e
e (R1 b a
a) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
e -> f a -> f a
setFirstParameter' e
e b a
a

instance (GFirstParameter a e, GFirstParameter b e) => GFirstParameter (a :*: b) e where
  getFirstParameter' :: forall (a :: k). (:*:) a b a -> e
getFirstParameter' (a a
a :*: b a
_) = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
f a -> e
getFirstParameter' a a
a
  setFirstParameter' :: forall (a :: k). e -> (:*:) a b a -> (:*:) a b a
setFirstParameter' e
e (a a
a :*: b a
b) = forall {k} (f :: k -> *) e (a :: k).
GFirstParameter f e =>
e -> f a -> f a
setFirstParameter' e
e a a
a forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b

instance (GFirstParameter U1 String) where
  getFirstParameter' :: forall (a :: k). U1 a -> String
getFirstParameter' U1 a
_ = String
""
  setFirstParameter' :: forall (a :: k). String -> U1 a -> U1 a
setFirstParameter' String
_ U1 a
e = U1 a
e