yi-0.3: Yi/UI/Cocoa.hs
{-# LANGUAGE TemplateHaskell, ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
--
-- Copyright (c) 2007, 2008 Jean-Philippe Bernardy
-- Copyright (c) 2008 Gustav Munkby
--
-- | This module defines a user interface implemented using Cocoa.
-- For a Cocoa application to work we need to have the Cocoa
-- event-loop running. Since we don't want to re-implement the
-- event-loop in Haskell, we simply dispatch to the Objective-C
-- version and hook into events.
--
-- This however, is not completely trivial, since calling the
-- long-running Objective-C loop causes Haskell code not to be
-- executed at all. Upon receiving an event we must also make
-- sure to dispatch to other Haskell threads in order to make
-- progress. Since the Cocoa run-loop installs and frees an
-- NSAutoreleasePool for every iteration of the loop, we must
-- make sure that we don't allocate an object in one iteration,
-- and then try to use it in the next.
--
-- We therefore use a lock to ensure that only one thread
-- executes Cocoa calls at a time. This means that if a thread
-- claims the lock, it can perform allocation and use Cocoa
-- resources knowing that either the whole operation is performed
-- in one iteration, or it is never even started.
module Yi.UI.Cocoa (start) where
import Prelude hiding (init, error, sequence_, elem, mapM_, mapM, concatMap)
import Yi.Buffer
import Yi.Buffer.HighLevel
import Yi.Editor (Editor, EditorM, withGivenBuffer0, findBufferWith, statusLine, buffers)
import qualified Yi.Editor as Editor
import Yi.Event
import Yi.Debug
import Yi.Buffer.Implementation
import Yi.Monad
import Yi.Style hiding (modeline)
import qualified Yi.UI.Common as Common
import qualified Yi.WindowSet as WS
import qualified Yi.Window as Window
import Yi.Window (Window)
import Paths_yi (getDataFileName)
import Control.Concurrent (yield, threadDelay)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Monad.Reader (liftIO, when, MonadIO)
import Control.Monad (ap, replicateM_)
import Control.Applicative ((<*>), (<$>))
import Data.IORef
import Data.Maybe
import Data.Unique
import Data.Foldable
import Data.Traversable
import qualified Data.Map as M
import Foundation hiding (length, name, new, parent, error, self, null)
import Foundation.NSObject (init)
import AppKit hiding (windows, start, rect, width, content, prompt, dictionary, icon)
import AppKit.NSWindow (contentView)
import AppKit.NSText (selectedRange)
import qualified AppKit.NSView as NSView
import HOC
import Foreign.C
import Foreign hiding (new)
foreign import ccall "Processes.h TransformProcessType" transformProcessType :: Ptr (CInt) -> CInt -> IO (CInt)
foreign import ccall "Processes.h SetFrontProcess" setFrontProcess :: Ptr (CInt) -> IO (CInt)
foreign import ccall "Processes.h GetCurrentProcess" getCurrentProcess :: Ptr (CInt) -> IO (CInt)
logNSException :: String -> IO () -> IO ()
logNSException str act =
catchNS act (\e -> description e >>= haskellString >>=
logPutStrLn . (("NSException " ++ str ++ ":") ++))
------------------------------------------------------------------------
-- The selector is used since NSEvent#type treats the c enum
-- in a type-safe way, but Cocoa receives values which are not
-- defined in the c enum, which results in a pattern mismatch...
$(declareRenamedSelector "type" "rawType" [t| IO CInt |])
instance Has_rawType (NSEvent a)
-- This declares an application delegate which ensures the application
-- terminates when the last (and only) cocoa window is closed
$(declareClass "YiController" "NSObject")
$(exportClass "YiController" "yc_" [
InstanceMethod 'applicationShouldTerminateAfterLastWindowClosed -- '
])
yc_applicationShouldTerminateAfterLastWindowClosed :: forall t. NSApplication t -> YiController () -> IO Bool
yc_applicationShouldTerminateAfterLastWindowClosed _app _self = return True
------------------------------------------------------------------------
-- This declares an application subclass which enables us to insert
-- ourselves into the application event loop and trap key-events application wide
$(declareClass "YiApplication" "NSApplication")
$(declareSelector "doTick" [t| IO () |])
$(declareSelector "setAppleMenu:" [t| forall t. NSMenu t -> IO () |] )
instance Has_setAppleMenu (NSApplication a)
$(exportClass "YiApplication" "ya_" [
InstanceVariable "eventChannel" [t| Maybe (Chan Yi.Event.Event) |] [| Nothing |]
, InstanceVariable "lock" [t| Maybe (MVar ()) |] [| Nothing |]
, InstanceMethod 'run -- '
, InstanceMethod 'doTick -- '
, InstanceMethod 'sendEvent -- '
])
ya_doTick :: YiApplication () -> IO ()
ya_doTick self = do
Just lock <- self #. _lock
putMVar lock ()
replicateM_ 4 yield
takeMVar lock
ya_run :: YiApplication () -> IO ()
ya_run self = do
-- Schedule a timer that repeatedly invokes ya_doTick in order to have
-- some Haskell code running all the time. This will prevent other
-- Haskell threads to stall while waiting for the Cocoa run loop to finish.
_NSTimer # scheduledTimerWithTimeIntervalTargetSelectorUserInfoRepeats
0.05 self (getSelectorForName "doTick") nil True
super self # run
ya_sendEvent :: forall t. NSEvent t -> YiApplication () -> IO ()
ya_sendEvent event self = logNSException "sendEvent" $ do
t <- event # rawType
if t == fromCEnum nsKeyDown
then self #. _eventChannel >>= handleKeyEvent event
else super self # sendEvent event
handleKeyEvent :: forall t. NSEvent t -> Maybe (Chan Yi.Event.Event) -> IO ()
handleKeyEvent event ch = do
mask <- event # modifierFlags
str <- event # charactersIgnoringModifiers >>= haskellString
let (k,shift) = case str of
"\r" -> (Just KEnter, True)
"\DEL" -> (Just KBS, True)
"\ESC" -> (Just KEsc, True)
"\63232" -> (Just KUp, True)
"\63233" -> (Just KDown, True)
"\63234" -> (Just KLeft, True)
"\63235" -> (Just KRight, True)
"\63273" -> (Just KHome, True)
"\63275" -> (Just KEnd, True)
"\63276" -> (Just KPageUp, True)
"\63277" -> (Just KPageDown, True)
[c] -> (Just $ KASCII c, False)
_ -> (Nothing, True)
case (k,ch) of
(Just k, Just ch) -> writeChan ch (Event k (modifiers shift mask))
_ -> return ()
modifierTable :: Bool -> [(CUInt, Modifier)]
modifierTable False = [(bit 18,MCtrl), (bit 19,MMeta)]
modifierTable True = (bit 17,MShift) : modifierTable False
modifiers :: Bool -> CUInt -> [Modifier]
modifiers shift mask = [yi | (cocoa, yi) <- modifierTable shift, (cocoa .&. mask) /= 0]
------------------------------------------------------------------------
-- This declares our special text-view class. The textview interpretes
-- mouse events so that mouse-selection in Yi should function as in any
-- Cocoa application
$(declareClass "YiTextView" "NSTextView")
$(exportClass "YiTextView" "ytv_" [
InstanceVariable "runBuffer" [t| BufferM () -> IO () |] [| \_ -> return () |]
, InstanceMethod 'mouseDown -- '
])
ytv_mouseDown :: forall t. NSEvent t -> YiTextView () -> IO ()
ytv_mouseDown event self = do
-- Determine the starting location before tracking mouse
layout <- self # layoutManager
container <- self # textContainer
mousewin <- event # locationInWindow
NSPoint ex ey <- self # convertPointFromView mousewin nil
NSPoint ox oy <- self # textContainerOrigin
let mouse@(NSPoint mx _) = NSPoint (ex - ox) (ey - oy)
index <- layout # glyphIndexForPointInTextContainer mouse container >>= return . fromEnum
NSRect (NSPoint cx _) (NSSize cw _) <-
layout # boundingRectForGlyphRangeInTextContainer (NSRange (toEnum index) 1) container
let startIndex = if mx - cx < cx + cw - mx then index else index + 1
-- The super-class deals Cocoa-ishly with mouse events
super self # mouseDown event
-- Update our selection marker and position to reflect what Cocoa wants
NSRange p l <- selectedRange self
let p1 = fromEnum p
p2 = p1 + fromEnum l
runbuf <- self #. _runBuffer
runbuf $ do
if p1 == p2
then do
unsetMarkB -- Should really be called unsetSelectionMarkB?
moveTo p1
else if abs (startIndex - p2) < min (abs (startIndex - p1)) 2
then setSelectionMarkPointB p2 >> moveTo p1
else setSelectionMarkPointB p1 >> moveTo p2
------------------------------------------------------------------------
data UI = forall action. UI {
uiWindow :: NSWindow ()
,uiBox :: NSSplitView ()
,uiCmdLine :: NSTextField ()
,uiBuffers :: IORef (M.Map BufferRef (NSTextStorage ()))
,windowCache :: IORef [WinInfo]
,uiRunEditor :: EditorM () -> IO ()
,uiLock :: MVar ()
}
data WinInfo = WinInfo
{
bufkey :: !BufferRef -- ^ the buffer this window opens to
,wkey :: !Unique
,textview :: YiTextView ()
,modeline :: NSTextField ()
,widget :: NSView () -- ^ Top-level widget for this window.
,isMini :: Bool
}
instance Show WinInfo where
show w = "W" ++ show (hashUnique $ wkey w) ++ " on " ++ show (bufkey w)
-- | Get the identification of a window.
winkey :: WinInfo -> (Bool, BufferRef)
winkey w = (isMini w, bufkey w)
mkUI :: UI -> Common.UI
mkUI ui = Common.UI
{
Common.main = main ui,
Common.end = end ,
Common.suspend = uiWindow ui # performMiniaturize nil,
Common.refresh = refresh ui,
Common.prepareAction = prepareAction ui
}
rect :: Float -> Float -> Float -> Float -> NSRect
rect x y w h = NSRect (NSPoint x y) (NSSize w h)
new, autonew :: forall t. Class (NSObject_ t) -> IO (NSObject t)
new x = do
d <- description x >>= haskellString
o <- alloc x
logPutStrLn $ "New " ++ d
init o
autonew x = new x >>= autoreleased
autoreleased :: forall t. NSObject t -> IO (NSObject t)
autoreleased o = do
retain o
autorelease o
return o
allSizable, normalWindowMask :: CUInt
allSizable = nsViewWidthSizable .|. nsViewHeightSizable
normalWindowMask =
nsTitledWindowMask .|. nsResizableWindowMask .|. nsClosableWindowMask .|. nsMiniaturizableWindowMask
initWithContentRect :: NSRect -> NewlyAllocated (NSWindow ()) -> IO (NSWindow ())
initWithContentRect r =
initWithContentRectStyleMaskBackingDefer r normalWindowMask nsBackingStoreBuffered True
width, height :: NSRect -> Float
width (NSRect _ (NSSize w _)) = w
height (NSRect _ (NSSize _ h)) = h
toNSView :: forall t. ID () -> NSView t
toNSView = castObject
toYiApplication :: forall t1 t2. NSApplication t1 -> YiApplication t2
toYiApplication = castObject
toYiController :: forall t1 t2. NSObject t1 -> YiController t2
toYiController = castObject
setMonospaceFont :: Has_setFont v => v -> IO ()
setMonospaceFont view = do
f <- _NSFont # userFixedPitchFontOfSize 0.0
setFont f view
newTextLine :: IO (NSTextField ())
newTextLine = do
tl <- new _NSTextField
tl # setAlignment nsLeftTextAlignment
tl # setAutoresizingMask (nsViewWidthSizable .|. nsViewMaxYMargin)
tl # setMonospaceFont
tl # setSelectable True
tl # setEditable False
tl # sizeToFit
return tl
addSubviewWithTextLine :: forall t1 t2. NSView t1 -> NSView t2 -> IO (NSTextField (), NSView ())
addSubviewWithTextLine view parent = do
container <- new _NSView
parent # bounds >>= flip setFrame container
container # setAutoresizingMask allSizable
view # setAutoresizingMask allSizable
container # addSubview view
text <- newTextLine
container # addSubview text
parent # addSubview container
-- Adjust frame sizes, as superb cocoa cannot do this itself...
txtbox <- text # frame
winbox <- container # bounds
view # setFrame (rect 0 (height txtbox) (width winbox) (height winbox - height txtbox))
text # setFrame (rect 0 0 (width winbox) (height txtbox))
return (text, container)
-- | Initialise the ui
start :: Chan Yi.Event.Event -> Chan action ->
Editor -> (EditorM () -> action) ->
IO Common.UI
start ch outCh _ed runEd = do
-- Ensure that our command line application is also treated as a gui application
fptr <- mallocForeignPtrBytes 32 -- way to many bytes, but hey...
withForeignPtr fptr $ getCurrentProcess
withForeignPtr fptr $ (flip transformProcessType) 1
withForeignPtr fptr $ setFrontProcess
-- Publish Objective-C classes...
initializeClass_YiApplication
initializeClass_YiController
initializeClass_YiTextView
app <- _YiApplication # sharedApplication >>= return . toYiApplication
app # setIVar _eventChannel (Just ch)
lock <- newMVar ()
app # setIVar _lock (Just lock)
icon <- getDataFileName "art/yi+lambda-fat.pdf"
_NSImage # alloc >>=
initWithContentsOfFile (toNSString icon) >>=
flip setApplicationIconImage app
-- Initialize the app delegate, which allows quit-on-window-close
controller <- autonew _YiController >>= return . toYiController
app # setDelegate controller
-- init menus
mm <- _NSMenu # alloc >>= init
mm' <- _NSMenu # alloc >>= init
mm'' <- _NSMenu # alloc >>= init
app # setMainMenu mm
app # setAppleMenu mm'
app # setWindowsMenu mm''
-- Create main cocoa window...
win <- _NSWindow # alloc >>= initWithContentRect (rect 0 0 480 340)
win # setTitle (toNSString "Yi")
content <- win # contentView >>= return . toNSView
content # setAutoresizingMask allSizable
-- Create yi window container
winContainer <- new _NSSplitView
(cmd,_) <- content # addSubviewWithTextLine winContainer
-- Activate application window
win # center
win # setFrameAutosaveName (toNSString "main")
win # makeKeyAndOrderFront nil
app # activateIgnoringOtherApps False
bufs <- newIORef M.empty
wc <- newIORef []
return (mkUI $ UI win winContainer cmd bufs wc (writeChan outCh . runEd) lock)
-- | Run the main loop
main :: UI -> IO ()
main ui = do
takeMVar (uiLock ui)
logPutStrLn "Cocoa main loop running"
_YiApplication # sharedApplication >>= run
-- | Clean up and go home
end :: IO ()
end = _YiApplication # sharedApplication >>= terminate_ nil
syncWindows :: Editor -> UI -> [(Window, Bool)] -> [WinInfo] -> IO [WinInfo]
syncWindows e ui (wfocused@(w,focused):ws) (c:cs)
| Window.winkey w == winkey c = do when focused (setFocus c)
return (c:) `ap` syncWindows e ui ws cs
| Window.winkey w `elem` map winkey cs = removeWindow ui c >> syncWindows e ui (wfocused:ws) cs
| otherwise = do c' <- insertWindowBefore e ui w c
when focused (setFocus c')
return (c':) `ap` syncWindows e ui ws (c:cs)
syncWindows e ui ws [] = mapM (insertWindowAtEnd e ui) (map fst ws)
syncWindows _e ui [] cs = mapM_ (removeWindow ui) cs >> return []
setFocus :: WinInfo -> IO ()
setFocus w = do
logPutStrLn $ "Cocoa focusing " ++ show w
(textview w) # NSView.window >>= makeFirstResponder (textview w) >> return ()
removeWindow :: UI -> WinInfo -> IO ()
removeWindow _i win = (widget win) # removeFromSuperview
-- | Make A new window
newWindow :: UI -> Bool -> FBuffer -> IO WinInfo
newWindow ui mini b = do
v <- alloc _YiTextView >>= initWithFrame (rect 0 0 100 100)
v # setRichText False
v # setSelectable True
v # setAlignment nsLeftTextAlignment
v # sizeToFit
v # setIVar _runBuffer ((uiRunEditor ui) . withGivenBuffer0 (keyB b))
(ml, view) <- if mini
then do
v # setHorizontallyResizable False
v # setVerticallyResizable False
prompt <- newTextLine
prompt # setStringValue (toNSString (name b))
prompt # sizeToFit
prompt # setAutoresizingMask nsViewNotSizable
prect <- prompt # frame
vrect <- v # frame
hb <- _NSView # alloc >>= initWithFrame (rect 0 0 (width prect + width vrect) (height prect))
v # setFrame (rect (width prect) 0 (width vrect) (height prect))
v # setAutoresizingMask nsViewWidthSizable
hb # addSubview prompt
hb # addSubview v
hb # setAutoresizingMask nsViewWidthSizable
brect <- (uiBox ui) # bounds
hb # setFrame (rect 0 0 (width brect) (height prect))
(uiBox ui) # addSubview hb
dummy <- _NSTextField # alloc >>= init
return (dummy, hb)
else do
v # setHorizontallyResizable True
v # setVerticallyResizable True
scroll <- new _NSScrollView
scroll # setDocumentView v
scroll # setAutoresizingMask allSizable
scroll # setHasVerticalScroller True
scroll # setHasHorizontalScroller False
scroll # setAutohidesScrollers False
addSubviewWithTextLine scroll (uiBox ui)
storage <- getTextStorage ui b
layoutManager v >>= replaceTextStorage storage
k <- newUnique
let win = WinInfo {
bufkey = (keyB b)
,wkey = k
,textview = v
,modeline = ml
,widget = view
,isMini = mini
}
return win
insertWindowBefore :: Editor -> UI -> Window -> WinInfo -> IO WinInfo
insertWindowBefore e i w _c = insertWindow e i w
insertWindowAtEnd :: Editor -> UI -> Window -> IO WinInfo
insertWindowAtEnd e i w = insertWindow e i w
insertWindow :: Editor -> UI -> Window -> IO WinInfo
insertWindow e i win = do
let buf = findBufferWith (Window.bufkey win) e
liftIO $ newWindow i (Window.isMini win) buf
refresh :: UI -> Editor -> IO ()
refresh ui e = withMVar (uiLock ui) $ \_ -> logNSException "refresh" $ do
let ws = Editor.windows e
let takeEllipsis s = if length s > 132 then take 129 s ++ "..." else s
(uiCmdLine ui) # setStringValue (toNSString (takeEllipsis (statusLine e)))
cache <- readRef $ windowCache ui
forM_ (buffers e) $ \buf -> when (not $ null $ pendingUpdates $ buf) $ do
storage <- getTextStorage ui buf
storage # beginEditing
forM_ (pendingUpdates buf) $ applyUpdate storage
storage # endEditing
contents <- storage # string >>= haskellString
storage # setMonospaceFont -- FIXME: Why is this needed for mini buffers?
let ((size,p),_) = runBufferDummyWindow buf ((,) <$> sizeB <*> pointB)
replaceTagsIn (inBounds (p-100) size) (inBounds (p+100) size) buf storage
(uiWindow ui) # setAutodisplay False -- avoid redrawing while window syncing
WS.debug "syncing" ws
logPutStrLn $ "with: " ++ show cache
cache' <- syncWindows e ui (toList $ WS.withFocus $ ws) cache
logPutStrLn $ "Yields: " ++ show cache'
writeRef (windowCache ui) cache'
(uiBox ui) # adjustSubviews -- FIX: maybe it is not needed
(uiWindow ui) # setAutodisplay True -- reenable automatic redrawing
forM_ cache' $ \w ->
do let buf = findBufferWith (bufkey w) e
let (p0, _) = runBufferDummyWindow buf pointB
let (p1, _) = runBufferDummyWindow buf (getSelectionMarkB >>= getMarkPointB)
(textview w) # setSelectedRange (NSRange (toEnum $ min p0 p1) (toEnum $ abs $ p1-p0))
(textview w) # scrollRangeToVisible (NSRange (toEnum p0) 0)
let (txt, _) = runBufferDummyWindow buf getModeLine
(modeline w) # setStringValue (toNSString txt)
replaceTagsIn :: forall t. Point -> Point -> FBuffer -> NSTextStorage t -> IO ()
replaceTagsIn from to buf storage = do
let (styleSpans, _) = runBufferDummyWindow buf (styleRangesB (to - from) from)
forM_ (zip styleSpans (drop 1 styleSpans)) $ \((l,Style fg bg),(r,_)) -> do
logPutStrLn $ "Setting style " ++ show fg ++ show bg ++ " on " ++ show l ++ " - " ++ show r
fg' <- color True fg
bg' <- color False bg
let range = NSRange (toEnum l) (toEnum $ r-l)
storage # addAttributeValueRange nsForegroundColorAttributeName fg' range
storage # addAttributeValueRange nsBackgroundColorAttributeName bg' range
where
color fg Default = if fg then _NSColor # blackColor else _NSColor # whiteColor
color fg Reverse = if fg then _NSColor # whiteColor else _NSColor # blackColor
color _g (RGB r g b) = _NSColor # colorWithDeviceRedGreenBlueAlpha ((fromIntegral r)/255) ((fromIntegral g)/255) ((fromIntegral b)/255) 1.0
applyUpdate :: NSTextStorage () -> Update -> IO ()
applyUpdate buf (Insert p s) =
buf # mutableString >>= insertStringAtIndex (toNSString s) (toEnum p)
applyUpdate buf (Delete p s) =
buf # mutableString >>= deleteCharactersInRange (NSRange (toEnum p) (toEnum s))
prepareAction :: UI -> IO (EditorM ())
prepareAction _ui = return (return ())
-- NSRange visibleGlyphRange, visibleCharRange;
-- NSLayoutManager *layoutManager = [textView layoutManager];
-- NSTextContainer *textContainer = [textView textContainer];
-- NSPoint containerOrigin = [textView textContainerOrigin];
-- NSRect visibleRect = [textView visibleRect];
--
-- visibleRect.origin.x -= containerOrigin.x; // convert from view
--coordinates to container coordinates
-- visibleRect.origin.y -= containerOrigin.y;
-- visibleGlyphRange = [layoutManager
--glyphRangeForBoundingRect:visibleRect inTextContainer:textContainer];
-- visibleCharRange = [layoutManager
--characterRangeForGlyphRange:visibleGlyphRange actualGlyphRange:NULL];
--do
-- gtkWins <- readRef (windowCache ui)
-- heights <- forM gtkWins $ \w -> do
-- let gtkWin = textview w
-- d <- widgetGetDrawWindow gtkWin
-- (_w,h) <- drawableGetSize d
-- (_,y0) <- textViewWindowToBufferCoords gtkWin TextWindowText (0,0)
-- (i0,_) <- textViewGetLineAtY gtkWin y0
-- l0 <- get i0 textIterLine
-- (_,y1) <- textViewWindowToBufferCoords gtkWin TextWindowText (0,h)
-- (i1,_) <- textViewGetLineAtY gtkWin y1
-- l1 <- get i1 textIterLine
-- return (l1 - l0)
-- modifyMVar (windows ui) $ \ws -> do
-- let (ws', _) = runState (mapM distribute ws) heights
-- return (ws', setBuffer (Window.bufkey $ WS.current ws') >> return ())
--
--distribute :: Window -> State [Int] Window
--distribute win = do
-- h <- gets head
-- modify tail
-- return win {Window.height = h}
getTextStorage :: UI -> FBuffer -> IO (NSTextStorage ())
getTextStorage ui b = do
let bufsRef = uiBuffers ui
bufs <- readRef bufsRef
storage <- case M.lookup (bkey b) bufs of
Just storage -> return storage
Nothing -> newTextStorage ui b
modifyRef bufsRef (M.insert (bkey b) storage)
return storage
newTextStorage :: UI -> FBuffer -> IO (NSTextStorage ())
newTextStorage _ui b = do
buf <- new _NSTextStorage
let (txt, _) = runBufferDummyWindow b (revertPendingUpdatesB >> elemsB)
buf # mutableString >>= setString (toNSString txt)
buf # setMonospaceFont
replaceTagsIn 0 (length txt) b buf
return buf
-- Debugging helpers
{-
data Hierarchy = View String NSRect [Hierarchy]
deriving Show
haskellList :: forall t1. NSArray t1 -> IO [ID ()]
haskellList a = a # objectEnumerator >>= helper
where
helper enum = do
e <- enum # nextObject
if e == nil
then return []
else helper enum >>= return . (e :)
mkHierarchy :: forall t. NSView t -> IO Hierarchy
mkHierarchy v = do
d <- v # description >>= haskellString
f <- v # frame
ss <- v # subviews >>= haskellList >>= mapM (mkHierarchy . toNSView)
return $ View d f ss
-}