concoct (empty) → 0.1.0

raw patch · 13 files changed

+687/−0 lines, 13 filesdep +basedep +concoctdep +mtl

Dependencies added: base, concoct, mtl

Files

• CHANGELOG.md +5/−0
• LICENSE +29/−0
• concoct.cabal +54/−0
• examples/UI.hs +29/−0
• src/Concoct.hs +11/−0
• src/Concoct/View.hs +31/−0
• src/Concoct/View/Build.hs +60/−0
• src/Concoct/View/Internal.hs +204/−0
• src/Concoct/View/Rebuild.hs +89/−0
• src/Concoct/View/Skip.hs +47/−0
• src/Concoct/View/Tree.hs +69/−0
• src/Concoct/View/Unmount.hs +55/−0
• test/Main.hs +4/−0

@@ -0,0 +1,5 @@+# Revision history for concoct
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

@@ -0,0 +1,29 @@+Copyright (c) 2026, Matt Hunzinger
+
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the copyright holder nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,54 @@+cabal-version:   3.0+name:            concoct+version:         0.1.0+license:         BSD-3-Clause+license-file:    LICENSE+maintainer:      matt@hunzinger.me+author:          Matt Hunzinger+homepage:        https://github.com/matthunz/concoct+synopsis:        A declarative UI framework+description:     A declarative user-interface framework+category:        User Interfaces+build-type:      Simple+extra-doc-files: CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/matthunz/concoct.git++library+    exposed-modules:+        Concoct+        Concoct.View+        Concoct.View.Build+        Concoct.View.Internal+        Concoct.View.Rebuild+        Concoct.View.Skip+        Concoct.View.Tree+        Concoct.View.Unmount++    hs-source-dirs:   src+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4.2 && <5,+        mtl >=2 && <3++executable ui+    main-is:          UI.hs+    hs-source-dirs:   examples+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4.2 && <5,+        concoct++test-suite concoct-test+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    hs-source-dirs:   test+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4.2 && <5,+        concoct

@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts #-}++module Main where++import Concoct++counter :: (MonadView IO m) => m ()+counter = do+  count <- useState $ pure (0 :: Int)++  useEffect (readStateRef count) $ \c -> do+    putStrLn $ "Count: " ++ show c+    writeStateRef count $ c + 1++  switchView+    (even <$> readStateRef count)+    (liftView $ putStrLn "Even!")+    (liftView $ putStrLn "Odd!")++  useOnUnmount $ do+    c <- readStateRef count+    putStrLn $ "Unmount:" ++ show c++main :: IO ()+main = do+  t <- viewTree counter+  t' <- rebuildViewTree t+  _ <- unmountViewTree t'+  return ()

@@ -0,0 +1,11 @@+-- |+-- Module      : Concoct+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct (module Concoct.View) where++import Concoct.View

@@ -0,0 +1,31 @@+-- |+-- Module      : Concoct.View+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View+  ( -- * MonadView+    MonadView (..),++    -- * StateRef+    StateRef,+    readStateRef,+    writeStateRef,++    -- * ViewRef+    ViewRef,+    readViewRef,++    -- * ViewTree+    ViewTree,+    viewTree,+    rebuildViewTree,+    unmountViewTree,+  )+where++import Concoct.View.Internal+import Concoct.View.Tree

