Strip unnecessary prefixes in JSON repr

Author: cblp

ff-core/lib/FF/Types.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS -Wwarn=orphans #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -23,7 +24,13 @@ module FF.Types where
 
 import Control.Monad.Except (throwError)
 import Data.Aeson qualified as JSON
-import Data.Aeson.Extra (ToJSON, singletonObjectSum, toJSON, (.=))
+import Data.Aeson.Extra (
+    ToJSON,
+    fieldLabelModifier,
+    singletonObjectSum,
+    toJSON,
+    (.=),
+ )
 import Data.Aeson.Key qualified as JSON.Key
 import Data.Aeson.KeyMap qualified as JSON.KeyMap
 import Data.Aeson.TH (defaultOptions, deriveToJSON)
@@ -56,11 +63,7 @@ import RON.Data.Time (Day)
 import RON.Error (Error (Error))
 import RON.Schema.TH (mkReplicated)
 import RON.Storage (Collection, DocId, collectionName, loadDocument)
-import RON.Storage.Backend (
-    DocId (DocId),
-    Document (Document),
-    MonadStorage,
- )
+import RON.Storage.Backend (DocId (DocId), Document (Document), MonadStorage)
 import RON.Storage.Backend qualified
 import RON.Text.Serialize (serializeUuid)
 import RON.Types (Atom (AUuid), ObjectRef, UUID)
@@ -254,28 +257,33 @@ data instance View Note = NoteView
     }
     deriving (Eq, Show)
 
-deriveToJSON defaultOptions ''LinkType
-deriveToJSON defaultOptions ''Status
-deriveToJSON singletonObjectSum ''NoteStatus
-deriveToJSON defaultOptions ''Tag
-deriveToJSON defaultOptions ''Track
-
-$(fold <$> for [''Link, ''Note] (deriveToJSON defaultOptions))
+$( fold
+    <$> for
+        [ (''Note, defaultOptions{fieldLabelModifier = drop 5})
+        , (''NoteStatus, singletonObjectSum)
+        , (''Status, defaultOptions)
+        , (''Tag, defaultOptions{fieldLabelModifier = drop 4})
+        , (''Track, defaultOptions{fieldLabelModifier = drop 6})
+        ]
+        \(name, options) -> deriveToJSON options name
+ )
 
 instance ToJSON (View Note) where
     toJSON NoteView{note, tags} =
-        JSON.Object $ JSON.KeyMap.insert "note_tags" tags' noteObj
+        modifyObject (JSON.KeyMap.insert "tags" tags') $ toJSON note
       where
-        noteObj = case toJSON note of
-            JSON.Object obj -> obj
-            _ -> error "Note must be serialized to Object"
         tags' =
             JSON.Object
                 . JSON.KeyMap.fromMap
                 . Map.mapKeysMonotonic JSON.Key.fromText
                 . fmap JSON.String
                 $ tags
 
+modifyObject :: (JSON.Object -> JSON.Object) -> JSON.Value -> JSON.Value
+modifyObject f val = case val of
+    JSON.Object obj -> JSON.Object $ f obj
+    _ -> error "Note must be serialized to Object"
+
 type ModeMap = Map TaskMode
 
 -- | Sub-status of an 'Active' task from the perspective of the user.

ff-core/lib/FF/Upgrade.hs

@@ -46,7 +46,7 @@ import RON.Types (
 import RON.UUID (pattern Zero)
 import qualified RON.UUID as UUID
 
-import FF.Types (Note, Tag)
+import FF.Types (Note)
 
 upgradeDatabase :: (MonadStorage m) => m ()
 upgradeDatabase = do

ff-test/ff.dump/note/457OFM10BN2-24NUHR86AE

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-12-08
-note_status:
+end: null
+links: []
+start: 2018-12-08
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: import from gmail
-note_track: null
+tags: {}
+text: import from gmail
+track: null

ff-test/ff.dump/note/457OFTMBBKM-24NUHR86AE

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-03-31
-note_status:
+end: null
+links: []
+start: 2018-03-31
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: import from github issues
-note_track: null
+tags: {}
+text: import from github issues
+track: null

ff-test/ff.dump/note/45B2V772N07-1333OPN2L

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-03-31
-note_status:
+end: null
+links: []
+start: 2018-03-31
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: try to use Swarm/RON as the backend
-note_track: null
+tags: {}
+text: try to use Swarm/RON as the backend
+track: null

ff-test/ff.dump/note/45D9148FP33-1333OPN2L

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-04-17
-note_status:
+end: null
+links: []
+start: 2018-04-17
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: 'CLI: syntax coloring'
-note_track: null
+tags: {}
+text: 'CLI: syntax coloring'
+track: null

ff-test/ff.dump/note/45DI70MPSK2-24NUHR86AE

@@ -1,9 +1,9 @@
-note_end: null
-note_links: []
-note_start: 2018-02-21
-note_status:
+end: null
+links: []
+start: 2018-02-21
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: 'repeating tasks: `done` moves to future in fixed period; may be useful
-  for utility payments, or for other regular routines'
-note_track: null
+tags: {}
+text: 'repeating tasks: `done` moves to future in fixed period; may be useful for
+  utility payments, or for other regular routines'
+track: null

ff-test/ff.dump/note/45E5BE92I4D-1333OPN2L

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-02-23
-note_status:
+end: null
+links: []
+start: 2018-02-23
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: due in N days
-note_track: null
+tags: {}
+text: due in N days
+track: null

ff-test/ff.dump/note/45KKI53IBH1-1333OPN2L

@@ -1,8 +1,8 @@
-note_end: null
-note_links: []
-note_start: 2018-12-08
-note_status:
+end: null
+links: []
+start: 2018-12-08
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: import from Google Keep
-note_track: null
+tags: {}
+text: import from Google Keep
+track: null

ff-test/ff.dump/note/45L712HR8AL-1333OPN2L

@@ -1,10 +1,10 @@
-note_end: null
-note_links: []
-note_start: 2018-02-25
-note_status:
+end: null
+links: []
+start: 2018-02-25
+status:
   TaskStatus: Archived
-note_tags: {}
-note_text: |-
+tags: {}
+text: |-
   postponed N times
   increment counter on `postpone` and `edit --start` or `edit --end`
-note_track: null
+track: null