152 lines
3.4 KiB
Haskell
152 lines
3.4 KiB
Haskell
{-# 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
|