@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module      : Concoct.View.Build+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Build (Build (..), runBuild) where++import Concoct.View.Internal+import Control.Monad.State+import Data.IORef++newtype Build m a = Build {unBuild :: StateT ViewState m a}+  deriving (Functor, Applicative, Monad)++instance (MonadIO m) => MonadView m (Build m) where+  useState a = Build $ do+    a' <- lift a+    ref <- liftIO $ newIORef a'+    vs <- get+    let sRef = StateRef ref $ viewUpdater vs+    put vs {viewStack = pushStack sRef (viewStack vs)}+    return sRef+  useRef a = Build $ do+    a' <- lift a+    let vRef = ViewRef a'+    modify $ \vs -> vs {viewStack = pushStack vRef (viewStack vs)}+    return vRef+  useEffect deps f = Build $ do+    deps' <- lift deps+    modify $ \vs -> vs {viewStack = pushStack deps' (viewStack vs)}+    lift $ f deps'+  useOnUnmount _ = return ()+  component vb = Build $ do+    ref <- liftIO $ newIORef False+    let updater m = writeIORef ref True >> m+    vs <- get+    put vs {viewUpdater = updater, viewStack = pushStack ref (viewStack vs)}+    unBuild vb+    vs' <- get+    put vs' {viewUpdater = viewUpdater vs}+  liftView = Build . lift+  switchView cond vTrue vFalse = Build $ do+    cond' <- lift cond+    modify $ \vs -> vs {viewStack = pushStack cond' (viewStack vs)}+    if cond' then unBuild vTrue else unBuild vFalse+  listView items f = Build $ do+    items' <- lift items+    modify $ \vs -> vs {viewStack = pushStack items' (viewStack vs)}+    mapM_ (unBuild . f) items'++runBuild :: (MonadIO m) => Build m a -> ViewState -> m (a, ViewState)+runBuild vb = runStateT (unBuild vb)

