Hints and formats
Nix build / nix-build (nixosConfigurations.apollo.config.system.build.toplevel) (push) Successful in 51s Details
Nix build / nix-build (nixosConfigurations.athene.config.system.build.toplevel) (push) Successful in 22s Details
Nix build / nix-build (nixosConfigurations.hephaistos.config.system.build.toplevel) (push) Successful in 38s Details
Nix build / nix-build (nixosConfigurations.hera.config.system.build.toplevel) (push) Successful in 51s Details
Nix build / nix-build (nixosConfigurations.zeus.config.system.build.toplevel) (push) Successful in 52s Details
Nix build / nix-flake-check (push) Successful in 55s Details

This commit is contained in:
maralorn 2023-10-28 22:41:53 +02:00
parent cf36ef137d
commit bbe5c810fe
No known key found for this signature in database
21 changed files with 195 additions and 180 deletions

View File

@ -164,5 +164,6 @@ css fontPath = do
".show" & color black
".showable" & display none
active
& i ? do
& i
? do
background black

View File

@ -122,9 +122,9 @@ remoteBackendWidget closeEvent mayBackend = D.divClass "remoteBackend" $ do
D.inputElement $
D.def
& lensVL D.inputElementConfig_initialValue
.~ defaultValue
.~ defaultValue
& lensVL (D.inputElementConfig_elementConfig . D.elementConfig_initialAttributes)
.~ if hidden then "type" D.=: "password" else mempty
.~ if hidden then "type" D.=: "password" else mempty
inputValue = R.current . D._inputElement_value
data WebSocketState = WebSocketError Text | Connecting deriving stock (Show)
@ -142,8 +142,8 @@ webClientSocket closeEvent backend@RemoteBackend{url, user, password} = do
let socketConfig =
D.def
& (lensVL D.webSocketConfig_send .~ (toList <$> (socketRequestEvent <> (one AllTasks <$ refreshEvent))))
. (lensVL D.webSocketConfig_reconnect .~ True)
. (lensVL D.webSocketConfig_close .~ ((3000, "Client unloaded websocket.") <$ un closeEvent))
. (lensVL D.webSocketConfig_reconnect .~ True)
. (lensVL D.webSocketConfig_close .~ ((3000, "Client unloaded websocket.") <$ un closeEvent))
storage <- getStorage
socket <- D.jsonWebSocket @SocketRequest @SocketMessage socketString socketConfig
let messages = R.fmapMaybe id $ socket ^. lensVL D.webSocket_recv

View File

