From c2fa4732b54ceb6d0329bb49ed110477acd735b6 Mon Sep 17 00:00:00 2001
From: Ilya Portnov <portnov84@rambler.ru>
Date: Sun, 2 Oct 2011 19:35:19 +0600
Subject: [PATCH] Remove some code duplication using Data.Default.

---
 JVM/Builder/Monad.hs | 14 +++-----------
 JVM/ClassFile.hs     | 28 ++++++++++++++++++++++++++++
 JVM/Common.hs        |  7 +++++++
 JVM/Converter.hs     | 14 ++++++--------
 4 files changed, 44 insertions(+), 19 deletions(-)

diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index 01e93f1..837c312 100644
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -220,21 +220,13 @@ generate name gen =
         gen
       res = execState generator emptyGState
       code = genCode res
-  in  Class {
-        magic = 0xCAFEBABE,
-        minorVersion = 0,
-        majorVersion = 50,
+      d = defaultClass :: Class Direct
+  in  d {
         constsPoolSize = fromIntegral $ M.size (currentPool res),
         constsPool = currentPool res,
         accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC],
         thisClass = name,
         superClass = "java/lang/Object",
-        interfacesCount = 0,
-        interfaces = [],
-        classFieldsCount = 0,
-        classFields = [],
         classMethodsCount = fromIntegral $ length (doneMethods res),
-        classMethods = doneMethods res,
-        classAttributesCount = 0,
-        classAttributes = AR M.empty }
+        classMethods = doneMethods res }
 
diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index 2b7e1e7..d2f3029 100644
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -19,6 +19,7 @@ module JVM.ClassFile
    Constant (..),
    AccessFlag (..), AccessFlags,
    Attributes (..),
+   defaultClass,
    -- * Misc
    HasSignature (..), HasAttributes (..),
    NameType (..),
@@ -35,6 +36,7 @@ import Data.Binary.Get
 import Data.Binary.Put
 import Data.Char
 import Data.List
+import Data.Default
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
@@ -96,10 +98,16 @@ data family Attributes stage
 data instance Attributes File = AP {attributesList :: [Attribute]}
   deriving (Eq, Show)
 
+instance Default (Attributes File) where
+  def = AP []
+
 -- | At Direct stage, attributes are represented as a Map.
 data instance Attributes Direct = AR (M.Map B.ByteString B.ByteString)
   deriving (Eq, Show)
 
+instance Default (Attributes Direct) where
+  def = AR M.empty
+
 -- | Size of attributes set at Direct stage
 arsize :: Attributes Direct -> Int
 arsize (AR m) = M.size m
@@ -214,6 +222,26 @@ deriving instance Eq (Constant File)
 deriving instance Eq (Constant Direct)
 deriving instance Show (Constant File)
 
+defaultClass :: (Default (AccessFlags stage), Default (Link stage B.ByteString), Default (Attributes stage))
+             => Class stage
+defaultClass = Class {
+  magic = 0xCAFEBABE,
+  minorVersion = 0,
+  majorVersion = 50,
+  constsPoolSize = 0,
+  constsPool = def,
+  accessFlags = def,
+  thisClass = def,
+  superClass = def,
+  interfacesCount = 0,
+  interfaces = [],
+  classFieldsCount = 0,
+  classFields = [],
+  classMethodsCount = 0,
+  classMethods = [],
+  classAttributesCount = 0,
+  classAttributes = def }
+
 instance Binary (Class File) where
   put (Class {..}) = do
     put magic
diff --git a/JVM/Common.hs b/JVM/Common.hs
index b3762c3..65a6c6f 100644
--- a/JVM/Common.hs
+++ b/JVM/Common.hs
@@ -15,9 +15,16 @@ import qualified Data.ByteString.Lazy as B
 import Data.Char
 import Data.String
 import qualified Data.Map as M
+import Data.Default
 
 import JVM.ClassFile
 
+instance Default B.ByteString where
+  def = B.empty
+
+instance Default Word16 where
+  def = 0
+
 instance IsString B.ByteString where
   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
 
diff --git a/JVM/Converter.hs b/JVM/Converter.hs
index a498c96..911024c 100644
--- a/JVM/Converter.hs
+++ b/JVM/Converter.hs
@@ -16,6 +16,7 @@ import Data.List
 import Data.Word
 import Data.Bits
 import Data.Binary
+import Data.Default () -- import instances only
 import qualified Data.ByteString.Lazy as B
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -39,10 +40,8 @@ classFile2Direct :: Class File -> Class Direct
 classFile2Direct (Class {..}) =
   let pool = poolFile2Direct constsPool
       superName = className $ pool ! superClass
-  in Class {
-      magic = 0xCAFEBABE,
-      minorVersion = 0,
-      majorVersion = 50,
+      d = defaultClass :: Class Direct
+  in d {
       constsPoolSize = fromIntegral (M.size pool),
       constsPool = pool,
       accessFlags = accessFile2Direct accessFlags,
@@ -58,10 +57,9 @@ classFile2Direct (Class {..}) =
       classAttributes = attributesFile2Direct pool classAttributes }
 
 classDirect2File :: Class Direct -> Class File
-classDirect2File (Class {..}) = Class {
-    magic = 0xCAFEBABE,
-    minorVersion = 0,
-    majorVersion = 50,
+classDirect2File (Class {..}) =
+  let d = defaultClass :: Class File
+  in d {
     constsPoolSize = fromIntegral (M.size poolInfo + 1),
     constsPool = poolInfo,
     accessFlags = access2word16 accessFlags,
-- 
2.25.1