mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
02ff10bd09
commit
6e31a1e094
|
@ -42,6 +42,10 @@ fixme-comments ";" "--"
|
|||
(play-git-log-file-all ".fixme-new/log")
|
||||
)
|
||||
|
||||
(fixme-play-log-action
|
||||
(export-fixmies ".fixme-new/fixme.log")
|
||||
)
|
||||
|
||||
(fixme-play-log-action
|
||||
(hello kitty)
|
||||
)
|
||||
|
|
|
@ -553,16 +553,25 @@ runForms ss = for_ ss $ \s -> do
|
|||
let action = ReadLogAction @c $ \_ -> liftIO (withFixmeEnv env (runForms xs))
|
||||
atomically $ modifyTVar t (<> [action])
|
||||
|
||||
ListVal (SymbolVal "append-file" : StringLike fn : StringLikeList xs) -> do
|
||||
debug "append-file"
|
||||
liftIO $ for_ xs $ \x -> do
|
||||
appendFile fn x
|
||||
appendFile fn "\n"
|
||||
|
||||
ListVal [SymbolVal "play-git-log-file-all", StringLike fn] -> do
|
||||
warn $ red "play-git-log-file-all" <+> pretty fn
|
||||
scanGitLogLocal fn runForms
|
||||
|
||||
ListVal [SymbolVal "export-fixmies", StringLike fn] -> do
|
||||
e <- getEpoch
|
||||
warn $ red "EXPORT-FIXMIES" <+> pretty fn
|
||||
sto <- compactStorageOpen @HbSync mempty fn
|
||||
fx <- selectFixmeThin ()
|
||||
for_ fx $ \(FixmeThin m) -> void $ runMaybeT do
|
||||
h <- HM.lookup "fixme-hash" m & toMPlus
|
||||
loaded <- lift (selectFixme (coerce h)) >>= toMPlus
|
||||
let what = Added e loaded
|
||||
let k = mkKey what
|
||||
get sto k >>= guard . isNothing
|
||||
put sto (mkKey what) (LBS.toStrict $ serialise what)
|
||||
warn $ red "export" <+> pretty h
|
||||
compactStorageClose sto
|
||||
|
||||
ListVal [SymbolVal "play-log-file", StringLike fn] -> do
|
||||
|
||||
env <- ask
|
||||
|
|
|
@ -26,6 +26,7 @@ module Fixme.State
|
|||
, isProcessed
|
||||
, selectProcessed
|
||||
, HasPredicate(..)
|
||||
, SelectPredicate(..)
|
||||
) where
|
||||
|
||||
import Fixme.Prelude
|
||||
|
|
|
@ -161,7 +161,7 @@ data Fixme =
|
|||
, fixmePlain :: [FixmePlainLine]
|
||||
, fixmeAttr :: HashMap FixmeAttrName FixmeAttrVal
|
||||
}
|
||||
deriving stock (Show,Data,Generic)
|
||||
deriving stock (Ord,Eq,Show,Data,Generic)
|
||||
|
||||
instance Monoid Fixme where
|
||||
mempty = Fixme mempty mempty Nothing Nothing Nothing Nothing mempty mempty
|
||||
|
@ -201,6 +201,7 @@ class HasSequence w where
|
|||
data CompactAction =
|
||||
Deleted Word64 HashRef
|
||||
| Modified Word64 HashRef FixmeAttrName FixmeAttrVal
|
||||
| Added Word64 Fixme
|
||||
deriving stock (Eq,Ord,Show,Generic)
|
||||
|
||||
class MkKey a where
|
||||
|
@ -209,11 +210,14 @@ class MkKey a where
|
|||
instance MkKey CompactAction where
|
||||
mkKey (Deleted _ h) = "D" <> LBS.toStrict (serialise h)
|
||||
mkKey (Modified _ h _ _) = "M" <> LBS.toStrict (serialise h)
|
||||
mkKey (Added _ fixme) = "A" <> LBS.toStrict (serialise fixme)
|
||||
|
||||
instance Pretty CompactAction where
|
||||
pretty = \case
|
||||
Deleted s r -> pretty $ mklist @C [ mksym "deleted", mkint s, mkstr r ]
|
||||
Modified s r k v -> pretty $ mklist @C [ mksym "modified", mkint s, mkstr r, mkstr k, mkstr v ]
|
||||
-- FIXME: normal-pretty-instance
|
||||
Added w fx -> pretty $ mklist @C [ mksym "added", mksym "..." ]
|
||||
|
||||
instance Serialise CompactAction
|
||||
|
||||
|
@ -226,6 +230,7 @@ seqOf :: CompactAction -> Maybe Word64
|
|||
seqOf = \case
|
||||
Deleted w _ -> Just w
|
||||
Modified w _ _ _ -> Just w
|
||||
Added w _ -> Just w
|
||||
|
||||
instance HasSequence CompactAction where
|
||||
getSequence x = fromMaybe 0 (seqOf x)
|
||||
|
|
Loading…
Reference in New Issue