Move JSON options to separate module

9 files changed, 61 insertions, 19 deletions

diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index ce919907..a511d6c1 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -92,6 +92,7 @@ import Text.PrettyPrint.Class
 import System.FilePath
 
 import Data.Torrent.InfoHash as IH
+import Data.Torrent.JSON
 import Data.Torrent.Layout
 import Data.Torrent.Piece
 
@@ -123,7 +124,7 @@ data InfoDict = InfoDict
     --   BEP 27: <http://www.bittorrent.org/beps/bep_0027.html>
   } deriving (Show, Read, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map Char.toLower . L.dropWhile isLower) } ''InfoDict)
+$(deriveJSON omitRecordPrefix ''InfoDict)
 
 makeLensesFor
   [ ("idInfoHash"  , "infohash"  )
@@ -239,7 +240,7 @@ instance ToJSON NominalDiffTime where
 instance FromJSON NominalDiffTime where
   parseJSON v = utcTimeToPOSIXSeconds <$> parseJSON v
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map Char.toLower . L.dropWhile isLower) } ''Torrent)
+$(deriveJSON omitRecordPrefix ''Torrent)
 
 makeLensesFor
   [ ("tAnnounce"    , "announce"    )
diff --git a/src/Data/Torrent/JSON.hs b/src/Data/Torrent/JSON.hs
new file mode 100644
index 00000000..3fa8973d
--- /dev/null
+++ b/src/Data/Torrent/JSON.hs
@@ -0,0 +1,31 @@
+module Data.Torrent.JSON
+       ( omitLensPrefix
+       , omitRecordPrefix
+       ) where
+
+import Data.Aeson.TH
+import Data.Char
+import Data.List as L
+
+
+-- | Ignore '_' prefix.
+omitLensPrefix :: Options
+omitLensPrefix = defaultOptions
+  { fieldLabelModifier     = L.dropWhile (== '_')
+  , constructorTagModifier = id
+  , allNullaryToStringTag  = True
+  , omitNothingFields      = True
+  }
+
+mapWhile :: (a -> Bool) -> (a -> a) -> [a] -> [a]
+mapWhile p f = go
+  where
+    go []       = []
+    go (x : xs)
+      |    p x    = f x : go xs
+      | otherwise = xs
+
+omitRecordPrefix :: Options
+omitRecordPrefix = omitLensPrefix
+  { fieldLabelModifier = mapWhile isUpper toLower . L.dropWhile isLower
+  }
\ No newline at end of file
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
index a32d74fa..453c0d4f 100644
--- a/src/Data/Torrent/Layout.hs
+++ b/src/Data/Torrent/Layout.hs
@@ -70,7 +70,6 @@ import Data.BEncode.Types
 import Data.ByteString as BS
 import Data.ByteString.Base16 as Base16
 import Data.ByteString.Char8 as BC
-import Data.Char as Char
 import Data.Foldable as F
 import Data.List as L
 import Data.Text as T
@@ -81,6 +80,7 @@ import Text.PrettyPrint.Class
 import System.FilePath
 import System.Posix.Types
 
+import Data.Torrent.JSON
 
 {-----------------------------------------------------------------------
 --  File attribytes
@@ -123,7 +123,7 @@ data FileInfo a = FileInfo {
                , Functor, Foldable
                )
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map Char.toLower . L.dropWhile isLower) } ''FileInfo)
+$(deriveJSON omitRecordPrefix ''FileInfo)
 
 makeLensesFor
   [ ("fiLength", "fileLength")
@@ -208,7 +208,7 @@ data LayoutInfo
     , liDirName  :: !ByteString
     } deriving (Show, Read, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map Char.toLower . L.dropWhile isLower) } ''LayoutInfo)
+$(deriveJSON omitRecordPrefix ''LayoutInfo)
 
 makeLensesFor
   [ ("liFile"   , "singleFile" )
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
index 00d4b843..d79da2ee 100644
--- a/src/Data/Torrent/Piece.hs
+++ b/src/Data/Torrent/Piece.hs
@@ -54,14 +54,15 @@ import Data.Bits.Extras
 import           Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Base64 as Base64
-import Data.Char
 import Data.Int
-import Data.List as L
 import Data.Text.Encoding as T
 import Data.Typeable
 import Text.PrettyPrint
 import Text.PrettyPrint.Class
 
+import Data.Torrent.JSON
+
+
 -- TODO add torrent file validation
 class Lint a where
    lint :: a -> Either String a
@@ -129,7 +130,7 @@ data Piece a = Piece
   , pieceData  :: !a
   } deriving (Show, Read, Eq, Functor, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''Piece)
+$(deriveJSON omitRecordPrefix ''Piece)
 
 instance NFData (Piece a)
 
@@ -166,7 +167,7 @@ data PieceInfo = PieceInfo
     -- ^ Concatenation of all 20-byte SHA1 hash values.
   } deriving (Show, Read, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''PieceInfo)
+$(deriveJSON omitRecordPrefix ''PieceInfo)
 
 -- | Number of bytes in each piece.
 makeLensesFor [("piPieceLength", "pieceLength")] ''PieceInfo
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index 34f8f299..ffcbf2aa 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -49,6 +49,8 @@ import Network.HTTP.Types.QueryLike
 import Text.PrettyPrint as PP
 import Text.PrettyPrint.Class
 
+import Data.Torrent.JSON
+
 
 -- | Progress data is considered as dynamic within one client
 -- session. This data also should be shared across client application
