Upgrade ron

ff-core/lib/FF.hs

@@ -55,7 +55,7 @@ import qualified Data.Text.IO as Text
 import Data.Time (Day, addDays, getCurrentTime, toModifiedJulianDay, utctDay)
 import Data.Traversable (for)
 import FF.Config (Config (Config), ConfigUI (ConfigUI), dataDir, shuffle)
-import FF.Options (Edit (..), New (..), maybeClearToMaybe)
+import FF.Options (Assign (Clear, Set), Edit (..), New (..), assignToMaybe)
 import FF.Types
   ( Contact (..),
     ContactId,
@@ -70,17 +70,20 @@ import FF.Types
     Sample (..),
     Status (..),
     Track (..),
-    contact_name_assign,
-    contact_status_assign,
+    contact_name_clear,
+    contact_status_clear,
     emptySample,
     loadNote,
-    note_end_assign,
+    note_end_clear,
     note_end_read,
-    note_start_assign,
+    note_end_set,
+    note_start_clear,
     note_start_read,
-    note_status_assign,
+    note_start_set,
+    note_status_clear,
     note_status_read,
-    note_text_assign,
+    note_status_set,
+    note_text_clear,
     note_text_zoom,
     note_track_read,
     taskMode
@@ -89,8 +92,8 @@ import RON.Data
   ( MonadObjectState,
     ObjectStateT,
     evalObjectState,
-    getObject,
     newObjectFrame,
+    readObject,
     runObjectState
     )
 import RON.Data.RGA (RGA (RGA))
@@ -126,7 +129,7 @@ import System.Random (StdGen, mkStdGen, randoms, split)
 load :: (Collection a, MonadStorage m) => DocId a -> m (Entity a)
 load docid = do
   Document {objectFrame} <- loadDocument docid
-  entityVal <- evalObjectState objectFrame getObject
+  entityVal <- evalObjectState objectFrame readObject
   pure $ Entity docid entityVal
 
 loadAll :: (Collection a, MonadStorage m) => m [Entity a]
@@ -288,7 +291,7 @@ updateTrackedNote oldNotes note = case note of
       obj <- newObjectFrame note
       createDocument obj
     Just noteid -> void $ modify noteid $ do
-      note_status_assignIfDiffer note_status
+      note_status_setIfDiffer note_status
       note_text_zoom $ RGA.edit text
   _ -> throwError "External note is expected to be supplied with tracking"
   where
@@ -340,8 +343,8 @@ cmdNewContact name = do
 
 cmdDeleteContact :: MonadStorage m => ContactId -> m (Entity Contact)
 cmdDeleteContact cid = modifyAndView cid $ do
-  contact_status_assign Nothing
-  contact_name_assign   Nothing
+  contact_status_clear
+  contact_name_clear
 
 cmdSearch
   :: MonadStorage m
@@ -363,19 +366,19 @@ cmdSearch substr archive ui limit today = do
 cmdDeleteNote :: MonadStorage m => NoteId -> m (Entity Note)
 cmdDeleteNote nid = modifyAndView nid $ do
   assertNoteIsNative
-  note_status_assign Nothing
-  note_text_assign   Nothing
-  note_start_assign  Nothing
-  note_end_assign    Nothing
+  note_status_clear
+  note_text_clear
+  note_start_clear
+  note_end_clear
 
 cmdDone :: MonadStorage m => NoteId -> m (Entity Note)
 cmdDone nid = modifyAndView nid $ do
   assertNoteIsNative
-  note_status_assign $ Just $ TaskStatus Archived
+  note_status_set $ TaskStatus Archived
 
 cmdUnarchive :: MonadStorage m => NoteId -> m (Entity Note)
 cmdUnarchive nid =
-  modifyAndView nid $ note_status_assign $ Just $ TaskStatus Active
+  modifyAndView nid $ note_status_set $ TaskStatus Active
 
 cmdEdit :: (MonadIO m, MonadStorage m) => Edit -> m [Entity Note]
 cmdEdit edit = case edit of
@@ -410,23 +413,25 @@ cmdEdit edit = case edit of
                 (,)
                   <$> (start <|> curStart)
                   <*> (end'  <|> curEnd)
-              end' = end >>= maybeClearToMaybe
+              end' = end >>= assignToMaybe
           whenJust newStartEnd
             $ uncurry assertStartBeforeEnd
         -- update
-        whenJust end   $ note_end_assign   . maybeClearToMaybe
-        whenJust start $ note_start_assign . Just
-        whenJust text  $ note_text_zoom    . RGA.editText
+        whenJust end $ \case
+          Clear -> note_end_clear
+          Set e -> note_end_set e
+        whenJust start note_start_set
+        whenJust text $ note_text_zoom . RGA.editText
 
 cmdPostpone :: (MonadIO m, MonadStorage m) => NoteId -> m (Entity Note)
 cmdPostpone nid = modifyAndView nid $ do
   today <- getUtcToday
   start <- note_start_read
   let start' = addDays 1 $ maybe today (max today) start
-  note_start_assign $ Just start'
+  note_start_set start'
   mEnd <- note_end_read
   case mEnd of
-    Just end | end < start' -> note_end_assign $ Just start'
+    Just end | end < start' -> note_end_set start'
     _ -> pure ()
 
 -- | Load document, apply changes and put it back to storage
@@ -451,7 +456,7 @@ modifyAndView docid f = do
   entityVal <-
     modify docid $ do
       f
-      getObject
+      readObject
   pure $ Entity docid entityVal
 
 getUtcToday :: MonadIO io => io Day
@@ -479,14 +484,14 @@ assertStartBeforeEnd :: MonadE m => Day -> Day -> m ()
 assertStartBeforeEnd start end =
   unless (start <= end) $ throwError "task cannot end before it is started"
 
-note_status_assignIfDiffer
+note_status_setIfDiffer
   :: (ReplicaClock m, MonadE m, MonadObjectState Note m)
   => Maybe NoteStatus
   -> m ()
-note_status_assignIfDiffer newStatus = do
+note_status_setIfDiffer newStatus = do
   curStatus <- note_status_read
   when (curStatus /= newStatus)
-    $ note_status_assign newStatus
+    $ maybe note_status_clear note_status_set newStatus
 
 assertNoteIsNative :: (MonadE m, MonadObjectState Note m) => m ()
 assertNoteIsNative = do

ff-core/lib/FF/Options.hs

@@ -5,19 +5,19 @@
 {-# LANGUAGE TypeApplications #-}
 
 module FF.Options (
+    Assign (..),
     Cmd (..),
     CmdAction (..),
     Config (..),
     Contact (..),
     DataDir (..),
     Edit (..),
-    MaybeClear (..),
     New (..),
     Options (..),
     Search (..),
     Shuffle (..),
     Track (..),
-    maybeClearToMaybe,
+    assignToMaybe,
     parseOptions,
     showHelp,
 ) where
@@ -87,19 +87,19 @@ data DataDir = DataDirJust FilePath | DataDirYandexDisk
 
 data Shuffle = Shuffle | Sort
 
-data MaybeClear a = Clear | Set a
+data Assign a = Clear | Set a
     deriving (Show)
 
-maybeClearToMaybe :: MaybeClear a -> Maybe a
-maybeClearToMaybe = \case
+assignToMaybe :: Assign a -> Maybe a
+assignToMaybe = \case
     Clear -> Nothing
     Set x -> Just x
 
 data Edit = Edit
     { ids   :: NonEmpty NoteId
     , text  :: Maybe Text
     , start :: Maybe Day
-    , end   :: Maybe (MaybeClear Day)
+    , end   :: Maybe (Assign Day)
     }
     deriving (Show)
 
@@ -225,7 +225,7 @@ parser h =
         <$> (NonEmpty.fromList <$> some noteid)
         <*> optional noteTextOption
         <*> optional startDateOption
-        <*> optional maybeClearEnd
+        <*> optional assignEnd
     search = Search
         <$> strArgument (metavar "TEXT")
         <*> searchT
@@ -249,7 +249,7 @@ parser h =
         dateOption $ long "start" <> short 's' <> help "start date"
     noteTextOption = strOption $
         long "text" <> short 't' <> help "note text" <> metavar "TEXT"
-    maybeClearEnd
+    assignEnd
         =   Set <$> endDateOption
         <|> flag' Clear (long "end-clear" <> help "clear end date")
 

ff-core/lib/FF/Types.hs

@@ -27,7 +27,6 @@ import qualified Data.Aeson as JSON
 import Data.Aeson.TH (defaultOptions, deriveFromJSON)
 import Data.Aeson.Types (parseEither)
 import Data.ByteString.Lazy (ByteString)
-import Data.Functor (($>))
 import Data.Hashable (Hashable)
 import Data.List (genericLength)
 import Data.Map.Strict (Map)
@@ -43,8 +42,8 @@ import RON.Data
     Replicated (encoding),
     ReplicatedAsPayload (fromPayload, toPayload),
     evalObjectState,
-    getObject,
     payloadEncoding,
+    readObject,
     stateFromChunk,
     stateToWireChunk
     )
@@ -65,10 +64,9 @@ import RON.Storage
 import RON.Storage.Backend (Document (Document, objectFrame), MonadStorage)
 import RON.Types
   ( Atom (AUuid),
-    Object (Object),
+    ObjectRef (ObjectRef),
     ObjectFrame (ObjectFrame, frame, uuid),
     Op (Op),
-    Payload,
     UUID,
     WireStateChunk (WireStateChunk, stateBody, stateType)
     )
@@ -98,7 +96,7 @@ instance ReplicatedAsPayload NoteStatus where
   (enum Status
     Active Archived)
 
-  (opaque atoms NoteStatus)
+  (opaque_atoms NoteStatus)
     ; TODO(2018-12-05, cblp) (enum NoteStatus (extends Status) Wiki)
 
   (struct_set Contact
@@ -248,19 +246,19 @@ type EntitySample a = Sample (Entity a)
 loadNote :: MonadStorage m => NoteId -> m (Entity Note)
 loadNote docid = do
   Document {objectFrame} <- loadDocument docid
-  let tryCurrentEncoding = evalObjectState objectFrame getObject
+  let tryCurrentEncoding = evalObjectState objectFrame readObject
   case tryCurrentEncoding of
     Right note -> pure $ Entity docid note
     Left e1 -> do
-      let tryNote2Encoding = evalObjectState objectFrame getNoteFromV2
+      let tryNote2Encoding = evalObjectState objectFrame readNoteFromV2
       case tryNote2Encoding of
         Right note -> pure $ Entity docid note
         Left e2 -> throwError $ Error "loadNote" [e1, e2]
 
-getNoteFromV2 :: (MonadE m, MonadObjectState a m) => m Note
-getNoteFromV2 = do
-  Object uuid <- ask
-  NoteV2 {..} <- runReaderT getObject (Object @NoteV2 uuid)
+readNoteFromV2 :: (MonadE m, MonadObjectState a m) => m Note
+readNoteFromV2 = do
+  ObjectRef uuid <- ask
+  NoteV2 {..} <- runReaderT readObject (ObjectRef @NoteV2 uuid)
   pure
     Note
       { note_end    = noteV2_end,
@@ -292,7 +290,7 @@ parseNoteV1 objectId = liftEitherString . (eitherDecode >=> parseEither p)
       let endTime'    = timeFromV1 endTime
           startTime'  = timeFromV1 startTime
           statusTime' = timeFromV1 statusTime
-      let trackPayload = toPayloadM $ mTracked $> trackId
+      -- let trackPayload = toPayloadM $ mTracked $> trackId
       mTrackObject <-
         case mTracked of
           Nothing -> pure Nothing
@@ -315,12 +313,14 @@ parseNoteV1 objectId = liftEitherString . (eitherDecode >=> parseEither p)
             Map.fromList
               $ [ ( objectId,
                     mkLww
-                      [ Op endTime'    endName    $ toPayloadM end,
-                        Op startTime'  startName  $ toPayload start,
-                        Op statusTime' statusName $ toPayload status,
-                        Op objectId    textName   $ toPayload textId,
-                        Op objectId    trackName    trackPayload
-                        ]
+                      $ [Op endTime' endName $ toPayload e | Just e <- [end]]
+                      ++  [ Op startTime' startName $ toPayload start,
+                            Op statusTime' statusName $ toPayload status,
+                            Op objectId textName $ toPayload textId
+                            ]
+                      ++  [ Op objectId trackName $ toPayload trackId
+                            | Just _ <- [mTracked]
+                            ]
                     ),
                   (textId, stateToWireChunk $ rgaFromV1 text) -- rgaType
                   ]
@@ -339,9 +339,6 @@ parseNoteV1 objectId = liftEitherString . (eitherDecode >=> parseEither p)
     sourceName     = $(UUID.liftName "source")
     urlName        = $(UUID.liftName "url")
 
-toPayloadM :: ReplicatedAsPayload a => Maybe a -> Payload
-toPayloadM = maybe [] toPayload
-
 timeFromV1 :: CRDT.LamportTime -> UUID
 timeFromV1 (CRDT.LamportTime unixTime (CRDT.Pid pid)) =
   encodeEvent

ff-core/lib/FF/Upgrade.hs

@@ -44,7 +44,7 @@ import RON.Storage.FS
     )
 import RON.Types
   ( Atom (AUuid),
-    Object (Object),
+    ObjectRef (ObjectRef),
     Op (Op, opId, payload, refId),
     StateChunk (StateChunk),
     StateFrame,
@@ -67,7 +67,7 @@ upgradeNoteCollection = do
   for_ docs $ \docid -> do
     docid' <- upgradeDocId docid
     modify docid' $ errorContext ("docid' = " <> show docid') $ do
-      Object noteId <- ask
+      ObjectRef noteId <- ask
       errorContext "convert note" $ convertLwwToSet noteId
       mTrack <- note_track_get
       whenJust mTrack

ff-qt/FFI/Haskell.hs

@@ -12,8 +12,8 @@ import           RON.Storage.FS (runStorage)
 import qualified RON.Storage.FS as StorageFS
 
 import           FF (cmdDone, cmdEdit, cmdPostpone)
-import           FF.Options (Edit (Edit, end, ids, start, text),
-                             MaybeClear (Clear, Set))
+import           FF.Options (Assign (Clear, Set),
+                             Edit (Edit, end, ids, start, text))
 
 {-# ANN module "HLint: ignore Use camelCase" #-}