initial

src/Lib.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+module Lib where
+
+import GHC.Generics
+import Data.Number.Symbolic
+import Data.Monoid
+import Data.Foldable
+import Data.Proxy
+
+data BinTree a = Leaf a
+               | Node (BinTree a) (BinTree a)
+               deriving (Show, Functor, Generic, Generic1)
+
+data BinTreeF a r = LeafF a
+                  | NodeF r r
+                  deriving (Show, Functor, Generic, Generic1)
+
+
+-- defaultGetAccessGF :: (Generic a, AccessGF1 (Rep a)) => Proxy a -> Sym Double
+-- defaultGetAccessGF = getAccessGF1 . from
+--
+-- defaultGetAccessGF1 :: forall f. (Generic1 f, AccessGF1 (Rep1 f)) => Proxy f -> Sym Double
+-- defaultGetAccessGF1 _ = 
+
+class AccessGF1 f where
+  getAccessGF1 :: Proxy (f a) -> Sym Double
+  default getAccessGF1 :: (Generic1 f, AccessGF1 (Rep1 f )) => Proxy (f a) -> Sym Double
+  getAccessGF1 _ = getAccessGF1 (undefined :: Proxy (Rep1 f a))
+
+instance AccessGF1 V1 where
+  getAccessGF1 _ = 0
+
+instance AccessGF1 U1 where
+  getAccessGF1 _ = 0
+
+instance AccessGF1 f => AccessGF1 (Rec1 f) where -- Recursion on our datatype
+  getAccessGF1 _ = 1 / (1 - var "rec")
+
+instance AccessGF1 Par1 where -- Recursion on our datatype
+  getAccessGF1 _ = 1 / (1 - var "l")
+
+instance AccessGF1 (K1 i c) where -- Constant data, either of our `a` from `f a b` or something else
+  getAccessGF1 _ = 1 / (1 - var "z")
+
+instance (AccessGF1 f, AccessGF1 g) => AccessGF1 (f :+: g) where -- recurse into both sum types
+  getAccessGF1 _ = getAccessGF1 (Proxy :: Proxy (f a)) + getAccessGF1 (Proxy :: Proxy (g a))
+
+instance (AccessGF1 f, AccessGF1 g) => AccessGF1 (f :*: g) where
+  getAccessGF1 _ = getAccessGF1 (Proxy :: Proxy (f a)) * getAccessGF1 (Proxy :: Proxy (g a))
+
+instance AccessGF1 f => AccessGF1 (M1 i c f) where
+  getAccessGF1 _ = getAccessGF1 (Proxy :: Proxy (f a))
+
+-- class AccessGF a where
+--   getAccessGF :: proxy a -> Sym Double
+--   default getAccessGF :: (Generic a, AccessGF1 (Rep a)) => Proxy a -> Sym Double
+--   getAccessGF = getAccessGF1 (undefined :: Proxy (Rep a))
+
+instance AccessGF1 (BinTree)
+instance AccessGF1 (BinTreeF a)