@@ -62,7 +64,7 @@ data Progress = Progress
   } deriving (Show, Read, Eq)
 
 $(makeLenses ''Progress)
-$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''Progress)
+$(deriveJSON omitLensPrefix ''Progress)
 
 -- | UDP tracker compatible encoding.
 instance Serialize Progress where
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 846a14f9..e7a4ea61 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -41,6 +41,7 @@ import Text.PrettyPrint.Class
 import Text.Read (readMaybe)
 import System.IO.Unsafe
 
+import Data.Torrent.JSON
 import Network.BitTorrent.Core.PeerId
 
 
@@ -68,7 +69,7 @@ data PeerAddr = PeerAddr
   , peerPort :: {-# UNPACK #-} !PortNumber
   } deriving (Show, Eq, Ord, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''PeerAddr)
+$(deriveJSON omitRecordPrefix ''PeerAddr)
 
 peer_id_key, peer_ip_key, peer_port_key :: BKey
 peer_id_key   = "peer id"
diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs
index 5ab73b65..d06fe727 100644
--- a/src/Network/BitTorrent/Exchange/Block.hs
+++ b/src/Network/BitTorrent/Exchange/Block.hs
@@ -41,6 +41,7 @@ import Data.Typeable
 import Text.PrettyPrint
 import Text.PrettyPrint.Class
 
+import Data.Torrent.JSON
 import Data.Torrent.Piece
 
 {-----------------------------------------------------------------------
@@ -84,7 +85,7 @@ data BlockIx = BlockIx {
   , ixLength :: {-# UNPACK #-} !BlockSize
   } deriving (Show, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''BlockIx)
+$(deriveJSON omitRecordPrefix ''BlockIx)
 
 getInt :: S.Get Int
 getInt = fromIntegral <$> S.getWord32be
diff --git a/src/Network/BitTorrent/Exchange/Status.hs b/src/Network/BitTorrent/Exchange/Status.hs
index 42766428..8472e575 100644
--- a/src/Network/BitTorrent/Exchange/Status.hs
+++ b/src/Network/BitTorrent/Exchange/Status.hs
@@ -36,14 +36,15 @@ module Network.BitTorrent.Exchange.Status
 import Control.Lens
 import Data.Aeson.TH
 import Data.Default
-import Data.List as L
 import Data.Maybe
 import Data.Monoid
 import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 
+import Data.Torrent.JSON
 import Network.BitTorrent.Exchange.Message
 
+
 {-----------------------------------------------------------------------
 --  Peer status
 -----------------------------------------------------------------------}
@@ -60,7 +61,7 @@ data PeerStatus = PeerStatus
   } deriving (Show, Eq, Ord)
 
 $(makeLenses ''PeerStatus)
-$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''PeerStatus)
+$(deriveJSON omitLensPrefix ''PeerStatus)
 
 instance Pretty PeerStatus where
   pretty PeerStatus {..} =
@@ -103,7 +104,7 @@ data SessionStatus = SessionStatus
   } deriving (Show, Eq)
 
 $(makeLenses ''SessionStatus)
-$(deriveJSON defaultOptions { fieldLabelModifier = L.tail } ''SessionStatus)
+$(deriveJSON omitRecordPrefix ''SessionStatus)
 
 instance Pretty SessionStatus where
   pretty SessionStatus {..} =
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 212181b9..943c3af5 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -34,6 +34,9 @@ module Network.BitTorrent.Tracker.Message
 
          -- ** Request
        , AnnounceQueryExt (..)
+       , renderAnnounceQueryExt
+       , parseAnnounceQueryExt
+
        , AnnounceRequest  (..)
        , parseAnnounceRequest
        , renderAnnounceRequest
@@ -87,6 +90,7 @@ import Network.Socket
 import Text.Read (readMaybe)
 
 import Data.Torrent.InfoHash
+import Data.Torrent.JSON
 import Data.Torrent.Progress
 import Network.BitTorrent.Core
 
@@ -104,7 +108,7 @@ data Event = Started
              -- ^ To be sent when the peer completes a download.
              deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''Event)
+$(deriveJSON omitRecordPrefix ''Event)
 
 -- | HTTP tracker protocol compatible encoding.
 instance QueryValueLike Event where
@@ -174,7 +178,7 @@ data AnnounceQuery = AnnounceQuery
    , reqEvent      :: Maybe Event
    } deriving (Show, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''AnnounceQuery)
+$(deriveJSON omitRecordPrefix ''AnnounceQuery)
 
 -- | UDP tracker protocol compatible encoding.
 instance Serialize AnnounceQuery where
@@ -480,7 +484,7 @@ data AnnounceInfo =
      , respWarning     :: !(Maybe Text)
      } deriving (Show, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''AnnounceInfo)
+$(deriveJSON omitRecordPrefix ''AnnounceInfo)
 
 -- | HTTP tracker protocol compatible encoding.
 instance BEncode AnnounceInfo where
@@ -630,7 +634,7 @@ data ScrapeEntry = ScrapeEntry {
   , siName       :: !(Maybe Text)
   } deriving (Show, Eq, Typeable)
 
-$(deriveJSON defaultOptions { fieldLabelModifier =  (L.map toLower . L.dropWhile isLower) } ''ScrapeEntry)
+$(deriveJSON omitRecordPrefix ''ScrapeEntry)
 
 -- | HTTP tracker protocol compatible encoding.
 instance BEncode ScrapeEntry where