diff --git a/src/Layers.hs b/src/Layers.hs new file mode 100644 index 000000000..4cd06ed83 --- /dev/null +++ b/src/Layers.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +{- | +Concerns a custom layers datatype that has a fixed number of strict elements. +Contains helpers that use the structure with indices. + -} +module Layers + ( Layers (..) + , Lay (..) + , lay0 + , lay1 + , lay2 + , lay3 + , lay4 + , lay5 + , layIndices + , getLay + , foldLayersr + , sequenceLayers + , sequenceLayers_ + ) where +import Control.Lens + +data Lay = L0 | L1 | L2 | L3 | L4 | L5 + +getLay :: Int -> Layers a -> a +{-# INLINE getLay #-} +getLay 0 = _lay0 +getLay 1 = _lay1 +getLay 2 = _lay2 +getLay 3 = _lay3 +getLay 4 = _lay4 +getLay 5 = _lay5 +getLay _ = undefined + +layIndices :: Layers Int +layIndices = Layers 0 1 2 3 4 5 + +foldLayersr :: (Int -> a -> b -> b) -> b -> Layers a -> b +foldLayersr f x Layers + { _lay0 = x0 + , _lay1 = x1 + , _lay2 = x2 + , _lay3 = x3 + , _lay4 = x4 + , _lay5 = x5 + } + = f 0 x0 . f 1 x1 . f 2 x2 . f 3 x3 . f 4 x4 $ f 5 x5 x +sequenceLayers_ :: (Int -> a -> IO b) -> Layers a -> IO () +sequenceLayers_ f lays = sequence_ $ f <$> layIndices <*> lays +-- f Layers +-- { _lay0 = x0 +-- , _lay1 = x1 +-- , _lay2 = x2 +-- , _lay3 = x3 +-- , _lay4 = x4 +-- , _lay5 = x5 +-- } +-- = f 0 x0 >> f 1 x1 >> f 2 x2 >> f 3 x3 >> f 4 x4 >> f 5 x5 >> return () +--foldLayersl' :: (Int -> b -> a -> b) -> b -> Layers a -> b +--foldLayersl' f x Layers +-- { _lay0 = x0 +-- , _lay1 = x1 +-- , _lay2 = x2 +-- , _lay3 = x3 +-- , _lay4 = x4 +-- , _lay5 = x5 +-- } +-- = f 0 x0 . f 1 x1 . f 2 x2 . f 3 x3 . f 4 x4 $ f 5 x5 x + +sequenceLayers :: (Int -> a -> IO b) -> Layers a -> IO (Layers b) +sequenceLayers f lays = sequence $ f <$> layIndices <*> lays + + +data Layers a = Layers + { _lay0 :: a + , _lay1 :: a + , _lay2 :: a + , _lay3 :: a + , _lay4 :: a + , _lay5 :: a + } +-- boilerplate folows +instance Functor Layers where + {-# INLINE fmap #-} + fmap f Layers + { _lay0 = the0 + , _lay1 = the1 + , _lay2 = the2 + , _lay3 = the3 + , _lay4 = the4 + , _lay5 = the5 + } + = Layers + { _lay0 = f the0 + , _lay1 = f the1 + , _lay2 = f the2 + , _lay3 = f the3 + , _lay4 = f the4 + , _lay5 = f the5 + } +instance Applicative Layers where + {-# INLINE pure #-} + pure a = Layers a a a a a a + {-# INLINE (<*>) #-} + (<*>) Layers + { _lay0 = f0 + , _lay1 = f1 + , _lay2 = f2 + , _lay3 = f3 + , _lay4 = f4 + , _lay5 = f5 + } + Layers + { _lay0 = x0 + , _lay1 = x1 + , _lay2 = x2 + , _lay3 = x3 + , _lay4 = x4 + , _lay5 = x5 + } + = Layers + { _lay0 = f0 x0 + , _lay1 = f1 x1 + , _lay2 = f2 x2 + , _lay3 = f3 x3 + , _lay4 = f4 x4 + , _lay5 = f5 x5 + } +instance Foldable Layers where + {-# INLINE foldr #-} + foldr f x Layers + { _lay0 = x0 + , _lay1 = x1 + , _lay2 = x2 + , _lay3 = x3 + , _lay4 = x4 + , _lay5 = x5 + } + = f x0 . f x1 . f x2 . f x3 . f x4 $ f x5 x +instance Traversable Layers where + {-# INLINE traverse #-} + traverse f Layers + { _lay0 = x0 + , _lay1 = x1 + , _lay2 = x2 + , _lay3 = x3 + , _lay4 = x4 + , _lay5 = x5 + } = Layers <$> f x0 <*> f x1 <*> f x2 <*> f x3 <*> f x4 <*> f x5 + +makeLenses ''Layers