Haskell Tests, GADTs, TypeFamilies, MultiParamTypeClasses,

gistfile1.txt

{-# LANGUAGE   TemplateHaskell
             , RankNTypes
             , ExistentialQuantification
             , GADTs
             , MultiParamTypeClasses
             , TypeFamilies #-}

module Main where

import Control.Monad.State
import Control.Lens

class UIModel s where
    processInput :: (MonadIO m, MonadState s m) => Int -> m ()

data Model1 = Model1 { _m1Count :: !Int
                     }

makeLenses ''Model1

instance UIModel Model1 where
    processInput n = m1Count +=  n

data Model2 = Model2 { _m2Log :: !String
                     }

makeLenses ''Model2

instance UIModel Model2 where
    processInput n = m2Log %= (++ (show n))

data AppState = {- forall model. UIModel model => -} AppState
    { _m1 :: !Model1
    , _m2 :: !Model2
    -- , _m3 :: model
    }

makeLenses ''AppState

---

data V3 a = V3 a a a deriving (Show, Eq)

data M33 a = M33 (V3 a) (V3 a) (V3 a) deriving (Show, Eq)

class Multiply a b where
    type Result a b :: *
    (.*.) :: a -> b -> Result a b

instance (Num a) => Multiply (V3 a) (V3 a) where
    type Result (V3 a) (V3 a) = V3 a
    (V3 a1 b1 c1) .*. (V3 a2 b2 c2) = V3 (a1 * a2) (b1 * b2) (c1 * c2)

---

data Optional a where
    Yes :: a -> Optional a
    No :: Optional a

data G :: * -> * where
    GInt  :: G Int
    GInt2 :: G Int
    GBool :: G Bool

someF :: G Int -> G Bool
someF GInt  = GBool
someF GInt2 = GBool

-- parseOnly ((Data.Attoparsec.Combinator.lookAhead $ char '[' *> satisfy isAsciiUpper) *> Data.Attoparsec.Text.takeTill (isSpace)) "[Abc] "

main :: IO ()
main = do
    let _ = (V3 1 2 3 :: V3 Float) .*. (V3 4 5 6 :: V3 Float)
    let _ = GInt :: G Int
    void . flip evalStateT (AppState (Model1 0) (Model2 "")) $ do
        zoom m1 $ processInput 10
        zoom m2 $ processInput 10
        return ()