@ -403,12 +403,13 @@ collapseButton = do
=<< lookupTasksM
(taskInfos ^. #children)
D.dyn_ $
when <$> hasChildren ?? do
open <- getIsExpanded $ taskInfos ^. #uuid
let label = \case
True -> "unfold_less"
False -> "unfold_more"
buttonEvent <-
button "slimButton" $
D.dyn_ (icon "collapse" . label <$> open)
tellToggle $ taskInfos ^. #uuid <$ buttonEvent
when
<$> hasChildren ?? do
open <- getIsExpanded $ taskInfos ^. #uuid
let label = \case
True -> "unfold_less"
False -> "unfold_more"
buttonEvent <-
button "slimButton" $
D.dyn_ (icon "collapse" . label <$> open)
tellToggle $ taskInfos ^. #uuid <$ buttonEvent

View File

@ -336,8 +336,9 @@ findSubscribedPRsInCommitList branch possible_new_merge_commits =
fmap join . mapM \change ->
either id id <$> runExceptT do
found_by_merge_commit <-
lift $
fmap (unMergeKey . Persist.entityKey) <$> SQL.select do
lift
$ fmap (unMergeKey . Persist.entityKey)
<$> SQL.select do
merge <- SQL.from $ SQL.table @Merge
SQL.where_ (merge ^. MergeCommit ==. SQL.val (commitId change))
pure merge
@ -401,7 +402,9 @@ watchRepo = do
if null changes
then pure Nothing
else
Just . (,prs) . fold
Just
. (,prs)
. fold
<$> sequence
[ branchHTML branch
, pure $ m " advanced by "
@ -439,8 +442,9 @@ dropUnsubscribedPRs :: App ()
dropUnsubscribedPRs = do
SQL.delete do
pr <- SQL.from $ SQL.table @PullRequest
SQL.where_ $
(pr ^. PullRequestId) `notIn` SQL.subList_select do
SQL.where_
$ (pr ^. PullRequestId)
`notIn` SQL.subList_select do
sub <- SQL.from $ SQL.table @Subscription
pure (sub ^. SubscriptionPullRequest)
@ -464,15 +468,15 @@ unsubscribeFromFinishedPRs = do
deleteUnusedQueries :: App ()
deleteUnusedQueries = SQL.delete do
query <- SQL.from $ SQL.table @Query
SQL.where_ $
(query ^. QueryUser)
SQL.where_
$ (query ^. QueryUser)
`notIn` SQL.subList_select do
sub <- SQL.from $ SQL.table @Subscription
pure (sub ^. SubscriptionUser)
&&. (query ^. QueryUser)
`notIn` SQL.subList_select do
sub <- SQL.from $ SQL.table @Subscription
pure (sub ^. SubscriptionUser)
&&. (query ^. QueryUser)
`notIn` SQL.subList_select do
sub <- SQL.from $ SQL.table @AuthorSubscription
pure (sub ^. AuthorSubscriptionUser)
sub <- SQL.from $ SQL.table @AuthorSubscription
pure (sub ^. AuthorSubscriptionUser)
leaveEmptyRooms :: App ()
leaveEmptyRooms = do
@ -486,13 +490,13 @@ sendMessage roomId@(Matrix.RoomID roomIdText) message = do
putTextLn $ "in room" <> roomIdText <> ":\n" <> fst message
txnId <- Matrix.TxnID . show <$> Random.randomRIO (1000000 :: Int, 9999999)
session <- getEnv matrixSession
void $
unwrapMatrixError $
Matrix.sendMessage
session
roomId
(Matrix.EventRoomMessage $ Matrix.RoomMessageText $ Matrix.MessageText (fst message) Matrix.NoticeType (Just "org.matrix.custom.html") (Just (snd message)))
txnId
void
$ unwrapMatrixError
$ Matrix.sendMessage
session
roomId
(Matrix.EventRoomMessage $ Matrix.RoomMessageText $ Matrix.MessageText (fst message) Matrix.NoticeType (Just "org.matrix.custom.html") (Just (snd message)))
txnId
sendMessageToUser :: Text -> MessageText -> App ()
sendMessageToUser user message = do
@ -679,8 +683,8 @@ helpMessage :: App MessageText
helpMessage = do
branchList <- join $ getEnv (fmap (intercalateMsgPlain ", ") . mapM branchHTML . Map.keys . branches . config)
repo_link <- repoLink "" "nixpkgs git repository on github"
pure $
unlinesMsg
pure
$ unlinesMsg
[ m "Hey! I am the friendly nixpkgs-bot and I am here to help you notice when pull requests are being merged, so you dont need to hammer refresh on github."
, mempty
, m "I am continously watching the " <> repo_link <> m ". If you want to be notified whenever a PR reaches one of the relevant branches in the nixpkgs release cycle, you can tell me via the following commands:"

View File

@ -35,7 +35,8 @@ extractTimeFromTableRow =
isDateTag :: Tag -> Bool
isDateTag = \tag ->
TagSoup.isTagOpenName "td" tag
&& "date" == TagSoup.fromAttrib "class" tag
&& "date"
== TagSoup.fromAttrib "class" tag
extractFolderFromTableRow :: [Tag] -> Maybe (Text, Text)
extractFolderFromTableRow =
@ -44,13 +45,11 @@ extractFolderFromTableRow =
extractFolderFromATag :: Tag -> Maybe (Text, Text)
extractFolderFromATag = \tag ->
let
title = TagSoup.fromAttrib "title" tag
href = TagSoup.fromAttrib "href" tag
in
if Text.null title || Text.null href
then Nothing
else Just (href, title)
let title = TagSoup.fromAttrib "title" tag
href = TagSoup.fromAttrib "href" tag
in if Text.null title || Text.null href
then Nothing
else Just (href, title)
parseTime :: Text -> Text -> Maybe UTCTime
parseTime = \format time_text ->
@ -80,10 +79,10 @@ fetchIndex = \url -> do
getExtension :: Text -> Text
getExtension =
toString
<&> FilePath.takeExtension
<&> toText
<&> Text.dropAround (== '.')
toText
. FilePath.takeExtension
. toString
. Text.dropAround (== '.')
collectEntries :: Text -> Entry -> IO [(Feed.Entry, UTCTime)]
collectEntries url entry
@ -115,7 +114,7 @@ data FeedInfo = MkFeedInfo
}
{- | Scrape an nginx fancy index.
| Create one RSS feed for every subfolder of the given folder.
| Create one RSS feed for every subfolder of the given folder.
-}
ignores = []
@ -137,8 +136,8 @@ main = do
(Feed.TextString entry.title)
(timestamp time)
feed =
fromMaybe (error "Could not produce feed.") $
Feed.textFeed
fromMaybe (error "Could not produce feed.")
$ Feed.textFeed
emptyFeed
{ Feed.feedEntries = fmap fst entries
, Feed.feedLinks = [Feed.nullLink (root_dir <> entry.link)]
@ -155,35 +154,35 @@ main = do
mkFeedIndex :: [FeedInfo] -> Text
mkFeedIndex = \feeds ->
Text.unlines $
[ "<!DOCTYPE html>"
, "<html>"
, "<head>"
, "<title>Available RSS Feeds</title>"
, "</head>"
, "<body>"
, "<h1>Available RSS Feeds</h1>"
, "<i>"
, "Report generated by the"
, "<a href =\"https://code.maralorn.de/maralorn/config/src/branch/main/packages/rssfeeds/FancyIndex.hs\">"
, "fancyindex2rss"
, "</a>"
, "script."
, "</i>"
, "<ul>"
]
++ concatMap
( \feedInfo ->
[ "<li>"
, makeFeedLink feedInfo
, "</li>"
]
)
feeds
++ [ "</ul>"
, "</body>"
, "</html>"
]
Text.unlines
$ [ "<!DOCTYPE html>"
, "<html>"
, "<head>"
, "<title>Available RSS Feeds</title>"
, "</head>"
, "<body>"
, "<h1>Available RSS Feeds</h1>"
, "<i>"
, "Report generated by the"
, "<a href =\"https://code.maralorn.de/maralorn/config/src/branch/main/packages/rssfeeds/FancyIndex.hs\">"
, "fancyindex2rss"
, "</a>"
, "script."
, "</i>"
, "<ul>"
]
++ concatMap
( \feedInfo ->
[ "<li>"
, makeFeedLink feedInfo
, "</li>"
]
)
feeds
++ [ "</ul>"
, "</body>"
, "</html>"
]
makeFeedLink :: FeedInfo -> Text
makeFeedLink = \MkFeedInfo{..} ->

View File

@ -33,9 +33,9 @@ main = do
entries <-
readFileBS file_path
<&> fmap (mkEntry now)
. zip [0 ..]
. lines
. decodeUtf8
. zip [0 ..]
. lines
. decodeUtf8
let
emptyFeed =
Feed.nullFeed
@ -43,8 +43,8 @@ main = do
(Feed.TextString (toText file_path))
(timestamp now)
feed =
fromMaybe (error "Could not produce feed.") $
Feed.textFeed
fromMaybe (error "Could not produce feed.")
$ Feed.textFeed
emptyFeed
{ Feed.feedEntries = entries
}

View File

@ -54,8 +54,8 @@ data Message = Message
main :: IO ()
main = do
Options{dbPath, folder} <-
O.execParser $
O.info
O.execParser
$ O.info
( Options
<$> O.argument
O.str
@ -80,11 +80,12 @@ main = do
msgsByThread <- forM msgs \msg -> Notmuch.threadId msg <&> (,Right msg)
thrdsByThread <- forM thrds \thrd -> Notmuch.threadId thrd <&> (,Left thrd)
result <-
mapM (runExceptT . processThread) . Map.toList $
fmap snd
<$> groupBy
fst
(msgsByThread <> thrdsByThread)
mapM (runExceptT . processThread)
. Map.toList
$ fmap snd
<$> groupBy
fst
(msgsByThread <> thrdsByThread)
now <- lift getCurrentTime
let entries = threadToEntry <$> sortOn (.date) (rights result)
feed =
@ -94,8 +95,9 @@ main = do
(timestamp now)
errors = lefts result
feedText <-
tryJust [i|Failed to generate feed.|] . textFeed $
feed
tryJust [i|Failed to generate feed.|]
. textFeed
$ feed
{ feedEntries = (if null errors then id else (errorsToEntry now errors :)) entries
}
say $ toStrict feedText
@ -158,9 +160,9 @@ processThread (threadid, toList -> thrdAndMsgs) =
messageToHtml :: Message -> Text
messageToHtml Message{headers, body} =
Text.intercalate "<br>\n" $
((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
<> one (bodyToHtml body)
Text.intercalate "<br>\n"
$ ((\(name, content) -> [i|<b>#{name}:</b> #{content}|]) <$> headers)
<> one (bodyToHtml body)
bodyToHtml :: Body -> Text
bodyToHtml (HTMLBody x) = fromMaybe x onlyBody
@ -191,16 +193,17 @@ processMessage msg = do
(\error_msg -> [i|Failed to read msg\nFilename:#{fileName}\nerror: #{error_msg}|])
do
msgContent <-
handleIOError (\io_error -> throwE [i|IOError: #{io_error}|]) $
readFileBS fileName
handleIOError (\io_error -> throwE [i|IOError: #{io_error}|])
$ readFileBS fileName
parseResult <-
hoistEither . first toText $
MIME.parse
hoistEither
. first toText
$ MIME.parse
(MIME.message MIME.mime)
msgContent
textPart <-
tryJust [i|No text or html part in message|] $
firstOf
tryJust [i|No text or html part in message|]
$ firstOf
( MIME.entities . filtered isHtml <> MIME.entities . filtered isTextPlain
)
parseResult

View File

@ -45,5 +45,5 @@ main = do
[out_file, dir] <- getArgs
now <- Time.getZonedTime
file_names <- Directory.getDirectoryFiles dir [todayMask now]
whenJust (makeFeed now file_names) $
\file -> writeFileLText out_file file
whenJust (makeFeed now file_names)
$ \file -> writeFileLText out_file file

View File

@ -129,8 +129,8 @@ main = do
(TextString "Weechat Logs")
(timestamp now)
[pathToWrite] <- getArgs
whenJust (textFeed feed{feedEntries = entries}) $
\file -> writeFileLText pathToWrite file
whenJust (textFeed feed{feedEntries = entries})
$ \file -> writeFileLText pathToWrite file
today :: T.UTCTime -> T.Day
today = T.utctDay
@ -219,10 +219,10 @@ printHTML log = intercalate "\n" $ map printDay days
where
days = groupBy ((==) `on` wlDate) log
printDay ls =
intercalate "\n" $
["<h3>" <> wlDate (head ls) <> "</h3>"]
<> toList
(printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
intercalate "\n"
$ ["<h3>" <> wlDate (head ls) <> "</h3>"]
<> toList
(printRow <$> zip (WeechatLine "" "" "" "" :| toList ls) ls)
printRow :: (WeechatLine, WeechatLine) -> Text
printRow (prevRow, curRow) =
"<i>" <> time <> "</i> <b>" <> printNick <> "</b> " <> message <> "<br>"

View File

@ -35,8 +35,8 @@ getInbox = do
children :: HashMap UUID.UUID (HashSet UUID.UUID) =
tasks
& toList
% mapMaybe (\task -> getParent task <&> (,HashSet.singleton task.uuid))
% HashMap.fromListWith (<>)
% mapMaybe (\task -> getParent task <&> (,HashSet.singleton task.uuid))
% HashMap.fromListWith (<>)
waiting_tasks :: HashSet UUID.UUID =
tasks
& toList
@ -48,9 +48,9 @@ getInbox = do
%> (.uuid)
% fromList
inhibitedTasks :: HashSet UUID.UUID = foldMap (closure children) (blocked_tasks <> waiting_tasks <> tagged_tasks)
pure $
toList tasks
& filter \task -> Set.null task.tags && not (HashMap.member task.uuid children) && not (HashSet.member task.uuid inhibitedTasks)
pure
$ toList tasks
& filter \task -> Set.null task.tags && not (HashMap.member task.uuid children) && not (HashSet.member task.uuid inhibitedTasks)
closure :: (Hashable a) => HashMap a (HashSet a) -> a -> HashSet a
closure mapping = go
@ -58,12 +58,13 @@ closure mapping = go
go = \x ->
HashMap.lookup x mapping
& maybe mempty (foldMap go)
% HashSet.insert x
% HashSet.insert x
getParent :: Task.Task -> Maybe UUID.UUID
getParent = \task ->
Map.lookup "partof" task.uda
>>= Aeson.fromJSON % \case
>>= Aeson.fromJSON
% \case
Aeson.Success uuid -> Just uuid
Aeson.Error err -> error ("invalid partof uda " <> toText err)

View File

@ -97,13 +97,14 @@ mkInfos = \objects ->
get_info :: (Aeson.FromJSON a) => Int -> [Aeson.Key] -> Maybe a
get_info = \id' path ->
IntMap.lookup id' objects
>>= [get|.info|] % extractJSON path
>>= [get|.info|]
% extractJSON path
get_name :: Int -> Text
get_name id' =
let raw = get_info id' ["props", "node.description"] & fromMaybe "unknown"
in find (fst % (`Text.isInfixOf` raw)) aliases
& fmap snd
% fromMaybe raw
% fromMaybe raw
find_volume :: Int -> Maybe Double
find_volume = \id' ->
get_info id' ["params", "Props"]
@ -121,11 +122,11 @@ mkInfos = \objects ->
defaults =
objects
& toList
% filter (\obj -> [get| obj.type |] == "PipeWire:Interface:Metadata")
% mapMaybe [get|.metadata|]
% filter (\obj -> [get| obj.type |] == "PipeWire:Interface:Metadata")
% mapMaybe [get|.metadata|]
& join
% filter (extractJSON ["key"] % (`elem` [Just "default.audio.sink", Just "default.audio.source"]))
% mapMaybe (extractJSON ["value", "name"])
% filter (extractJSON ["key"] % (`elem` [Just "default.audio.sink", Just "default.audio.source"]))
% mapMaybe (extractJSON ["value", "name"])
links =
objects
& toList

View File

@ -52,23 +52,23 @@ calendar = \env -> do
, "@=@{start}@@@{end}@@@{title}@@@{description}@@@{location}@@@{calendar}"
]
)
pure $
appointments
& Text.splitOn "@=@"
%> Text.splitOn "@@@"
%>> cleanString
% mapMaybe \case
[start', end, title, description, location, calendar'] ->
Just $
MkAppointment
{ start = start'
, end
, title
, description
, location
, calendar = calendar'
}
_ -> Nothing
pure
$ appointments
& Text.splitOn "@=@"
%> Text.splitOn "@@@"
%>> cleanString
% mapMaybe \case
[start', end, title, description, location, calendar'] ->
Just
$ MkAppointment
{ start = start'
, end
, title
, description
, location
, calendar = calendar'
}
_ -> Nothing
cleanString :: Text -> Text
cleanString = Text.replace "\"" "" . Text.intercalate "\\n" . Text.lines . Text.strip

View File

@ -23,7 +23,8 @@ pullNeeded = \env mode -> do
_ -> do
behind <-
CommandUtil.tryCmd (git "--no-optional-locks" "-C" (env.homeDir </> "git" </> "config") "log" "--oneline" "origin/main" "^main")
<&> LBSC.lines % length
<&> LBSC.lines
% length
pure
[ MkWarning
{ description =

View File

@ -42,11 +42,11 @@ gitEvents env mode = do
dir_events <- forM [git_dir </> dir] \sub_dir -> FileWatch.watchDir env sub_dir False (const True)
git_dir_event <- FileWatch.watchDir env (git_dir </> dir </> ".git") False (const True)
git_refs_event <- FileWatch.watchDir env (git_dir </> dir </> ".git/refs") True (const True)
pure $
mconcat (void <$> dir_events)
<> void git_dir_event
<> void git_refs_event
$> [dir]
pure
$ mconcat (void <$> dir_events)
<> void git_dir_event
<> void git_refs_event
$> [dir]
R.throttle 0.2 $ mconcat dir_update_events
git_dir_events <- (<> git_dirs_event) . R.switchDyn <$> R.networkHold (pure R.never) git_dirs_event'
let dirs_matching git_pred = do

View File

@ -19,18 +19,19 @@ data IdleState = Off | Active | Idle Int
idleState :: (R.MonadHeadlessApp t m) => Env -> m (R.Dynamic t IdleState)
idleState = \env -> do
service_running_dyn <-
ReflexUtil.processLines env (journalctl "--user" "-n1" "-fu" "swayidle.service") <<&>> \case
line | "Stopped" `BS.isInfixOf` line -> Just False
line | "Started" `BS.isInfixOf` line -> Just True
_ -> Nothing
ReflexUtil.processLines env (journalctl "--user" "-n1" "-fu" "swayidle.service")
<<&>> \case
line | "Stopped" `BS.isInfixOf` line -> Just False
line | "Started" `BS.isInfixOf` line -> Just True
_ -> Nothing
<&> R.mapMaybe id
>>= R.holdDyn True
file_dyn <-
FileWatch.watchFileContents env env.homeDir ".idle_state"
<&> R.updated
% R.mapMaybe id
% fmap encodeUtf8
% R.mapMaybe Aeson.decode'
% R.mapMaybe id
% fmap encodeUtf8
% R.mapMaybe Aeson.decode'
>>= R.holdDyn Active
R.holdUniqDyn (liftA2 combine service_running_dyn file_dyn)

View File

@ -19,5 +19,5 @@ networkState = \env ->
ReflexUtil.performEventThreaded env monitor_event \_ -> do
CommandUtil.tryCmd (Shh.exe "nmcli" "-g" "name" "connection" "show" "--active")
<&> decodeUtf8
% lines
% filter (/= "lo")
% lines
% filter (/= "lo")

View File

@ -17,8 +17,9 @@ ping = \env -> do
tick <- ReflexUtil.tickEvent 15
ReflexUtil.performEventThreaded env tick \_ -> do
unreachable_hosts <- flip filterM hosts \host -> isLeft <$> (Shh.tryFailure do (Shh.exe "/run/wrappers/bin/ping" "-c" "1" (toString host)) &> Shh.devNull)
pure $
unreachable_hosts <&> \host ->
pure
$ unreachable_hosts
<&> \host ->
MkWarning
{ description = Just [i|No tunnel to #{host}|]
, group = "warning"

View File

@ -37,22 +37,22 @@ playerModule = \env -> do
%> find (/= "::")
%> fmap (" " <>)
%> fromMaybe ""
pure $
player_states
& decodeUtf8
% Text.lines
%> Text.splitOn "@@@"
% mapMaybe
( \case
[name, status, title] ->
Just $
MkPlayerState
{ name = if name == "mpd" then name <> mpd_host else name
, title = cleanTitle title
, status = status
}
_ -> Nothing
)
pure
$ player_states
& decodeUtf8
% Text.lines
%> Text.splitOn "@@@"
% mapMaybe
( \case
[name, status, title] ->
Just
$ MkPlayerState
{ name = if name == "mpd" then name <> mpd_host else name
, title = cleanTitle title
, status = status
}
_ -> Nothing
)
cleanList :: [Text]
cleanList =

View File

@ -18,6 +18,6 @@ timers :: (R.MonadHeadlessApp t m) => Env -> m (R.Event t [Timer])
timers = \env ->
FileWatch.watchFileContents env env.homeDir ".timers"
<&> R.updated
% R.fmapMaybe id
% fmap encodeUtf8
% R.mapMaybe Aeson.decode'
% R.fmapMaybe id
% fmap encodeUtf8
% R.mapMaybe Aeson.decode'

View File

@ -63,7 +63,8 @@ getTasks = do
getFilePaths :: FilePath -> IO [FilePath]
getFilePaths dir =
Dir.listDirectory dir
>>= fmap concat . mapM \name -> do
>>= fmap concat
. mapM \name -> do
isFile <- Dir.doesFileExist (dir </> name)
isDir <- Dir.doesDirectoryExist (dir </> name)
case () of

View File

@ -25,8 +25,9 @@ data Command = Run Text | Fork Text deriving (Show)
instance FromJSON (Menu Command) where
parseJSON = parseMenu "Hotkeys"
where
parseList name = (fmap (Menu name) .) $
mapM $ \(Key.toText -> key, val) ->
parseList name = (fmap (Menu name) .)
$ mapM
$ \(Key.toText -> key, val) ->
case val of
String cmd -> pure $ Dialog.Option key (text2cmd cmd)
innerObj -> Dialog.SubMenu <$> parseMenu key innerObj