@@ -0,0 +1,204 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module      : Concoct.View.Internal+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Internal+  ( -- * MonadView+    MonadView (..),++    -- * StateRef+    StateRef (..),+    readStateRef,+    writeStateRef,++    -- * ViewRef+    ViewRef (..),+    readViewRef,++    -- * Stack+    Stack (..),+    emptyStack,+    pushStack,+    popStack,+    peekStack,+    setStack,+    skipStack,+    flushStack,++    -- * ViewState+    ViewState (..),+    rebuildState,+    rebuildState',+    rebuildRef,+    rebuildRef',+    rebuildComponent,+  )+where++import Control.Monad+import Control.Monad.State+import Data.Dynamic+import Data.IORef++-- | Monadic view.+--+-- Views are interpreted in multiple passes:+--+-- * Build+-- * Rebuild+-- * Skip+-- * Unmount+--+-- And can be extended for further passes, such as layout or render.+--+-- Hooks provide access to values in a view across passes.+--+-- Views are seperated into @component@s, with each providing a scope for updates to occur.+-- A @component@ will only be rebuilt if its state is changed.+-- If a component containing children is updated, its children are rebuilt as well.+class (Monad m) => MonadView t m | m -> t where+  -- | Hook to use a mutable state reference.+  useState :: (Typeable a) => t a -> m (StateRef a)++  -- | Hook to use a constant view reference.+  useRef :: (Typeable a) => t a -> m (ViewRef a)++  -- | Hook to use an effect that runs when dependencies change.+  useEffect :: (Eq d, Typeable d) => t d -> (d -> t ()) -> m ()++  -- | Hook that runs when the current component is unmounted.+  useOnUnmount :: t () -> m ()++  -- | Component view.+  component :: (forall x. (MonadView t x) => x ()) -> m ()++  -- | Lift a monadic action into the view.+  liftView :: t () -> m ()++  -- | Conditional view.+  -- This will render the first view if the condition is @True@, otherwise the second.+  switchView ::+    t Bool ->+    (forall x. (MonadView t x) => x ()) ->+    (forall x. (MonadView t x) => x ()) ->+    m ()++  -- | List view.+  -- This will render a view for each item in the list.+  listView :: (Typeable a, Eq a) => t [a] -> (a -> (forall x. (MonadView t x) => x ())) -> m ()++-- | State reference.+-- Created with @useState@.+data StateRef a = StateRef+  { stateRef :: IORef a,+    stateRefUpdater :: IO () -> IO ()+  }++-- | Read a state reference.+readStateRef :: (MonadIO m) => StateRef a -> m a+readStateRef = liftIO . readIORef . stateRef++-- | Write to a state reference.+-- This will schedule an update to the current @component@.+writeStateRef :: (MonadIO m) => StateRef a -> a -> m ()+writeStateRef ref = liftIO . stateRefUpdater ref . writeIORef (stateRef ref)++-- | View reference.+-- Created with @useRef@.+newtype ViewRef a = ViewRef a++-- | Read a view reference.+readViewRef :: (Applicative m) => ViewRef a -> m a+readViewRef (ViewRef a) = pure a++data Stack = Stack+  { stackBefore :: [Dynamic],+    stackAfter :: [Dynamic]+  }++emptyStack :: Stack+emptyStack = Stack [] []++pushStack :: (Typeable a) => a -> Stack -> Stack+pushStack a (Stack before after) = Stack (toDyn a : before) after++popStack :: (Typeable a) => Stack -> (Maybe a, Stack)+popStack (Stack before []) = (Nothing, Stack before [])+popStack (Stack before (d : ds)) =+  case fromDynamic d of+    Just a -> (Just a, Stack (d : before) ds)+    Nothing -> popStack (Stack (d : before) ds)++peekStack :: (Typeable a) => Stack -> Maybe a+peekStack (Stack _ []) = Nothing+peekStack (Stack _ (d : _)) = fromDynamic d++setStack :: (Typeable a) => a -> Stack -> Stack+setStack a (Stack before (_ : ds)) = Stack (toDyn a : before) ds+setStack _ s = s++skipStack :: Stack -> Stack+skipStack (Stack before (d : after)) = Stack (d : before) after+skipStack s = s++flushStack :: Stack -> Stack+flushStack (Stack before after) = Stack [] (reverse before ++ after)++data ViewState = ViewState+  { viewStack :: Stack,+    viewUpdater :: IO () -> IO ()+  }++rebuildState :: (MonadIO m, Typeable a) => StateT ViewState m (StateRef a)+rebuildState = do+  vs <- get+  let (ref, s') = rebuildState' (viewStack vs)+  put vs {viewStack = s'}+  return ref++rebuildState' :: (Typeable a) => Stack -> (StateRef a, Stack)+rebuildState' s = do+  let (mref, s') = popStack s+  case mref of+    Just ref -> (ref, s')+    Nothing -> error "useState: StateRef not found in stack during rebuild"++rebuildRef :: (Monad m, Typeable a) => StateT ViewState m (ViewRef a)+rebuildRef = do+  vs <- get+  let (ref, s') = rebuildRef' (viewStack vs)+  put vs {viewStack = s'}+  return ref++rebuildRef' :: (Typeable a) => Stack -> (ViewRef a, Stack)+rebuildRef' s = do+  let (mref, s') = popStack s+  case mref of+    Just ref -> (ref, s')+    Nothing -> error "useRef: ViewRef not found in stack during rebuild"++rebuildComponent ::+  (MonadIO m, MonadView t f) =>+  (f () -> StateT ViewState m ()) ->+  (forall x. (MonadView t x) => x ()) ->+  StateT ViewState m ()+rebuildComponent g v = do+  vs <- get+  let (mref, s') = popStack (viewStack vs)+  put vs {viewStack = s'}+  case mref of+    Just ref -> do+      changed <- liftIO $ readIORef ref+      when changed $ liftIO $ writeIORef ref False+      g v+      vs' <- get+      put vs' {viewUpdater = viewUpdater vs}+    Nothing -> error "component: Change ref not found in stack during rebuild"

