Add layers

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