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

module Language.Fortran.Util.SecondParameter(SecondParameter(..)) where

import GHC.Generics

class SecondParameter a e | a -> e where
  getSecondParameter :: a -> e
  setSecondParameter :: e -> a -> a

  default getSecondParameter :: (Generic a, GSecondParameter (Rep a) e) => a -> e
  getSecondParameter = Rep a Any -> e
forall (f :: * -> *) e a. GSecondParameter f e => f a -> e
getSecondParameter' (Rep a Any -> e) -> (a -> Rep a Any) -> a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

  default setSecondParameter :: (Generic a, GSecondParameter (Rep a) e) => e -> a -> a
  setSecondParameter e
e = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (a -> Rep a Any) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Rep a Any -> Rep a Any
forall (f :: * -> *) e a. GSecondParameter f e => e -> f a -> f a
setSecondParameter' e
e (Rep a Any -> Rep a Any) -> (a -> Rep a Any) -> a -> Rep a Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

class GSecondParameter f e where
  getSecondParameter' :: f a -> e
  setSecondParameter' :: e -> f a -> f a

instance GSecondParameter (K1 i a) e where
  getSecondParameter' :: K1 i a a -> e
getSecondParameter' K1 i a a
_ = e
forall a. HasCallStack => a
undefined
  setSecondParameter' :: e -> K1 i a a -> K1 i a a
setSecondParameter' e
_ = K1 i a a -> K1 i a a
forall a. HasCallStack => a
undefined

instance GSecondParameter a e => GSecondParameter (M1 i c a) e where
  getSecondParameter' :: M1 i c a a -> e
getSecondParameter' (M1 a a
x) = a a -> e
forall (f :: * -> *) e a. GSecondParameter f e => f a -> e
getSecondParameter' a a
x
  setSecondParameter' :: e -> M1 i c a a -> M1 i c a a
setSecondParameter' e
e (M1 a a
x) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ e -> a a -> a a
forall (f :: * -> *) e a. GSecondParameter f e => e -> f a -> f a
setSecondParameter' e
e a a
x

instance (GSecondParameter a e, GSecondParameter b e) => GSecondParameter (a :+: b) e where
  getSecondParameter' :: (:+:) a b a -> e
getSecondParameter' (L1 a a
a) = a a -> e
forall (f :: * -> *) e a. GSecondParameter f e => f a -> e
getSecondParameter' a a
a
  getSecondParameter' (R1 b a
a) = b a -> e
forall (f :: * -> *) e a. GSecondParameter f e => f a -> e
getSecondParameter' b a
a

  setSecondParameter' :: e -> (:+:) a b a -> (:+:) a b a
setSecondParameter' e
e (L1 a a
a) = a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> a a -> (:+:) a b a
forall a b. (a -> b) -> a -> b
$ e -> a a -> a a
forall (f :: * -> *) e a. GSecondParameter f e => e -> f a -> f a
setSecondParameter' e
e a a
a
  setSecondParameter' e
e (R1 b a
a) = b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> b a -> (:+:) a b a
forall a b. (a -> b) -> a -> b
$ e -> b a -> b a
forall (f :: * -> *) e a. GSecondParameter f e => e -> f a -> f a
setSecondParameter' e
e b a
a

instance (ParameterLeaf a, GSecondParameter a e, GSecondParameter' b e) => GSecondParameter (a :*: b) e where
  getSecondParameter' :: (:*:) a b a -> e
getSecondParameter' (a a
a :*: b a
b) = 
    if a a -> Bool
forall (f :: * -> *) a. ParameterLeaf f => f a -> Bool
isLeaf a a
a 
    then b a -> e
forall (f :: * -> *) e a. GSecondParameter' f e => f a -> e
getSecondParameter'' b a
b
    else a a -> e
forall (f :: * -> *) e a. GSecondParameter f e => f a -> e
getSecondParameter' a a
a

  setSecondParameter' :: e -> (:*:) a b a -> (:*:) a b a
setSecondParameter' e
e (a a
a :*: b a
b) = 
    if a a -> Bool
forall (f :: * -> *) a. ParameterLeaf f => f a -> Bool
isLeaf a a
a 
    then a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: e -> b a -> b a
forall (f :: * -> *) e a. GSecondParameter' f e => e -> f a -> f a
setSecondParameter'' e
e b a
b
    else e -> a a -> a a
forall (f :: * -> *) e a. GSecondParameter f e => e -> f a -> f a
setSecondParameter' e
e a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b

class GSecondParameter' f e where
  getSecondParameter'' :: f a -> e
  setSecondParameter'' :: e -> f a -> f a

instance GSecondParameter' a e => GSecondParameter' (M1 i c a) e where
  getSecondParameter'' :: M1 i c a a -> e
getSecondParameter'' (M1 a a
a) = a a -> e
forall (f :: * -> *) e a. GSecondParameter' f e => f a -> e
getSecondParameter'' a a
a
  setSecondParameter'' :: e -> M1 i c a a -> M1 i c a a
setSecondParameter'' e
e (M1 a a
a) = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> a a -> M1 i c a a
forall a b. (a -> b) -> a -> b
$ e -> a a -> a a
forall (f :: * -> *) e a. GSecondParameter' f e => e -> f a -> f a
setSecondParameter'' e
e a a
a

instance GSecondParameter' a e => GSecondParameter' (a :*: b) e where
  getSecondParameter'' :: (:*:) a b a -> e
getSecondParameter'' (a a
a :*: b a
_) = a a -> e
forall (f :: * -> *) e a. GSecondParameter' f e => f a -> e
getSecondParameter'' a a
a
  setSecondParameter'' :: e -> (:*:) a b a -> (:*:) a b a
setSecondParameter'' e
e (a a
a :*: b a
b) = e -> a a -> a a
forall (f :: * -> *) e a. GSecondParameter' f e => e -> f a -> f a
setSecondParameter'' e
e a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b

instance {-# OVERLAPPING #-} GSecondParameter' (K1 i e) e where
  getSecondParameter'' :: K1 i e a -> e
getSecondParameter'' (K1 e
a) = e
a
  setSecondParameter'' :: e -> K1 i e a -> K1 i e a
setSecondParameter'' e
e (K1 e
_) = e -> K1 i e a
forall k i c (p :: k). c -> K1 i c p
K1 e
e

instance {-# OVERLAPPABLE #-} GSecondParameter' (K1 i a) e where
  getSecondParameter'' :: K1 i a a -> e
getSecondParameter'' K1 i a a
_ = e
forall a. HasCallStack => a
undefined
  setSecondParameter'' :: e -> K1 i a a -> K1 i a a
setSecondParameter'' e
_ K1 i a a
_  = K1 i a a
forall a. HasCallStack => a
undefined

class ParameterLeaf f where
  isLeaf :: f a -> Bool

instance ParameterLeaf (M1 i c a) where
  isLeaf :: M1 i c a a -> Bool
isLeaf M1 i c a a
_ = Bool
True

instance ParameterLeaf (a :*: b) where
  isLeaf :: (:*:) a b a -> Bool
isLeaf (:*:) a b a
_ = Bool
False