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")
|
(play-git-log-file-all ".fixme-new/log")
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(fixme-play-log-action
|
||||||
|
(export-fixmies ".fixme-new/fixme.log")
|
||||||
|
)
|
||||||
|
|
||||||
(fixme-play-log-action
|
(fixme-play-log-action
|
||||||
(hello kitty)
|
(hello kitty)
|
||||||
)
|
)
|
||||||
|
|
|
@ -553,16 +553,25 @@ runForms ss = for_ ss $ \s -> do
|
||||||
let action = ReadLogAction @c $ \_ -> liftIO (withFixmeEnv env (runForms xs))
|
let action = ReadLogAction @c $ \_ -> liftIO (withFixmeEnv env (runForms xs))
|
||||||
atomically $ modifyTVar t (<> [action])
|
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
|
ListVal [SymbolVal "play-git-log-file-all", StringLike fn] -> do
|
||||||
warn $ red "play-git-log-file-all" <+> pretty fn
|
warn $ red "play-git-log-file-all" <+> pretty fn
|
||||||
scanGitLogLocal fn runForms
|
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
|
ListVal [SymbolVal "play-log-file", StringLike fn] -> do
|
||||||
|
|
||||||
env <- ask
|
env <- ask
|
||||||
|
|
|
@ -26,6 +26,7 @@ module Fixme.State
|
||||||
, isProcessed
|
, isProcessed
|
||||||
, selectProcessed
|
, selectProcessed
|
||||||
, HasPredicate(..)
|
, HasPredicate(..)
|
||||||
|
, SelectPredicate(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Fixme.Prelude
|
import Fixme.Prelude
|
||||||
|
|
|
@ -161,7 +161,7 @@ data Fixme =
|
||||||
, fixmePlain :: [FixmePlainLine]
|
, fixmePlain :: [FixmePlainLine]
|
||||||
, fixmeAttr :: HashMap FixmeAttrName FixmeAttrVal
|
, fixmeAttr :: HashMap FixmeAttrName FixmeAttrVal
|
||||||
}
|
}
|
||||||
deriving stock (Show,Data,Generic)
|
deriving stock (Ord,Eq,Show,Data,Generic)
|
||||||
|
|
||||||
instance Monoid Fixme where
|
instance Monoid Fixme where
|
||||||
mempty = Fixme mempty mempty Nothing Nothing Nothing Nothing mempty mempty
|
mempty = Fixme mempty mempty Nothing Nothing Nothing Nothing mempty mempty
|
||||||
|
@ -201,6 +201,7 @@ class HasSequence w where
|
||||||
data CompactAction =
|
data CompactAction =
|
||||||
Deleted Word64 HashRef
|
Deleted Word64 HashRef
|
||||||
| Modified Word64 HashRef FixmeAttrName FixmeAttrVal
|
| Modified Word64 HashRef FixmeAttrName FixmeAttrVal
|
||||||
|
| Added Word64 Fixme
|
||||||
deriving stock (Eq,Ord,Show,Generic)
|
deriving stock (Eq,Ord,Show,Generic)
|
||||||
|
|
||||||
class MkKey a where
|
class MkKey a where
|
||||||
|
@ -209,11 +210,14 @@ class MkKey a where
|
||||||
instance MkKey CompactAction where
|
instance MkKey CompactAction where
|
||||||
mkKey (Deleted _ h) = "D" <> LBS.toStrict (serialise h)
|
mkKey (Deleted _ h) = "D" <> LBS.toStrict (serialise h)
|
||||||
mkKey (Modified _ h _ _) = "M" <> LBS.toStrict (serialise h)
|
mkKey (Modified _ h _ _) = "M" <> LBS.toStrict (serialise h)
|
||||||
|
mkKey (Added _ fixme) = "A" <> LBS.toStrict (serialise fixme)
|
||||||
|
|
||||||
instance Pretty CompactAction where
|
instance Pretty CompactAction where
|
||||||
pretty = \case
|
pretty = \case
|
||||||
Deleted s r -> pretty $ mklist @C [ mksym "deleted", mkint s, mkstr r ]
|
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 ]
|
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
|
instance Serialise CompactAction
|
||||||
|
|
||||||
|
@ -226,6 +230,7 @@ seqOf :: CompactAction -> Maybe Word64
|
||||||
seqOf = \case
|
seqOf = \case
|
||||||
Deleted w _ -> Just w
|
Deleted w _ -> Just w
|
||||||
Modified w _ _ _ -> Just w
|
Modified w _ _ _ -> Just w
|
||||||
|
Added w _ -> Just w
|
||||||
|
|
||||||
instance HasSequence CompactAction where
|
instance HasSequence CompactAction where
|
||||||
getSequence x = fromMaybe 0 (seqOf x)
|
getSequence x = fromMaybe 0 (seqOf x)
|
||||||
|
|
Loading…
Reference in New Issue