Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
| f3cae4d09a |
12 changed files with 20 additions and 982 deletions
|
|
@ -1,122 +0,0 @@
|
|||
{-# OPTIONS_GHC -fplugin=LiquidHaskell #-}
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
|
||||
module LiquidExamples where
|
||||
import qualified Data.Vector as V
|
||||
import Foreign
|
||||
import Foreign.C.Types
|
||||
|
||||
|
||||
-- defining new types
|
||||
{-@ type Zero = {v:Int | v == 0} @-}
|
||||
{-@ type NonZero = {v:Int | v /= 0} @-}
|
||||
|
||||
|
||||
-- this is impossible to occur.
|
||||
-- meaning that programs with errors wont compile.
|
||||
{-@ die :: {v:String | false} -> a @-}
|
||||
die msg = error msg
|
||||
|
||||
|
||||
{-@ type TRUE = {v:Bool | v} @-}
|
||||
{-@ type FALSE = {v:Bool | not v} @-}
|
||||
|
||||
|
||||
{-@ ax0 :: TRUE @-}
|
||||
ax0 = 1 + 1 == 2
|
||||
|
||||
{-@ measure size @-}
|
||||
{-@ size :: [a] -> Nat @-}
|
||||
size :: [a] -> Int
|
||||
size [] = 0
|
||||
size (x:xs) = 1 + size xs
|
||||
|
||||
cannotDie = if 1 + 1 == 3
|
||||
then die "horrible death"
|
||||
else ()
|
||||
|
||||
-- canDie = if 1 + 1 == 2
|
||||
-- then die "horrible death"
|
||||
-- else ()
|
||||
|
||||
|
||||
|
||||
-- we can also use a pre-condition to say that it must be a nonzero
|
||||
{-@ divide :: Int -> NonZero -> Int @-}
|
||||
divide :: Int -> Int -> Int
|
||||
divide n d = n `div` d
|
||||
|
||||
|
||||
-- if you put zero at the end , it wont compile
|
||||
avg2 x y = divide (x + y) 2
|
||||
avg3 x y z = divide (x + y + z) 3
|
||||
|
||||
|
||||
-- here we could use "die" , because it's impossible to reach it.
|
||||
{-@ avg :: {xs:[Int] | len xs > 0} -> Int @-}
|
||||
avg :: [Int] -> Int
|
||||
avg [] = die "cannot average empty list"
|
||||
avg xs = divide total n
|
||||
where
|
||||
total = sum xs
|
||||
n = length xs
|
||||
|
||||
|
||||
{-@ abs :: Int -> Nat @-}
|
||||
abs :: Int -> Int
|
||||
abs n
|
||||
| 0 < n = n
|
||||
| otherwise = 0 - n -- indeed, this is non-negative
|
||||
|
||||
|
||||
{-@ type NEVector a = {v:Vector a | 0 < vlen v} @-}
|
||||
|
||||
|
||||
head'' :: V.Vector a -> Maybe a
|
||||
head'' v
|
||||
| V.length v > 0 = Just (v V.! 0)
|
||||
| otherwise = Nothing
|
||||
|
||||
-- unsafe here means no bounds check
|
||||
-- my fix was making the refinement type same as the concrete one
|
||||
{-@ unsafeLookup :: Nat -> V.Vector a -> a @-}
|
||||
unsafeLookup :: Int -> V.Vector a -> a
|
||||
unsafeLookup index vec = vec V.! index
|
||||
|
||||
|
||||
-- needs to be a measure, cannot be written in refinement
|
||||
{-@ measure vlen :: V.Vector a -> Int @-} -- type annotation
|
||||
vlen :: V.Vector a -> Int -- Haskell definition
|
||||
vlen v = V.length v
|
||||
|
||||
-- this assumes that vlen is always greater than zero, but what if the vector is empty?
|
||||
{-@ safeLookup :: {v:V.Vector a | 0 < vlen v} -> {i:Int | 0 <= i && i < vlen v} -> Maybe a @-}
|
||||
safeLookup x i
|
||||
| ok = Just (x V.! i) -- this doesnt mean equality
|
||||
| otherwise = Nothing
|
||||
where
|
||||
ok = V.length x > 0
|
||||
|
||||
----
|
||||
---- Pointers
|
||||
|
||||
|
||||
-- | A pointer tagged with its size
|
||||
{-@ data PtrSized a = PtrSized { ptrData :: Ptr a , ptrSz :: {n:Int | n >= 0}} @-}
|
||||
data PtrSized a = PtrSized
|
||||
{ ptrData :: Ptr a
|
||||
, ptrSz :: Int
|
||||
}
|
||||
|
||||
|
||||
{-@ type SafeIndex v = {i:Int | 0 <= i && i < ptrSz v} @-}
|
||||
|
||||
{-@ peekElemN :: Storable a
|
||||
=> v:PtrSized a
|
||||
-> SafeIndex v
|
||||
-> IO a
|
||||
@-}
|
||||
peekElemN :: Storable a => PtrSized a -> Int -> IO a
|
||||
peekElemN (PtrSized p _) i = peekElemOff p i
|
||||
57
appleKit.hs
57
appleKit.hs
|
|
@ -1,57 +0,0 @@
|
|||
{-
|
||||
|
||||
install my lib: https://github.com/KonstantinDjairo/haskell-obj-c
|
||||
|
||||
then:
|
||||
|
||||
$ ghc -package-env - appleKit.hs -o hello \
|
||||
-package haskell-obj-c \
|
||||
-package libffi \
|
||||
-framework AppKit
|
||||
|
||||
|
||||
-}
|
||||
|
||||
|
||||
import Foreign.C.String (withCString)
|
||||
import Foreign.LibFFI (argPtr, retPtr, retVoid, retCULong)
|
||||
import Foreign.Ptr (castPtr)
|
||||
import ObjC.Runtime
|
||||
|
||||
main :: IO ()
|
||||
main = withAutoreleasePool $ do
|
||||
loadFramework "AppKit"
|
||||
|
||||
appClass <- getRequiredClass "NSApplication"
|
||||
_ <- sendClassMsg appClass (mkSelector "sharedApplication")
|
||||
(retPtr retVoid) []
|
||||
|
||||
alertClass <- getRequiredClass "NSAlert"
|
||||
alertPtr <- sendClassMsg alertClass (mkSelector "new")
|
||||
(retPtr retVoid) []
|
||||
let alert = RawId (castPtr alertPtr)
|
||||
|
||||
stringClass <- getRequiredClass "NSString"
|
||||
title <- makeString stringClass "Hello from Haskell"
|
||||
detail <- makeString stringClass "RawId-only AppKit test."
|
||||
|
||||
let RawId titlePtr = title
|
||||
RawId detailPtr = detail
|
||||
|
||||
_ <- sendRawMsg alert (mkSelector "setMessageText:")
|
||||
retVoid [argPtr titlePtr]
|
||||
|
||||
_ <- sendRawMsg alert (mkSelector "setInformativeText:")
|
||||
retVoid [argPtr detailPtr]
|
||||
|
||||
_ <- sendRawMsg alert (mkSelector "runModal")
|
||||
retCULong []
|
||||
|
||||
pure ()
|
||||
|
||||
makeString :: Class -> String -> IO RawId
|
||||
makeString cls s =
|
||||
withCString s $ \cs -> do
|
||||
ptr <- sendClassMsg cls (mkSelector "stringWithUTF8String:")
|
||||
(retPtr retVoid) [argPtr cs]
|
||||
pure (RawId (castPtr ptr))
|
||||
154
appleKitHello.hs
154
appleKitHello.hs
|
|
@ -1,154 +0,0 @@
|
|||
-- originally made by Ian Duncan
|
||||
|
||||
|
||||
{-
|
||||
|
||||
install my lib: https://github.com/KonstantinDjairo/haskell-obj-c
|
||||
|
||||
make sure all the dependencies can be seen (as in being visible).
|
||||
in some cases there are bugs in visibility, an example of how to solve is:
|
||||
|
||||
ENV="$HOME/.ghc/x86_64-darwin-9.14.1/environments/default"
|
||||
LOCAL=".ghc.environment.x86_64-darwin-9.14.1"
|
||||
|
||||
cp "$ENV" "$LOCAL"
|
||||
|
||||
cat >> "$LOCAL" <<'EOF'
|
||||
package-id haskell-obj-c-0.1.0.0-Bz2BQgarUWfIjLViTQm4VB
|
||||
package-id libffi-0.2.1-8ww0PruNfptGqXPccO6KJj
|
||||
EOF
|
||||
|
||||
|
||||
then conpile:
|
||||
|
||||
$ ghc -fforce-recomp appleKitHello.hs -o hello -framework AppKit
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import Foreign.Ptr (nullPtr)
|
||||
|
||||
import ObjC.Runtime
|
||||
|
||||
-- Generated bindings — types and enums from per-class modules
|
||||
import ObjC.AppKit.NSApplication
|
||||
( NSApplication
|
||||
, pattern NSApplicationActivationPolicyRegular
|
||||
)
|
||||
import ObjC.AppKit.NSWindow
|
||||
( NSWindow
|
||||
, pattern NSWindowStyleMaskTitled
|
||||
, pattern NSWindowStyleMaskClosable
|
||||
, pattern NSWindowStyleMaskMiniaturizable
|
||||
, pattern NSWindowStyleMaskResizable
|
||||
, pattern NSBackingStoreBuffered
|
||||
)
|
||||
import ObjC.AppKit.NSTextField (NSTextField)
|
||||
import ObjC.AppKit.NSMenu (NSMenu)
|
||||
import ObjC.AppKit.NSMenuItem (NSMenuItem)
|
||||
import ObjC.AppKit.NSView (IsNSView(toNSView))
|
||||
import ObjC.Foundation.NSString (NSString) -- IsString (Id NSString) instance
|
||||
import ObjC.Foundation.Structs (NSRect(..), NSPoint(..), NSSize(..))
|
||||
|
||||
-- Generated bindings — methods (qualified)
|
||||
import qualified ObjC.AppKit.NSApplication as App
|
||||
import qualified ObjC.AppKit.NSWindow as Win
|
||||
import qualified ObjC.AppKit.NSTextField as TF
|
||||
import qualified ObjC.AppKit.NSView as View
|
||||
import qualified ObjC.AppKit.NSMenu as Menu
|
||||
import qualified ObjC.AppKit.NSMenuItem as MI
|
||||
import qualified ObjC.AppKit.NSControl as Ctrl
|
||||
import qualified ObjC.AppKit.NSFont as Font
|
||||
import ObjC.AppKit.Delegate.NSApplicationDelegate
|
||||
( NSApplicationDelegateOverrides(..)
|
||||
, defaultNSApplicationDelegateOverrides
|
||||
, newNSApplicationDelegate
|
||||
)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = withAutoreleasePool $ do
|
||||
loadFramework "AppKit"
|
||||
|
||||
-- [NSApplication sharedApplication]
|
||||
app <- App.sharedApplication
|
||||
|
||||
_ <- App.setActivationPolicy app NSApplicationActivationPolicyRegular
|
||||
|
||||
setupMenuBar app
|
||||
|
||||
-- Create the window
|
||||
let styleMask = NSWindowStyleMaskTitled <> NSWindowStyleMaskClosable
|
||||
<> NSWindowStyleMaskMiniaturizable <> NSWindowStyleMaskResizable
|
||||
backing = NSBackingStoreBuffered
|
||||
rect = NSRect (NSPoint 200 200) (NSSize 480 260)
|
||||
|
||||
window <- (alloc @NSWindow >>=
|
||||
\w -> Win.initWithContentRect_styleMask_backing_defer w rect styleMask backing False)
|
||||
Win.center window
|
||||
Win.setReleasedWhenClosed window False
|
||||
|
||||
Win.setTitle window ("Hello Haskell" :: Id NSString)
|
||||
|
||||
-- Create a label
|
||||
label <- TF.labelWithString ("Hello, World from Haskell!" :: Id NSString) :: IO (Id NSTextField)
|
||||
|
||||
-- Position the label within the window
|
||||
let labelRect = NSRect (NSPoint 40 80) (NSSize 400 100)
|
||||
View.setFrame label labelRect
|
||||
|
||||
-- Set the font to system 32pt
|
||||
font <- Font.systemFontOfSize 32
|
||||
Ctrl.setFont label font
|
||||
|
||||
Ctrl.setAlignment label Ctrl.NSTextAlignmentCenter
|
||||
|
||||
-- Add the label to the window's content view
|
||||
cv <- Win.contentView window
|
||||
View.addSubview cv (toNSView label)
|
||||
|
||||
appDelegate <- newNSApplicationDelegate defaultNSApplicationDelegateOverrides
|
||||
{ _applicationShouldTerminateAfterLastWindowClosed = Just (const (pure False))
|
||||
, _applicationShouldHandleReopen_hasVisibleWindows = Just $ \_ hasVisible ->
|
||||
if hasVisible then pure True
|
||||
else Win.makeKeyAndOrderFront window (RawId nullPtr) >> pure True
|
||||
}
|
||||
App.setDelegate app appDelegate
|
||||
|
||||
Win.makeKeyAndOrderFront window (RawId nullPtr)
|
||||
App.activateIgnoringOtherApps app True
|
||||
|
||||
-- Enter the AppKit run loop (blocks until app quits)
|
||||
App.run app
|
||||
|
||||
|
||||
-- | Set up a minimal menu bar with an application menu containing Quit (Cmd+Q).
|
||||
setupMenuBar :: Id NSApplication -> IO ()
|
||||
setupMenuBar app = do
|
||||
-- Menu bar
|
||||
menuBar <- alloc @NSMenu >>= \m -> Menu.initWithTitle m ("" :: Id NSString)
|
||||
|
||||
-- App menu item (container in the menu bar) — plain -init.
|
||||
appMenuItem <- new @NSMenuItem
|
||||
|
||||
Menu.addItem menuBar appMenuItem
|
||||
|
||||
-- App submenu
|
||||
appMenu <- alloc @NSMenu >>= \m -> Menu.initWithTitle m ("App" :: Id NSString)
|
||||
|
||||
-- "Quit" item with Cmd+Q
|
||||
quitItem <- alloc @NSMenuItem >>=
|
||||
\mi -> MI.initWithTitle_action_keyEquivalent mi ("Quit" :: Id NSString) (asSel App.terminateSelector) ("q" :: Id NSString)
|
||||
|
||||
Menu.addItem appMenu quitItem
|
||||
|
||||
-- Wire submenu and set the menu bar
|
||||
Menu.setSubmenu_forItem menuBar appMenu appMenuItem
|
||||
App.setMainMenu app menuBar
|
||||
|
|
@ -1,73 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Data.GI.Base (castTo)
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gdk as Gdk
|
||||
import qualified GI.GdkX11 as GdkX11
|
||||
import GI.GLib (mainContextInvokeFull)
|
||||
import GI.Gio
|
||||
import Control.Monad (void)
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Ptr (castPtr)
|
||||
import Foreign.C.Types (CULong)
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (xChangeProperty, propModeReplace)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Gtk.Application [#applicationId := "org.example.test"]
|
||||
|
||||
on app #activate $ do
|
||||
win <- new Gtk.ApplicationWindow
|
||||
[ #application := app
|
||||
, #title := "Dialog Window"
|
||||
, #defaultWidth := 400
|
||||
, #defaultHeight := 100
|
||||
, #resizable := False
|
||||
, #decorated := False
|
||||
]
|
||||
|
||||
|
||||
Gtk.windowSetDefaultSize win 400 100
|
||||
|
||||
|
||||
-- run in main context; returns IO Bool
|
||||
void $ mainContextInvokeFull Nothing (-99) $ do
|
||||
_ <- on win #realize $ do
|
||||
mSurface <- #getSurface win
|
||||
case mSurface of
|
||||
Just surface -> do
|
||||
mX11Surface <- castTo GdkX11.X11Surface surface
|
||||
display <- Gdk.surfaceGetDisplay surface
|
||||
mX11Display <- castTo GdkX11.X11Display display
|
||||
|
||||
case (mX11Display, mX11Surface) of
|
||||
(Just _gdkX11Disp, Just x11Surf) -> do
|
||||
xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
|
||||
|
||||
dpy <- openDisplay ""
|
||||
|
||||
atomType <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
|
||||
atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
|
||||
atomAtom <- internAtom dpy "ATOM" False
|
||||
|
||||
withArray [atomDialog] $ \ptr -> do
|
||||
let winX = fromIntegral (xidCULong :: CULong) :: Window
|
||||
void $ xChangeProperty dpy winX atomType atomAtom 32 propModeReplace (castPtr ptr) 1
|
||||
flush dpy
|
||||
|
||||
closeDisplay dpy
|
||||
_ -> putStrLn "Not running under X11."
|
||||
Nothing -> putStrLn "No surface available"
|
||||
|
||||
pure () -- <--- important: SourceFunc expects IO Bool
|
||||
|
||||
return False -- just indicate mainContextInvokeFull call succeeded
|
||||
|
||||
#realize win
|
||||
Gtk.widgetShow win
|
||||
|
||||
void $ applicationRun app Nothing
|
||||
|
|
@ -1,106 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Data.GI.Base (castTo)
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gdk as Gdk
|
||||
import qualified GI.GdkX11 as GdkX11
|
||||
import GI.GLib (mainContextInvokeFull)
|
||||
import Data.GI.Base.Signals
|
||||
import GI.Gio
|
||||
import Control.Monad (void)
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Ptr (castPtr)
|
||||
import Foreign.C.Types (CULong)
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (xChangeProperty, propModeReplace)
|
||||
|
||||
-- Polymorphic: accepts any GTK window type
|
||||
setWindowAsDialog :: Gtk.IsWindow w => w -> IO ()
|
||||
setWindowAsDialog win = do
|
||||
-- upcast to concrete Gtk.Window right away (resolves ambiguity)
|
||||
wnd <- Gtk.toWindow win
|
||||
|
||||
-- now get surface with a concrete Window type in scope
|
||||
mSurface <- #getSurface wnd
|
||||
case mSurface of
|
||||
Just (surface :: Gdk.Surface) -> do
|
||||
-- cast to GDK X11 surface & display (explicit IO results)
|
||||
mX11Surface <- (castTo GdkX11.X11Surface surface) :: IO (Maybe GdkX11.X11Surface)
|
||||
display <- Gdk.surfaceGetDisplay surface
|
||||
mX11Display <- (castTo GdkX11.X11Display display) :: IO (Maybe GdkX11.X11Display)
|
||||
|
||||
case (mX11Display, mX11Surface) of
|
||||
(Just _gdkX11Disp, Just x11Surf) -> do
|
||||
-- get window XID and set ATOM via X11
|
||||
xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
|
||||
|
||||
dpy <- openDisplay ""
|
||||
atomType <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
|
||||
atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
|
||||
atomAtom <- internAtom dpy "ATOM" False
|
||||
|
||||
withArray [atomDialog] $ \ptr -> do
|
||||
let winX :: Window
|
||||
winX = fromIntegral (xidCULong :: CULong)
|
||||
void $ xChangeProperty dpy winX atomType atomAtom 32 propModeReplace (castPtr ptr) 1
|
||||
flush dpy
|
||||
|
||||
closeDisplay dpy
|
||||
_ -> putStrLn "Not running under X11."
|
||||
Nothing -> putStrLn "No surface available"
|
||||
|
||||
-- Polymorphic attach helper
|
||||
attachDialogOnRealize :: Gtk.IsWindow w => w -> IO SignalHandlerId
|
||||
attachDialogOnRealize win = do
|
||||
wnd <- Gtk.toWindow win
|
||||
on wnd #realize (setWindowAsDialog win)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Gtk.Application [#applicationId := "org.example.test"]
|
||||
|
||||
on app #activate $ do
|
||||
-- Main window
|
||||
win <- new Gtk.ApplicationWindow
|
||||
[ #application := app
|
||||
, #title := "Dialog Window"
|
||||
, #defaultWidth := 400
|
||||
, #defaultHeight := 100
|
||||
, #resizable := False
|
||||
, #decorated := False
|
||||
]
|
||||
Gtk.windowSetDefaultSize win 400 100
|
||||
void $ mainContextInvokeFull Nothing (-99) $ do
|
||||
_ <- attachDialogOnRealize win
|
||||
return False
|
||||
#realize win
|
||||
Gtk.widgetShow win
|
||||
|
||||
-- Spawn a dialog window
|
||||
dlg <- new Gtk.Dialog
|
||||
[ #transientFor := win -- dialog is attached to main window
|
||||
, #title := "This is a Dialog"
|
||||
, #modal := True
|
||||
, #resizable := False
|
||||
, #decorated := False
|
||||
]
|
||||
Gtk.windowSetDefaultSize dlg 300 80
|
||||
|
||||
-- Add a label with text inside the dialog
|
||||
contentArea <- Gtk.dialogGetContentArea dlg
|
||||
lbl <- new Gtk.Label [#label := "Hello, I am a dialog!"]
|
||||
Gtk.boxAppend contentArea lbl
|
||||
|
||||
-- Attach dialog X11 role
|
||||
void $ mainContextInvokeFull Nothing (-99) $ do
|
||||
_ <- attachDialogOnRealize dlg
|
||||
return False
|
||||
|
||||
#realize dlg
|
||||
Gtk.widgetShow dlg
|
||||
|
||||
void $ applicationRun app Nothing
|
||||
|
|
@ -8,23 +8,22 @@ module Main where
|
|||
|
||||
import qualified Data.Conduit.Combinators as CC
|
||||
import Data.Conduit
|
||||
import Data.Text (pack,unpack)
|
||||
import Data.Text
|
||||
import System.Environment (getArgs)
|
||||
import System.IO (stdout)
|
||||
import System.FilePath (takeExtension)
|
||||
import Conduit
|
||||
|
||||
-- | Recursively list all files in the given directory, streaming each file path as UTF-8 bytes to stdout.
|
||||
listFiles :: FilePath -> IO ()
|
||||
-- | Recursively list all files in the given directory
|
||||
listFiles :: FilePath -> IO [FilePath]
|
||||
listFiles dir = runConduitRes $
|
||||
-- 1) Walk the directory (produces `FilePath`)
|
||||
CC.sourceDirectoryDeep False dir
|
||||
.| -- 2) Filter *before* converting to Text
|
||||
filterC (\fp -> takeExtension fp == ".mdx")
|
||||
.| -- 3) Convert to Text, append newline, then encode
|
||||
CC.map (\fp -> pack fp <> "\n")
|
||||
.| CC.encodeUtf8
|
||||
.| CC.sinkHandle stdout
|
||||
.| filterC (\fp -> takeExtension fp == ".mdx")
|
||||
{- .| CC.sinkList -- we probably want to enrich the pipeline by not storing things until we're done processing them.
|
||||
-- what i mean is that we didnt build the necessary data for constructing the program yet.
|
||||
-}
|
||||
.| CC.iterM -- IMPLEMENT function here
|
||||
|
||||
|
||||
|
||||
-- | Entry point: use first CLI argument as directory, defaulting to current directory.
|
||||
|
|
@ -34,4 +33,5 @@ main = do
|
|||
let targetDir = case args of
|
||||
(d:_) -> d
|
||||
[] -> "."
|
||||
listFiles targetDir
|
||||
paths <- listFiles targetDir
|
||||
mapM_ putStrLn paths
|
||||
|
|
|
|||
|
|
@ -1,47 +1,22 @@
|
|||
-- Copyright © 2025 Hashirama Senju
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
|
||||
|
||||
import Control.Concurrent
|
||||
import GI.Gtk
|
||||
import GI.Gtk
|
||||
import GI.Gio hiding (Application)
|
||||
import qualified GI.Gtk as GTK
|
||||
import Control.Monad (when, void, mzero, guard)
|
||||
import Data.Foldable (for_)
|
||||
import System.Directory (doesDirectoryExist, listDirectory)
|
||||
import System.FilePath ((</>))
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
||||
|
||||
|
||||
selectFolder :: FileDialog -> ApplicationWindow -> (Maybe String -> IO ()) -> IO ()
|
||||
selectFolder fd w k =
|
||||
fileDialogSelectFolder fd (Just w) (Nothing :: Maybe Cancellable) $ Just $ \_ r -> do
|
||||
mbPath <- runMaybeT $ do
|
||||
f <- MaybeT $ handleDialogError (\_ _ -> pure Nothing) (fileDialogSelectFolderFinish fd r)
|
||||
p <- MaybeT $ fileGetPath f
|
||||
p <$ (liftIO (doesDirectoryExist p) >>= guard)
|
||||
k mbPath
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Application []
|
||||
onApplicationActivate app $ do
|
||||
|
||||
w <- new GI.Gtk.ApplicationWindow [#application := app,#title := "Wazajisho"]
|
||||
fd <- GTK.fileDialogNew
|
||||
GTK.fileDialogSetTitle fd "Select folder..."
|
||||
GTK.fileDialogSetModal fd True
|
||||
GTK.fileDialogSetAcceptLabel fd (Just "Select")
|
||||
|
||||
selectFolder fd w $ \mbPath -> case mbPath of
|
||||
Just p -> putStrLn $ "Selected directory: " ++ p
|
||||
Nothing -> putStrLn "No valid directory selected"
|
||||
|
||||
dlg <- new FileDialog [fileDialogInitialFolder :=> fileNewForPath "/"]
|
||||
window <- new GI.Gtk.ApplicationWindow [#application := app,
|
||||
#title := "Wazajisho"]
|
||||
{-
|
||||
This type is defined in the GI.Gio library, which we're importing (with import GI.Gio hiding (Application)).
|
||||
It’s a common pattern in GTK and GIO for asynchronous functions to accept a cancellable object.
|
||||
-}
|
||||
fileDialogSelectFolder dlg (Just window) (Nothing :: Maybe Cancellable) Nothing
|
||||
|
||||
applicationRun app Nothing
|
||||
threadDelay 30000000000
|
||||
|
|
|
|||
|
|
@ -1,51 +0,0 @@
|
|||
-- Copyright © 2025 Hashirama Senju
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
|
||||
|
||||
import Control.Concurrent
|
||||
import GI.Gtk
|
||||
import GI.Gio hiding (Application)
|
||||
import qualified GI.Gtk as GTK
|
||||
import Control.Monad (when, void, mzero, guard)
|
||||
import Data.Foldable (for_)
|
||||
import System.Directory (doesDirectoryExist, listDirectory)
|
||||
import System.FilePath ((</>))
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
||||
import Wazahs
|
||||
|
||||
selectFolder :: FileDialog -> ApplicationWindow -> (Maybe String -> IO ()) -> IO ()
|
||||
selectFolder fd w k =
|
||||
fileDialogSelectFolder fd (Just w) (Nothing :: Maybe Cancellable) $ Just $ \_ r -> do
|
||||
mbPath <- runMaybeT $ do
|
||||
f <- MaybeT $ handleDialogError (\_ _ -> pure Nothing) (fileDialogSelectFolderFinish fd r)
|
||||
p <- MaybeT $ fileGetPath f
|
||||
p <$ (liftIO (doesDirectoryExist p) >>= guard)
|
||||
k mbPath
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Application []
|
||||
onApplicationActivate app $ do
|
||||
|
||||
w <- new GI.Gtk.ApplicationWindow [#application := app,#title := "Wazajisho"]
|
||||
fd <- GTK.fileDialogNew
|
||||
GTK.fileDialogSetTitle fd "Select folder..."
|
||||
GTK.fileDialogSetModal fd True
|
||||
GTK.fileDialogSetAcceptLabel fd (Just "Select")
|
||||
|
||||
selectFolder fd w $ maybe
|
||||
(putStrLn "No valid directory selected")
|
||||
(\dir -> do
|
||||
files <- listFiles dir
|
||||
putStrLn "Selected directory:"
|
||||
mapM_ putStrLn files)
|
||||
|
||||
|
||||
|
||||
applicationRun app Nothing
|
||||
threadDelay 30000000000
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Ptr (castPtr)
|
||||
import Control.Monad (void)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
dpy <- openDisplay ""
|
||||
|
||||
let screen = defaultScreen dpy -- pure value
|
||||
rootWin <- rootWindow dpy screen -- IO Window
|
||||
|
||||
win <- createSimpleWindow dpy rootWin 100 100 400 100 1 0 0
|
||||
|
||||
mapWindow dpy win
|
||||
|
||||
atomNetWm <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
|
||||
atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
|
||||
atomAtom <- internAtom dpy "ATOM" False
|
||||
|
||||
withArray [atomDialog] $ \ptr ->
|
||||
void $ xChangeProperty dpy win atomNetWm atomAtom 32 propModeReplace (castPtr ptr) 1
|
||||
|
||||
flush dpy
|
||||
|
||||
putStrLn "Window created. Press Enter to exit."
|
||||
_ <- getLine
|
||||
|
||||
destroyWindow dpy win
|
||||
closeDisplay dpy
|
||||
264
kanjiPicker.hs
264
kanjiPicker.hs
|
|
@ -1,264 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.GI.Base (castTo)
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gdk as Gdk
|
||||
import qualified GI.GdkX11 as GdkX11
|
||||
import GI.GLib (mainContextInvokeFull)
|
||||
import Data.GI.Base.Signals
|
||||
import GI.Gio
|
||||
import Control.Monad
|
||||
import Foreign.Marshal.Array (withArray)
|
||||
import Foreign.Ptr (castPtr)
|
||||
import Foreign.C.Types (CULong)
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (xChangeProperty, propModeReplace)
|
||||
|
||||
import Data.Char (chr, toUpper)
|
||||
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.IORef
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
-- createKanjiPickerDialog: parent must be a Gtk.Window (ApplicationWindow is fine)
|
||||
-- components: full list of Text radicals (no keys bound)
|
||||
createKanjiPickerDialog :: Gtk.Window -> [T.Text] -> IO Gtk.Dialog
|
||||
createKanjiPickerDialog parent components = do
|
||||
dlg <- new Gtk.Dialog
|
||||
[ #transientFor := parent
|
||||
, #title := "Kanji Components"
|
||||
, #modal := True
|
||||
, #defaultWidth := 480
|
||||
, #defaultHeight := 320
|
||||
, #resizable := False
|
||||
]
|
||||
|
||||
content <- Gtk.dialogGetContentArea dlg
|
||||
|
||||
-- UI top: pager controls and page label
|
||||
pagerBox <- new Gtk.Box [ #orientation := Gtk.OrientationHorizontal, #spacing := 8 ]
|
||||
prevBtn <- new Gtk.Button [ #label := "Prev" ]
|
||||
pageLbl <- new Gtk.Label [ #label := "" ]
|
||||
nextBtn <- new Gtk.Button [ #label := "Next" ]
|
||||
Gtk.boxAppend pagerBox prevBtn
|
||||
Gtk.boxAppend pagerBox pageLbl
|
||||
Gtk.boxAppend pagerBox nextBtn
|
||||
|
||||
-- area that will contain the dynamic grid (we will swap children)
|
||||
gridContainer <- new Gtk.Box [ #orientation := Gtk.OrientationVertical, #spacing := 6 ]
|
||||
|
||||
-- selected label
|
||||
selected <- new Gtk.Label [ #label := "Selected:" ]
|
||||
|
||||
-- available keys to zip with components on each page
|
||||
let keys :: [Char]
|
||||
keys = "ASDFGHJKLQWERTYUIOPZXCVBNM" -- change order / letters as you like
|
||||
|
||||
pageSize = length keys
|
||||
|
||||
totalPages = (length components + pageSize - 1) `div` pageSize
|
||||
|
||||
-- state
|
||||
pageRef <- newIORef (0 :: Int)
|
||||
keyMapRef <- newIORef (Map.empty :: Map Char T.Text)
|
||||
btnMapRef <- newIORef (Map.empty :: Map Char Gtk.Button)
|
||||
gridRef <- newIORef (Nothing :: Maybe Gtk.Widget)
|
||||
|
||||
-- append controls to dialog
|
||||
Gtk.boxAppend content pagerBox
|
||||
Gtk.boxAppend content gridContainer
|
||||
Gtk.boxAppend content selected
|
||||
|
||||
-- appendSelected appends into the selected label (shared by clicks & keys)
|
||||
let appendSelected txt = do
|
||||
old <- Gtk.labelGetText selected
|
||||
let stripped = T.strip old
|
||||
base = if stripped == "Selected:" then "" else T.drop (T.length "Selected: " ) stripped
|
||||
newt = if T.null base then txt else base <> " " <> txt
|
||||
Gtk.labelSetText selected ("Selected: " <> newt)
|
||||
|
||||
-- build a page grid for given page index and set key/button maps
|
||||
let buildPage :: Int -> IO Gtk.Grid
|
||||
buildPage p = do
|
||||
let start = p * pageSize
|
||||
pageItems = take pageSize (drop start components)
|
||||
pairs = zip keys pageItems -- dynamic zip: keys -> components on this page
|
||||
|
||||
grid <- new Gtk.Grid [ #rowSpacing := 8, #columnSpacing := 8 ]
|
||||
|
||||
-- reset maps for this page
|
||||
let emptyKeyMap = Map.empty :: Map Char T.Text
|
||||
writeIORef keyMapRef emptyKeyMap
|
||||
writeIORef btnMapRef Map.empty
|
||||
|
||||
forM_ (zip [0..] pairs) $ \(i, (k, comp)) -> do
|
||||
-- button with centered label for the kanji
|
||||
btn <- new Gtk.Button [ #hexpand := True, #vexpand := True ]
|
||||
lbl <- new Gtk.Label [ #label := comp ]
|
||||
Gtk.widgetSetHalign lbl Gtk.AlignCenter
|
||||
Gtk.widgetSetValign lbl Gtk.AlignCenter
|
||||
#setChild btn (Just lbl)
|
||||
|
||||
-- small key label in the corner (Overlay)
|
||||
overlay <- new Gtk.Overlay []
|
||||
Gtk.overlaySetChild overlay (Just btn)
|
||||
|
||||
keyLbl <- new Gtk.Label [ #label := T.singleton (toUpper k) ]
|
||||
Gtk.widgetSetHalign keyLbl Gtk.AlignEnd
|
||||
Gtk.widgetSetValign keyLbl Gtk.AlignEnd
|
||||
Gtk.widgetSetMarginEnd keyLbl 6
|
||||
Gtk.widgetSetMarginBottom keyLbl 4
|
||||
sc <- Gtk.widgetGetStyleContext keyLbl
|
||||
Gtk.styleContextAddClass sc "small-key"
|
||||
Gtk.overlayAddOverlay overlay keyLbl
|
||||
|
||||
-- click action should append the component
|
||||
void $ Gtk.on btn #clicked $ appendSelected comp
|
||||
|
||||
-- put overlay into grid
|
||||
let cols = 8 :: Int -- visual columns (tweak to taste)
|
||||
col = fromIntegral (i `mod` cols)
|
||||
row = fromIntegral (i `div` cols)
|
||||
Gtk.gridAttach grid overlay col row 1 1
|
||||
|
||||
-- update maps
|
||||
modifyIORef' keyMapRef (Map.insert (toUpper k) comp)
|
||||
modifyIORef' btnMapRef (Map.insert (toUpper k) btn)
|
||||
|
||||
return grid
|
||||
|
||||
-- helper to render current page: remove old grid, create new one and show
|
||||
renderPage :: IO ()
|
||||
renderPage = do
|
||||
p <- readIORef pageRef
|
||||
let lblText = "Page " <> T.pack (show (p+1)) <> " / " <> T.pack (show totalPages)
|
||||
Gtk.labelSetText pageLbl lblText
|
||||
|
||||
-- remove old grid if any
|
||||
mOld <- readIORef gridRef
|
||||
case mOld of
|
||||
Just w -> void $ Gtk.boxRemove gridContainer w
|
||||
Nothing -> pure ()
|
||||
|
||||
-- build and append new grid
|
||||
g <- buildPage p
|
||||
wg <- Gtk.toWidget g
|
||||
writeIORef gridRef (Just wg)
|
||||
Gtk.boxAppend gridContainer g
|
||||
-- ensure visible
|
||||
Gtk.widgetShow g
|
||||
|
||||
-- Prev / Next handlers
|
||||
void $ Gtk.on prevBtn #clicked $ do
|
||||
modifyIORef' pageRef (\x -> max 0 (x - 1))
|
||||
renderPage
|
||||
|
||||
void $ Gtk.on nextBtn #clicked $ do
|
||||
modifyIORef' pageRef (\x -> min (totalPages - 1) (x + 1))
|
||||
renderPage
|
||||
|
||||
-- keyboard controller: left/right pages and per-page keys
|
||||
keyController <- Gtk.eventControllerKeyNew
|
||||
void $ Gtk.on keyController #keyPressed $ \keyval _keycode _state -> do
|
||||
u <- Gdk.keyvalToUnicode keyval
|
||||
if u == 0
|
||||
then return False
|
||||
else do
|
||||
let ch = toUpper (chr (fromIntegral u))
|
||||
case ch of
|
||||
'\x2190' -> do -- left arrow (not reliable via unicode here)
|
||||
modifyIORef' pageRef (\x -> max 0 (x - 1)); renderPage; return True
|
||||
'\x2192' -> do -- right arrow
|
||||
modifyIORef' pageRef (\x -> min (totalPages - 1) (x + 1)); renderPage; return True
|
||||
_ -> do
|
||||
km <- readIORef keyMapRef
|
||||
case Map.lookup ch km of
|
||||
Just comp -> appendSelected comp >> return True
|
||||
Nothing -> return False
|
||||
|
||||
-- attach controller to dialog
|
||||
Gtk.widgetAddController dlg keyController
|
||||
|
||||
-- initial render
|
||||
renderPage
|
||||
|
||||
return dlg
|
||||
|
||||
|
||||
-- Polymorphic: accepts any GTK window type
|
||||
setWindowAsDialog :: Gtk.IsWindow w => w -> IO ()
|
||||
setWindowAsDialog win = do
|
||||
-- upcast to concrete Gtk.Window right away (resolves ambiguity)
|
||||
wnd <- Gtk.toWindow win
|
||||
|
||||
-- now get surface with a concrete Window type in scope
|
||||
mSurface <- #getSurface wnd
|
||||
case mSurface of
|
||||
Just (surface :: Gdk.Surface) -> do
|
||||
-- cast to GDK X11 surface & display (explicit IO results)
|
||||
mX11Surface <- (castTo GdkX11.X11Surface surface) :: IO (Maybe GdkX11.X11Surface)
|
||||
display <- Gdk.surfaceGetDisplay surface
|
||||
mX11Display <- (castTo GdkX11.X11Display display) :: IO (Maybe GdkX11.X11Display)
|
||||
|
||||
case (mX11Display, mX11Surface) of
|
||||
(Just _gdkX11Disp, Just x11Surf) -> do
|
||||
-- get window XID and set ATOM via X11
|
||||
xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
|
||||
|
||||
dpy <- openDisplay ""
|
||||
atomType <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
|
||||
atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
|
||||
atomAtom <- internAtom dpy "ATOM" False
|
||||
|
||||
withArray [atomDialog] $ \ptr -> do
|
||||
let winX :: Window
|
||||
winX = fromIntegral (xidCULong :: CULong)
|
||||
void $ xChangeProperty dpy winX atomType atomAtom 32 propModeReplace (castPtr ptr) 1
|
||||
flush dpy
|
||||
|
||||
closeDisplay dpy
|
||||
_ -> putStrLn "Not running under X11."
|
||||
Nothing -> putStrLn "No surface available"
|
||||
|
||||
-- Polymorphic attach helper
|
||||
attachDialogOnRealize :: Gtk.IsWindow w => w -> IO SignalHandlerId
|
||||
attachDialogOnRealize win = do
|
||||
wnd <- Gtk.toWindow win
|
||||
on wnd #realize (setWindowAsDialog win)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Gtk.Application [#applicationId := "org.example.test"]
|
||||
|
||||
void $ Gtk.on app #activate $ do
|
||||
win <- new Gtk.ApplicationWindow
|
||||
[ #application := app
|
||||
, #title := "Main Window"
|
||||
, #defaultWidth := 400
|
||||
, #defaultHeight := 100
|
||||
]
|
||||
|
||||
-- List of all kanji components (you can extend freely)
|
||||
let allComponents :: [T.Text]
|
||||
allComponents =
|
||||
[ "氵", "心", "亻", "木", "口", "日", "月", "艹"
|
||||
, "火", "女", "糸", "手", "金", "水", "土", "言"
|
||||
, "目", "耳", "足", "見", "虫", "貝", "車", "食"
|
||||
, "魚", "鳥", "雨", "馬", "風", "竹", "田", "米"
|
||||
, "石", "山", "川", "弓", "矢", "刀", "犬", "王"
|
||||
]
|
||||
|
||||
parentWin <- Gtk.toWindow win
|
||||
dlg <- createKanjiPickerDialog parentWin allComponents
|
||||
|
||||
-- Show both main window and dialog
|
||||
Gtk.widgetShow win
|
||||
Gtk.widgetShow dlg
|
||||
|
||||
void $ applicationRun app Nothing
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
|
||||
import Data.GI.Base
|
||||
import qualified GI.Gtk as Gtk
|
||||
import qualified GI.Gdk as Gdk
|
||||
import qualified GI.GdkX11 as GdkX11
|
||||
import GI.Gio
|
||||
import Control.Monad (void)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Gtk.Application [#applicationId := "org.example.test"]
|
||||
on app #activate $ do
|
||||
win <- new Gtk.ApplicationWindow
|
||||
[ #application := app
|
||||
, #title := "Dialog Window"
|
||||
, #defaultWidth := 100
|
||||
, #defaultHeight := 40
|
||||
, #resizable := False
|
||||
, #decorated := False
|
||||
]
|
||||
Gtk.widgetShow win
|
||||
|
||||
mSurface <- #getSurface win
|
||||
case mSurface of
|
||||
Just surface -> do
|
||||
-- get X11 surface and display
|
||||
x11Surface <- castTo GdkX11.X11Surface surface
|
||||
display <- Gdk.surfaceGetDisplay surface
|
||||
x11Display <- castTo GdkX11.X11Display display
|
||||
|
||||
case (x11Display, x11Surface) of
|
||||
(Just d, Just s) -> do
|
||||
-- retrieve atoms via GDK X11
|
||||
atomDialog <- GdkX11.x11GetXatomByNameForDisplay d "_NET_WM_WINDOW_TYPE_DIALOG"
|
||||
atomType <- GdkX11.x11GetXatomByNameForDisplay d "_NET_WM_WINDOW_TYPE"
|
||||
|
||||
-- set window type using UTF8 property (technically still a string, but fine for WM hints)
|
||||
GdkX11.x11SurfaceSetUtf8Property
|
||||
s
|
||||
"_NET_WM_WINDOW_TYPE"
|
||||
(Just "_NET_WM_WINDOW_TYPE_DIALOG")
|
||||
|
||||
_ -> putStrLn "Not running under X11."
|
||||
Nothing -> pure ()
|
||||
|
||||
void $ applicationRun app Nothing
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
{-# LANGUAGE ImplicitParams #-}
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import GI.Gdk.Objects.Display
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Maybe
|
||||
import GI.Gdk
|
||||
import GI.Gtk
|
||||
import GI.Gio hiding (Application)
|
||||
import Control.Monad
|
||||
|
||||
printMessage :: IO ()
|
||||
printMessage = do
|
||||
putStrLn "clipboard changed!"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
app <- new Application []
|
||||
void $ onApplicationActivate app $ do
|
||||
window <- applicationWindowNew app
|
||||
|
||||
clipboard <- displayGetDefault >>= maybe (error "No display") (liftM id . displayGetClipboard)
|
||||
on clipboard #changed printMessage
|
||||
#show window
|
||||
|
||||
_ <- applicationRun app Nothing
|
||||
return ()
|
||||
Loading…
Reference in a new issue