@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Concoct.View.Rebuild+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Rebuild (Rebuild (..), runRebuild) where++import Concoct.View.Build+import Concoct.View.Internal+import Concoct.View.Skip+import Concoct.View.Unmount+import Control.Monad+import Control.Monad.State++newtype Rebuild m a = Rebuild {unRebuild :: StateT ViewState m a}+  deriving (Functor, Applicative, Monad)++instance (MonadIO m) => MonadView m (Rebuild m) where+  useState _ = Rebuild $ rebuildState+  useRef _ = Rebuild $ rebuildRef+  useEffect deps f = Rebuild $ do+    mdep <- gets $ peekStack . viewStack+    case mdep of+      Just oldDeps -> do+        deps' <- lift deps+        when (oldDeps /= deps') $ do+          modify $ \vs -> vs {viewStack = setStack deps' (viewStack vs)}+          lift $ f deps'+      Nothing -> error "useEffect: Dependencies not found in stack during rebuild"+  useOnUnmount _ = return ()+  component v = Rebuild $ rebuildComponent unRebuild v+  liftView = Rebuild . lift+  switchView cond vTrue vFalse = Rebuild $ do+    vs <- get+    let (mcond, s') = popStack (viewStack vs)+    case mcond of+      Just oldCond -> do+        cond' <- lift cond+        if oldCond == cond'+          then do+            put vs {viewStack = pushStack cond' s'}+            if cond' then unRebuild vTrue else unRebuild vFalse+          else do+            put vs {viewStack = pushStack cond' s'}+            if oldCond+              then unSkip vTrue+              else unSkip vFalse+            if cond'+              then unBuild vTrue+              else unBuild vFalse+      Nothing -> error "switchView: Condition not found in stack during rebuild"+  listView items f = Rebuild $ do+    vs <- get+    let (mOldItems, s') = popStack (viewStack vs)+    case mOldItems of+      Just oldItems -> do+        items' <- lift items+        put vs {viewStack = pushStack items' s'}+        -- Update shared items+        let common = zip oldItems items'+            oldLen = length oldItems+            newLen = length items'+        forM_ common $ \(old, new) ->+          if old == new+            then unSkip (f old)+            else do+              unSkip (f old)+              unBuild (f new)+        -- Unmount removed items+        when (oldLen > newLen) $+          forM_ (drop newLen oldItems) $ \old -> do+            vs' <- get+            (_, stack') <- lift $ runUnmount (f old) (viewStack vs')+            put vs' {viewStack = stack'}+        -- Build added items+        when (newLen > oldLen) $+          forM_ (drop oldLen items') $ \new ->+            unBuild (f new)+      Nothing -> error "listView: Items not found in stack during rebuild"++runRebuild :: (MonadIO m) => Rebuild m a -> ViewState -> m (a, ViewState)+runRebuild vr = runStateT (unRebuild vr)

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Concoct.View.Skip+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Skip (Skip (..), runSkip) where++import Concoct.View.Internal+import Control.Monad.State++newtype Skip m a = Skip {unSkip :: StateT ViewState m a}+  deriving (Functor, Applicative, Monad)++instance (MonadIO m) => MonadView m (Skip m) where+  useState _ = Skip rebuildState+  useRef _ = Skip rebuildRef+  useEffect _ _ = return ()+  useOnUnmount _ = return ()+  component v = Skip $ rebuildComponent unSkip v+  liftView _ = return ()+  switchView _ vTrue vFalse = Skip $ do+    vs <- get+    let (mcond, s') = popStack (viewStack vs)+    case mcond of+      Just cond' -> do+        put vs {viewStack = pushStack cond' s'}+        if cond' then unSkip vTrue else unSkip vFalse+      Nothing -> error "switchView: Condition not found in stack during skip"+  listView _ f = Skip $ do+    vs <- get+    let (mItems, s') = popStack @[_] (viewStack vs)+    case mItems of+      Just items' -> do+        put vs {viewStack = pushStack items' s'}+        mapM_ (unSkip . f) items'+      Nothing -> error "listView: Items not found in stack during skip"++runSkip :: (MonadIO m) => Skip m a -> ViewState -> m (a, ViewState)+runSkip vs = runStateT (unSkip vs)

@@ -0,0 +1,69 @@+{-# LANGUAGE RankNTypes #-}++-- |+-- Module      : Concoct.View.Tree+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Tree+  ( ViewTree (..),+    viewTree,+    rebuildViewTree,+    unmountViewTree,+  )+where++import Concoct.View.Build+import Concoct.View.Internal+import Concoct.View.Rebuild+import Concoct.View.Skip+import Concoct.View.Unmount+import Control.Monad.IO.Class+import Data.IORef++-- | View tree.+data ViewTree t = ViewTree+  { viewTreeView :: forall m. (MonadView t m) => m (),+    viewTreeStack :: Stack,+    viewTreeChanged :: IORef Bool,+    viewTreePendingUpdates :: IORef (IO ())+  }++-- | Create a view tree from a view.+viewTree :: (MonadIO t) => (forall m. (MonadView t m) => m ()) -> t (ViewTree t)+viewTree v = do+  changedRef <- liftIO $ newIORef False+  pendingRef <- liftIO $ newIORef (pure ())+  let updater m = modifyIORef pendingRef (>> m) >> writeIORef changedRef True+      s = ViewState emptyStack updater+  (_, s') <- runBuild v s+  return (ViewTree v (flushStack $ viewStack s') changedRef pendingRef)++-- | Rebuild the view tree if changed.+rebuildViewTree :: (MonadIO t) => ViewTree t -> t (ViewTree t)+rebuildViewTree t = do+  pending <- liftIO $ readIORef (viewTreePendingUpdates t)+  liftIO pending+  liftIO $ writeIORef (viewTreePendingUpdates t) (pure ())+  changed <- liftIO $ readIORef (viewTreeChanged t)+  if changed+    then do+      liftIO $ writeIORef (viewTreeChanged t) False+      let updater m = modifyIORef (viewTreePendingUpdates t) (>> m) >> writeIORef (viewTreeChanged t) True+          s = ViewState (viewTreeStack t) updater+      (_, s') <- runRebuild (viewTreeView t) s+      return t {viewTreeStack = flushStack $ viewStack s'}+    else do+      let updater m = modifyIORef (viewTreePendingUpdates t) (>> m) >> writeIORef (viewTreeChanged t) True+          s = ViewState (viewTreeStack t) updater+      (_, s') <- runSkip (viewTreeView t) s+      return t {viewTreeStack = flushStack $ viewStack s'}++-- | Unmount the view tree.+unmountViewTree :: (MonadIO t) => ViewTree t -> t (ViewTree t)+unmountViewTree t = do+  (_, stack') <- runUnmount (viewTreeView t) (viewTreeStack t)+  return t {viewTreeStack = stack'}

@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Concoct.View.Unmount+-- Copyright   : (c) Matt Hunzinger, 2026+-- License     : BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  : matt@hunzinger.me+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Concoct.View.Unmount (Unmount (..), runUnmount) where++import Concoct.View.Internal+import Control.Monad.State++newtype Unmount m a = Unmount {unUnmount :: StateT Stack m a}+  deriving (Functor, Applicative, Monad)++instance (MonadIO m) => MonadView m (Unmount m) where+  useState _ = Unmount $ do+    stack <- get+    let (ref, stack') = rebuildState' stack+    put stack'+    return ref+  useRef _ = Unmount $ do+    stack <- get+    let (ref, stack') = rebuildRef' stack+    put stack'+    return ref+  useEffect _ _ = Unmount $ modify skipStack+  useOnUnmount = Unmount . lift+  component v = Unmount $ do+    modify skipStack+    unUnmount v+  liftView _ = return ()+  switchView _ vTrue vFalse = Unmount $ do+    stack <- get+    let (mcond, stack') = popStack stack+    put stack'+    case mcond of+      Just cond' -> if cond' then unUnmount vTrue else unUnmount vFalse+      Nothing -> error "switchView: Condition not found in stack during unmount"+  listView _ f = Unmount $ do+    stack <- get+    let (mItems, stack') = popStack @[_] stack+    put stack'+    case mItems of+      Just items' -> mapM_ (unUnmount . f) items'+      Nothing -> error "listView: Items not found in stack during unmount"++runUnmount :: (MonadIO m) => Unmount m a -> Stack -> m (a, Stack)+runUnmount vu = runStateT (unUnmount vu)

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."