{-# LANGUAGE KindSignatures, GADTs, TypeFamilies, TypeOperators, MultiParamTypeClasses, DataKinds #-}

import Control.Applicative
import Data.Traversable (Traversable)

class (Applicative f, Traversable f) => Dim f

data Shapely (fs :: [* -> *]) where
	ShZ :: Shapely '[]
	ShS :: (Dim f, SShapely fs) => Shapely (f ': fs)

class SShapely (fs :: [* -> *]) where
	shapely :: Shapely fs

instance SShapely '[] where
	shapely = ShZ
	
instance (Dim f, SShapely fs) => SShapely (f ': fs) where
	shapely = ShS

-------------------------------------
--            Hypercuboid datatype
-------------------------------------
data Hyper :: [* -> *] -> * -> * where
    Scalar :: a -> Hyper '[] a
    Prism  :: (Dim f, SShapely fs) => 
                Hyper fs (f a) -> Hyper (f ': fs) a

instance Functor (Hyper fs) where
    fmap f (Scalar a) = Scalar $ f a
    fmap f (Prism p)  = Prism $ fmap (fmap f) p

pureSh :: Shapely fs -> a -> Hyper fs a
pureSh ShZ x = Scalar x
pureSh ShS x = Prism (pureSh shapely (pure x))

instance SShapely fs => Applicative (Hyper fs) where
	pure = pureSh shapely

main = print 42