fork download
copy 
  1. {-# LANGUAGE KindSignatures, GADTs, TypeFamilies, TypeOperators, MultiParamTypeClasses, DataKinds, RankNTypes #-}
  2.  
  3. import Control.Applicative
  4. import Data.Traversable (Traversable)
  5.  
  6. class (Applicative f, Traversable f) => Dim f
  7.  
  8. data Shapely (fs :: [* -> *]) where
  9. 	ShZ :: Shapely '[]
  10. 	ShS :: (Dim f) => Shapely fs -> Shapely (f ': fs)
  11.  
  12. class SShapely (fs :: [* -> *]) where
  13. 	shapely :: Shapely fs
  14.  
  15. instance SShapely '[] where
  16. 	shapely = ShZ
  17.  
  18. instance (Dim f, SShapely fs) => SShapely (f ': fs) where
  19. 	shapely = ShS shapely
  20.  
  21. -------------------------------------
  22. --            Hypercuboid datatype
  23. -------------------------------------
  24. data Hyper :: [* -> *] -> * -> * where
  25.     Scalar :: a -> Hyper '[] a
  26.     Prism  :: (Dim f, SShapely fs) => 
  27.                 Hyper fs (f a) -> Hyper (f ': fs) a
  28.  
  29. instance Functor (Hyper fs) where
  30.     fmap f (Scalar a) = Scalar $ f a
  31.     fmap f (Prism p)  = Prism $ fmap (fmap f) p
  32.  
  33. applySh :: (SShapely fs => a) -> Shapely fs -> a
  34. applySh k  ShZ    = k
  35. applySh k (ShS s) = applySh k s
  36.  
  37. pureSh :: Shapely fs -> a -> Hyper fs a
  38. pureSh  ShZ    x = Scalar x
  39. pureSh (ShS s) x = applySh Prism s (pureSh s (pure x))
  40.  
  41. instance SShapely fs => Applicative (Hyper fs) where
  42. 	pure = pureSh shapely
  43.  
  44. main = print 42
Success #stdin #stdout 0s 4712KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
42
https://ideone.com/zKhDK8
language:
Haskell (ghc 8.4.4)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!