75 lines
1.9 KiB
Haskell
75 lines
1.9 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
|
|
man <- ask >>= readTVarIO
|
|
<&> HM.lookup what
|
|
<&> maybe mzero bindMan
|
|
|
|
liftIO $ hPutDoc stdout (pretty man)
|
|
|
|
pattern HelpEntryBound :: forall {c}. Id -> [Syntax c]
|
|
pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )]
|
|
|
|
|
|
splitOpts :: [(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'
|
|
|
|
|