{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Language.GLSL.Internal.Bits where

data B = O | I
  deriving (Int -> B -> ShowS
[B] -> ShowS
B -> String
(Int -> B -> ShowS) -> (B -> String) -> ([B] -> ShowS) -> Show B
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [B] -> ShowS
$cshowList :: [B] -> ShowS
show :: B -> String
$cshow :: B -> String
showsPrec :: Int -> B -> ShowS
$cshowsPrec :: Int -> B -> ShowS
Show, B -> B -> Bool
(B -> B -> Bool) -> (B -> B -> Bool) -> Eq B
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: B -> B -> Bool
$c/= :: B -> B -> Bool
== :: B -> B -> Bool
$c== :: B -> B -> Bool
Eq)

class Bits a where
  fill :: B -> a
  flat :: a -> [B]
  unflat :: [B] -> Maybe (a, [B])

instance Bits B where
  fill :: B -> B
fill B
b = B
b
  flat :: B -> [B]
flat B
a = [B
a]
  unflat :: [B] -> Maybe (B, [B])
unflat (B
x:[B]
xs) = (B, [B]) -> Maybe (B, [B])
forall a. a -> Maybe a
Just (B
x, [B]
xs)
  unflat [B]
_      = Maybe (B, [B])
forall a. Maybe a
Nothing
instance (Bits a,Bits b) => Bits (a,b) where
  fill :: B -> (a, b)
fill B
b = (B -> a
forall a. Bits a => B -> a
fill B
b,B -> b
forall a. Bits a => B -> a
fill B
b)
  flat :: (a, b) -> [B]
flat (a
a,b
b) = a -> [B]
forall a. Bits a => a -> [B]
flat a
a [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ b -> [B]
forall a. Bits a => a -> [B]
flat b
b
  unflat :: [B] -> Maybe ((a, b), [B])
unflat [B]
xs = do
    (a
a,[B]
xsa) <- [B] -> Maybe (a, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xs
    (b
b,[B]
xsb) <- [B] -> Maybe (b, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsa
    ((a, b), [B]) -> Maybe ((a, b), [B])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b),[B]
xsb)
instance (Bits a,Bits b,Bits c) => Bits (a,b,c) where
  fill :: B -> (a, b, c)
fill B
b = (B -> a
forall a. Bits a => B -> a
fill B
b,B -> b
forall a. Bits a => B -> a
fill B
b,B -> c
forall a. Bits a => B -> a
fill B
b)
  flat :: (a, b, c) -> [B]
flat (a
a,b
b,c
c) = a -> [B]
forall a. Bits a => a -> [B]
flat a
a [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ b -> [B]
forall a. Bits a => a -> [B]
flat b
b [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ c -> [B]
forall a. Bits a => a -> [B]
flat c
c
  unflat :: [B] -> Maybe ((a, b, c), [B])
unflat [B]
xs = do
    (a
a,[B]
xsa) <- [B] -> Maybe (a, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xs
    (b
b,[B]
xsb) <- [B] -> Maybe (b, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsa
    (c
c,[B]
xsc) <- [B] -> Maybe (c, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsb
    ((a, b, c), [B]) -> Maybe ((a, b, c), [B])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c),[B]
xsc)
instance (Bits a,Bits b,Bits c,Bits d) => Bits (a,b,c,d) where
  fill :: B -> (a, b, c, d)
fill B
b = (B -> a
forall a. Bits a => B -> a
fill B
b,B -> b
forall a. Bits a => B -> a
fill B
b,B -> c
forall a. Bits a => B -> a
fill B
b,B -> d
forall a. Bits a => B -> a
fill B
b)
  flat :: (a, b, c, d) -> [B]
flat (a
a,b
b,c
c,d
d) = a -> [B]
forall a. Bits a => a -> [B]
flat a
a [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ b -> [B]
forall a. Bits a => a -> [B]
flat b
b [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ c -> [B]
forall a. Bits a => a -> [B]
flat c
c [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ d -> [B]
forall a. Bits a => a -> [B]
flat d
d
  unflat :: [B] -> Maybe ((a, b, c, d), [B])
unflat [B]
xs = do
    (a
a,[B]
xsa) <- [B] -> Maybe (a, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xs
    (b
b,[B]
xsb) <- [B] -> Maybe (b, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsa
    (c
c,[B]
xsc) <- [B] -> Maybe (c, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsb
    (d
d,[B]
xsd) <- [B] -> Maybe (d, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsc
    ((a, b, c, d), [B]) -> Maybe ((a, b, c, d), [B])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c,d
d),[B]
xsd)
instance (Bits a,Bits b,Bits c,Bits d, Bits e) => Bits (a,b,c,d,e) where
  fill :: B -> (a, b, c, d, e)
fill B
b = (B -> a
forall a. Bits a => B -> a
fill B
b,B -> b
forall a. Bits a => B -> a
fill B
b,B -> c
forall a. Bits a => B -> a
fill B
b,B -> d
forall a. Bits a => B -> a
fill B
b,B -> e
forall a. Bits a => B -> a
fill B
b)
  flat :: (a, b, c, d, e) -> [B]
flat (a
a,b
b,c
c,d
d,e
e) = a -> [B]
forall a. Bits a => a -> [B]
flat a
a [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ b -> [B]
forall a. Bits a => a -> [B]
flat b
b [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ c -> [B]
forall a. Bits a => a -> [B]
flat c
c [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ d -> [B]
forall a. Bits a => a -> [B]
flat d
d [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
++ e -> [B]
forall a. Bits a => a -> [B]
flat e
e
  unflat :: [B] -> Maybe ((a, b, c, d, e), [B])
unflat [B]
xs = do
    (a
a,[B]
xsa) <- [B] -> Maybe (a, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xs
    (b
b,[B]
xsb) <- [B] -> Maybe (b, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsa
    (c
c,[B]
xsc) <- [B] -> Maybe (c, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsb
    (d
d,[B]
xsd) <- [B] -> Maybe (d, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsc
    (e
e,[B]
xse) <- [B] -> Maybe (e, [B])
forall a. Bits a => [B] -> Maybe (a, [B])
unflat [B]
xsd
    ((a, b, c, d, e), [B]) -> Maybe ((a, b, c, d, e), [B])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c,d
d,e
e),[B]
xse)

zero, one :: Bits a => a
zero :: a
zero = B -> a
forall a. Bits a => B -> a
fill B
O
one :: a
one = B -> a
forall a. Bits a => B -> a
fill B
I

class Expandable a b where
  expand :: a -> b

instance Expandable a a where
  expand :: a -> a
expand a
x = a
x
-- TODO: can this be more generic?
instance Expandable (B,B) (B,B,B,B,B) where
  expand :: (B, B) -> (B, B, B, B, B)
expand (B
a,B
b) = (B, B, B) -> (B, B, B, B, B)
forall a b. Expandable a b => a -> b
expand (B
a,B
b,B
O)
instance Expandable (B,B,B) (B,B,B,B,B) where
  expand :: (B, B, B) -> (B, B, B, B, B)
expand (B
a,B
b,B
c) = (B, B, B, B) -> (B, B, B, B, B)
forall a b. Expandable a b => a -> b
expand (B
a,B
b,B
c,B
O)
instance Expandable (B,B,B,B) (B,B,B,B,B) where
  expand :: (B, B, B, B) -> (B, B, B, B, B)
expand (B
a,B
b,B
c,B
d) = (B, B, B, B, B) -> (B, B, B, B, B)
forall a b. Expandable a b => a -> b
expand (B
a,B
b,B
c,B
d,B
O)