mirror of https://github.com/voidlizard/hbs2
87 lines
2.4 KiB
Haskell
87 lines
2.4 KiB
Haskell
{-# Language UndecidableInstances #-}
|
|
{-# Language PatternSynonyms #-}
|
|
{-# Language RecordWildCards #-}
|
|
module Data.Config.Suckless.Script
|
|
( module Exported
|
|
, module Data.Config.Suckless.Script
|
|
) where
|
|
|
|
import Data.Config.Suckless as Exported
|
|
import Data.Config.Suckless.Script.Internal as Exported
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Reader
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Prettyprinter
|
|
import Prettyprinter.Render.Terminal
|
|
import Data.List qualified as List
|
|
import Data.Text qualified as Text
|
|
import Data.String
|
|
import UnliftIO
|
|
|
|
|
|
{- HLINT ignore "Functor law" -}
|
|
|
|
helpList :: MonadUnliftIO m => Bool -> Maybe String -> RunM c m ()
|
|
helpList hasDoc p = do
|
|
|
|
let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
|
|
|
|
d <- ask >>= readTVarIO
|
|
let ks = [k | Id k <- List.sort (HM.keys d)
|
|
, match k
|
|
, docDefined (HM.lookup (Id k) d) || not hasDoc
|
|
]
|
|
|
|
display_ $ vcat (fmap pretty ks)
|
|
|
|
where
|
|
docDefined (Just (Bind (Just Man{..}) _)) | not manHidden = True
|
|
docDefined _ = False
|
|
|
|
helpEntry :: MonadUnliftIO m => Id -> RunM c m ()
|
|
helpEntry what' = do
|
|
|
|
found <- flip fix what' $ \next what -> do
|
|
ask >>= readTVarIO
|
|
<&> HM.lookup what
|
|
<&> (bindMan =<<)
|
|
>>= \case
|
|
Nothing -> pure Nothing
|
|
Just (Man{manIsAliasFor = Just x, manBrief = Nothing}) -> next x
|
|
Just x -> pure (Just ( x { manName = Just (ManName what') } ))
|
|
|
|
liftIO $ hPutDoc stdout (pretty found)
|
|
|
|
pattern HelpEntryBound :: forall {c}. Id -> [Syntax c]
|
|
pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )]
|
|
|
|
pattern MatchOption:: forall {c} . Id -> Syntax c -> Syntax c
|
|
pattern MatchOption n e <- ListVal [SymbolVal n, e]
|
|
|
|
pattern MatchFlag :: forall {c} . Id -> Syntax c
|
|
pattern MatchFlag n <- ListVal [SymbolVal n]
|
|
|
|
splitOpts :: forall c . IsContext c
|
|
=> [(Id,Int)]
|
|
-> [Syntax c]
|
|
-> ([Syntax c], [Syntax c])
|
|
|
|
splitOpts def opts' = flip fix (mempty, opts) $ \go -> \case
|
|
(acc, []) -> acc
|
|
( (o,a), r@(StringLike x) : rs ) -> do
|
|
case HM.lookup (fromString x) omap of
|
|
Nothing -> go ((o, a <> [r]), rs)
|
|
Just n -> do
|
|
let (w, rest) = List.splitAt n rs
|
|
let result = mkList @c ( r : w )
|
|
go ( (o <> [result], a), rest )
|
|
( (o,a), r : rs ) -> do
|
|
go ((o, a <> [r]), rs)
|
|
|
|
where
|
|
omap = HM.fromList [ (p, x) | (p,x) <- def ]
|
|
opts = opts'
|
|
|
|
|