mirror of https://github.com/voidlizard/hbs2
wip, kinda fixme cat
This commit is contained in:
parent
b06ca3c3f5
commit
bdec99c48e
|
@ -27,4 +27,6 @@ fixme-file-comments "*.scm" ";"
|
|||
|
||||
fixme-comments ";" "--"
|
||||
|
||||
update
|
||||
|
||||
|
||||
|
|
|
@ -42,6 +42,7 @@ import Data.Generics.Product.Fields (field)
|
|||
import Lens.Micro.Platform
|
||||
import System.Process.Typed
|
||||
import Control.Monad.Trans.Cont
|
||||
import Control.Monad.Trans.Maybe
|
||||
import System.IO qualified as IO
|
||||
|
||||
import Streaming.Prelude qualified as S
|
||||
|
@ -414,6 +415,18 @@ list_ a = do
|
|||
fixmies <- selectFixmeThin a
|
||||
liftIO $ LBS.putStr $ Aeson.encodePretty fixmies
|
||||
|
||||
cat_ :: FixmePerks m => Text -> FixmeM m ()
|
||||
cat_ hash = void $ flip runContT pure do
|
||||
callCC \exit -> do
|
||||
|
||||
mha <- lift $ selectFixmeHash hash
|
||||
|
||||
ha <- ContT $ maybe1 mha (pure ())
|
||||
|
||||
fme <- lift $ selectFixme ha
|
||||
|
||||
notice $ pretty fme
|
||||
|
||||
printEnv :: FixmePerks m => FixmeM m ()
|
||||
printEnv = do
|
||||
g <- asks fixmeEnvGitDir
|
||||
|
@ -529,8 +542,7 @@ run what = do
|
|||
list_ whatever
|
||||
|
||||
ListVal [SymbolVal "cat", FixmeHashLike hash] -> do
|
||||
ha <- selectFixmeHash hash
|
||||
notice $ pretty ha
|
||||
cat_ hash
|
||||
|
||||
ReadFixmeStdin -> readFixmeStdin
|
||||
|
||||
|
|
|
@ -20,7 +20,7 @@ import Fixme.Config
|
|||
import HBS2.System.Dir
|
||||
import Data.Config.Suckless
|
||||
import Data.Config.Suckless.Syntax
|
||||
import DBPipe.SQLite
|
||||
import DBPipe.SQLite hiding (field)
|
||||
|
||||
import Data.Aeson as Aeson
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
|
@ -31,6 +31,7 @@ import Data.Either
|
|||
import Data.List (sortBy,sortOn)
|
||||
import Data.Ord
|
||||
import Lens.Micro.Platform
|
||||
import Data.Generics.Product.Fields (field)
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Coerce
|
||||
|
||||
|
@ -265,17 +266,19 @@ selectFixmeHash what = withState do
|
|||
|
||||
selectFixme :: FixmePerks m => Text -> FixmeM m (Maybe Fixme)
|
||||
selectFixme txt = do
|
||||
|
||||
attrs <- selectFixmeThin (FixmeHashExactly txt)
|
||||
<&> fmap coerce . headMay
|
||||
<&> fromMaybe mempty
|
||||
|
||||
runMaybeT do
|
||||
|
||||
self <- lift (withState $ select [qc|select blob from fixme where id = ? limit 1|] (Only txt))
|
||||
<&> listToMaybe . fmap fromOnly
|
||||
>>= toMPlus
|
||||
<&> (deserialiseOrFail @Fixme)
|
||||
>>= toMPlus
|
||||
|
||||
error "what"
|
||||
lift (withState $ select [qc|select fixme from fixme where id = ? limit 1|] (Only txt))
|
||||
<&> listToMaybe . fmap fromOnly
|
||||
>>= toMPlus
|
||||
<&> (deserialiseOrFail @Fixme)
|
||||
>>= toMPlus
|
||||
<&> over (field @"fixmeAttr") (<> attrs)
|
||||
|
||||
|
||||
data Bound = forall a . (ToField a, Show a) => Bound a
|
||||
|
|
Loading…
Reference in New Issue