Skip to content

Commit

Permalink
new syntax (#308, #313): fix pinafore-lib-script
Browse files Browse the repository at this point in the history
  • Loading branch information
@AshleyYakeley
AshleyYakeley committed Sep 13, 2024
1 parent 75149cd commit 0b183c2
Show file tree
Hide file tree
Showing 6 changed files with 393 additions and 445 deletions.
11 changes: 5 additions & 6 deletions Pinafore/pinafore-lib-script/data/UILib.pinafore
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
import
"UILib/Context",
"UILib/Command",
"UILib/Pane",
"UILib/Set",
"UILib/Named"
end;
"UILib/Context",
"UILib/Command",
"UILib/Pane",
"UILib/Set",
"UILib/Named";
183 changes: 87 additions & 96 deletions Pinafore/pinafore-lib-script/data/UILib/Command.pinafore
View file
Original file line number Diff line number Diff line change
@@ -1,105 +1,96 @@
import "gnome" in
with GTK. in
namespace UILib of
import "gnome"
with GTK.
namespace UILib {
docsec "Commands" {
datatype Command -context {
Mk {
name: Text;
defaultKeyBinding: Maybe Text = Nothing;
action: context -> Action Unit;
};
};

docsec "Commands" of
namespace Command {
toMenuEntry: context -> Command context -> MenuEntry =
fn ctxt, Mk => action.MenuEntry ap{(name, defaultKeyBinding)} ap{action ctxt};

datatype Command -context of
Mk of
name: Text;
defaultKeyBinding: Maybe Text = Nothing;
action: context -> Action Unit;
end;
end;
datatype Context {
Mk {
gtk: Context.GTK.;
undoHandler: UndoHandler;
window: Window;
getTextSelection: Action (WholeModel Text);
};
};

namespace Command of
copy: Command Context =
Mk.Command {
name = "Copy";
defaultKeyBinding = Just "Ctrl+C";
action =
fn Mk.Context => do {
tmodel <- getTextSelection;
text <- get.WholeModel tmodel;
clipboard ?gtk :=.WholeModel text;
};
};

toMenuEntry: context -> Command context -> MenuEntry =
fn ctxt, Mk => action.MenuEntry {(name, defaultKeyBinding)} {action ctxt};
cut: Command Context =
Mk.Command {
name = "Cut";
defaultKeyBinding = Just "Ctrl+X";
action =
fn Mk.Context => do {
tmodel <- getTextSelection;
text <- get.WholeModel tmodel;
clipboard ?gtk :=.WholeModel text;
tmodel :=.WholeModel "";
};
};

datatype Context of
Mk of
gtk: Context.GTK.;
undoHandler: UndoHandler;
window: Window;
getTextSelection: Action (WholeModel Text);
end;
end;
paste: Command Context =
Mk.Command {
name = "Paste";
defaultKeyBinding = Just "Ctrl+V";
action =
fn Mk.Context => do {
tmodel <- getTextSelection;
clip <- get.WholeModel $ clipboard ?gtk;
clip >-
fn {
text:? Text => tmodel :=.WholeModel text;
_ => pure ();
};
};
};

copy: Command Context =
Mk.Command of
name = "Copy";
defaultKeyBinding = Just "Ctrl+C";
action =
fn Mk.Context =>
do
tmodel <- getTextSelection;
text <- get.WholeModel tmodel;
clipboard ?gtk :=.WholeModel text;
end;
end;
undo: Command Context =
Mk.Command {
name = "Undo";
defaultKeyBinding = Just "Ctrl+Z";
action = fn Mk.Context => queueUndo undoHandler >> pure ();
};

cut: Command Context =
Mk.Command of
name = "Cut";
defaultKeyBinding = Just "Ctrl+X";
action =
fn Mk.Context =>
do
tmodel <- getTextSelection;
text <- get.WholeModel tmodel;
clipboard ?gtk :=.WholeModel text;
tmodel :=.WholeModel "";
end;
end;
redo: Command Context =
Mk.Command {
name = "Redo";
defaultKeyBinding = Just "Ctrl+Y";
action = fn Mk.Context => queueRedo undoHandler >> pure ();
};

paste: Command Context =
Mk.Command of
name = "Paste";
defaultKeyBinding = Just "Ctrl+V";
action =
fn Mk.Context =>
do
tmodel <- getTextSelection;
clip <- get.WholeModel $ clipboard ?gtk;
clip >-
match
text:? Text => tmodel :=.WholeModel text;
_ => pure ();
end;
end;
end;
close: Command Context =
Mk.Command {
name = "Close";
defaultKeyBinding = Just "Ctrl+W";
action = fn Mk.Context => close.Window window;
};

undo: Command Context =
Mk.Command of
name = "Undo";
defaultKeyBinding = Just "Ctrl+Z";
action = fn Mk.Context => queueUndo undoHandler >> pure ();
end;

redo: Command Context =
Mk.Command of
name = "Redo";
defaultKeyBinding = Just "Ctrl+Y";
action = fn Mk.Context => queueRedo undoHandler >> pure ();
end;

close: Command Context =
Mk.Command of
name = "Close";
defaultKeyBinding = Just "Ctrl+W";
action = fn Mk.Context => close.Window window;
end;

exit: Command Context =
Mk.Command of
name = "Exit";
defaultKeyBinding = Just "Ctrl+Q";
action = fn Mk.Context => exit.GTK gtk;
end;

end;

end;

end;
exit: Command Context =
Mk.Command {
name = "Exit";
defaultKeyBinding = Just "Ctrl+Q";
action = fn Mk.Context => exit.GTK gtk;
};
};
};
};
53 changes: 23 additions & 30 deletions Pinafore/pinafore-lib-script/data/UILib/Context.pinafore
View file
Original file line number Diff line number Diff line change
@@ -1,31 +1,24 @@
import "gnome" in
namespace UILib of
import "gnome"
namespace UILib {
docsec "Running" {
#| Context type for using GTK, storage, and undo together.
datatype Context {
Mk {
gtk: Context.GTK;
undoHandler: UndoHandler;
store: Store;
};
};

docsec "Running" of

#| Context type for using GTK, storage, and undo together.
datatype Context of
Mk of
gtk: Context.GTK;
undoHandler: UndoHandler;
store: Store;
end;
end;

namespace Context of

#| Run an action, giving a `Context`.
run: (Context -> Action a) -> Action a =
fn call =>
do
dstore <- openLocal.Store of end;
undoHandler <- new.UndoHandler;
store <- handleStore.UndoHandler undoHandler dstore;
run.GTK $ fn gtk => call Mk.Context;
end;

end;

end;

end;
namespace Context {
#| Run an action, giving a `Context`.
run: (Context -> Action a) -> Action a =
fn call => do {
dstore <- openLocal.Store {};
undoHandler <- new.UndoHandler;
store <- handleStore.UndoHandler undoHandler dstore;
run.GTK $ fn gtk => call Mk.Context;
};
};
};
};
95 changes: 43 additions & 52 deletions Pinafore/pinafore-lib-script/data/UILib/Named.pinafore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,55 +2,46 @@ import
"gnome",
"UILib/Pane",
"UILib/Set"
in
with GTK in
namespace UILib of

docsec "Named" of

#| An open entity type; something with a name
entitytype Named;

namespace Named of

#| A name is a text that identifies (in some sense) an entity.
nameOf: Property Named Text =
property @Named @Text !"identify.name" ?store;

#| Order alphabetically (case-insensitive) by name
order: ModelOrder Named =
on.ModelOrder nameOf order.Text;

#| Order a set of entities by their names.
toList: FiniteSetModel {+a,+Named} -> WholeModel +(List (a *: Text)) =
fn model => toList.FiniteSetModel (map.ModelOrder fst.Product order) $ (id.Property **.Property nameOf) !$$% model;

#| A pane for a widget, where the title is the name of the widget.
pane: (a -> Widget) -> (a & Named) -> Pane =
fn itemWidget, e =>
let
titleModel= nameOf !$% {e};
extraMenusModel = fn _ => {[]};
contents = itemWidget e;
in Mk.Pane;

#| A "name" column for `listTable.Widget`.
column: WholeModel +Text *: (Named -> WholeModel Text) =
({"Name"},fn p => nameOf !$ {p});

#| A `SetWidget` for this set that's a list of widgets by name.
table: FiniteSetModel {a,+Named} -> (a -> Widget) -> SetWidget {a,-Named} =
fn sm, itemWidget =>
Mk.SetWidget $
fn msel =>
exec.Widget $
do
lm <- getList.FiniteSetModel order sm;
pure.Action $ listTable.Widget [column.Named] lm (fn e => paneWindow.Pane $ pane.Named itemWidget e) msel;
end;

end;

end;

end;
with GTK
namespace UILib {
docsec "Named" {
#| An open entity type; something with a name
entitytype Named;

namespace Named {
#| A name is a text that identifies (in some sense) an entity.
nameOf: Property Named Text =
property @Named @Text !"identify.name" ?store;

#| Order alphabetically (case-insensitive) by name
order: ModelOrder Named =
on.ModelOrder nameOf order.Text;

#| Order a set of entities by their names.
toList: FiniteSetModel (+a,+Named) -> WholeModel +(List (a *: Text)) =
fn model => toList.FiniteSetModel (map.ModelOrder fst.Product order) $ (id.Property **.Property nameOf) !$$% model;

#| A pane for a widget, where the title is the name of the widget.
pane: (a -> Widget) -> (a & Named) -> Pane =
fn itemWidget, e => let {
titleModel= nameOf !$% ap{e};
extraMenusModel = fn _ => ap{[]};
contents = itemWidget e;
} Mk.Pane;

#| A "name" column for `listTable.Widget`.
column: WholeModel +Text *: (Named -> WholeModel Text) =
(ap{"Name"},fn p => nameOf !$ ap{p});

#| A `SetWidget` for this set that's a list of widgets by name.
table: FiniteSetModel (a,+Named) -> (a -> Widget) -> SetWidget (a,-Named) =
fn sm, itemWidget =>
Mk.SetWidget $
fn msel =>
exec.Widget $ do {
lm <- getList.FiniteSetModel order sm;
pure.Action $ listTable.Widget [column.Named] lm (fn e => paneWindow.Pane $ pane.Named itemWidget e) msel;
};
};
};
};
Loading

0 comments on commit 0b183c2

Please sign in to comment.