Move defaultDerivedClasses as a ToolSetting

Author: adinapoli

api-tools.cabal

@@ -53,7 +53,6 @@ Library
         Data.API.Tools.CBOR
         Data.API.Tools.Combinators
         Data.API.Tools.Datatypes
-        Data.API.Tools.DataTypeable
         Data.API.Tools.DeepSeq
         Data.API.Tools.Enum
         Data.API.Tools.Example

src/Data/API/Tools.hs

@@ -24,7 +24,6 @@ module Data.API.Tools
       -- * Individual tools
     , enumTool
     , exampleTool
-    , dataTypeableTool
     , deepSeqTool
     , jsonTool
     , jsonTool'
@@ -42,7 +41,6 @@ module Data.API.Tools
     ) where
 
 import           Data.API.Tools.Combinators
-import           Data.API.Tools.DataTypeable
 import           Data.API.Tools.Datatypes
 import           Data.API.Tools.DeepSeq
 import           Data.API.Tools.Enum
@@ -65,7 +63,7 @@ generate = generateWith defaultToolSettings
 -- | Generate the datatypes corresponding to an API, allowing the
 -- 'ToolSettings' to be overriden.
 generateWith :: ToolSettings -> API -> Q [Dec]
-generateWith ts api = generateAPIToolsWith ts api [datatypesTool]
+generateWith ts api = generateAPIToolsWith ts api [datatypesTool ts]
 
 -- | Apply a list of tools to an 'API', generating TH declarations.
 -- See the individual tool descriptions for details.  Note that

src/Data/API/Tools/Combinators.hs

@@ -22,13 +22,16 @@ module Data.API.Tools.Combinators
     , warnOnOmittedInstance
     , newtypeSmartConstructors
     , defaultToolSettings
+    , defaultDerivedClasses
     ) where
 
 import           Data.API.Types
 
 import           Control.Applicative
 import           Data.Monoid
 import           Data.Semigroup as Sem
+import           Data.String
+import           Data.Typeable
 import           Language.Haskell.TH
 import           Prelude
 
@@ -43,15 +46,41 @@ data ToolSettings = ToolSettings
     , newtypeSmartConstructors :: Bool
       -- ^ Rename the constructors of filtered newtypes and generate
       -- smart constructors that enforce the invariants
+    , defaultDerivedClasses :: APINode -> [Name]
+      -- ^ The classes which are derived automatically by api-tools.
     }
 
 -- | Default settings designed to be overridden.
 defaultToolSettings :: ToolSettings
 defaultToolSettings = ToolSettings
     { warnOnOmittedInstance = False
     , newtypeSmartConstructors = False
+    , defaultDerivedClasses = default_derived_classes
     }
 
+-- | Default names of classes for which to derive instances, depending
+-- on the type of API node.
+default_derived_classes :: APINode -> [Name]
+default_derived_classes an = case anSpec an of
+    SpNewtype sn -> case snType sn of
+                      BTstring -> ''IsString : derive_leaf_nms
+                      BTbinary -> derive_leaf_nms
+                      BTbool   -> derive_leaf_nms
+                      BTint    -> derive_leaf_nms
+                      BTutc    -> derive_leaf_nms
+    SpRecord  _  -> derive_node_nms
+    SpUnion   _  -> derive_node_nms
+    SpEnum    _  -> derive_leaf_nms ++ [''Bounded, ''Enum]
+    SpSynonym _  -> []
+
+derive_leaf_nms :: [Name]
+derive_leaf_nms = [''Show,''Eq,''Ord,''Typeable]
+
+derive_node_nms :: [Name]
+derive_node_nms = [''Show,''Eq,''Typeable]
+
+
+
 -- | A @'Tool' a@ is something that can generate TH declarations from
 -- a value of type @a@.  Tools can be combined using the 'Monoid'
 -- instance.

src/Data/API/Tools/DataTypeable.hs

@@ -2,7 +2,6 @@
 module Data.API.Tools.Datatypes
     ( datatypesTool
     , datatypesTool'
-    , defaultDerivedClasses
     , type_nm
     , rep_type_nm
     , nodeT
@@ -32,15 +31,14 @@ import           Data.Maybe
 import           Data.String
 import qualified Data.Text                      as T
 import           Data.Time
-import           Data.Typeable
 import           Language.Haskell.TH
 import           Text.Regex
 import           Prelude
 
 
 -- | Tool to generate datatypes and type synonyms corresponding to an API
-datatypesTool :: APITool
-datatypesTool = datatypesTool' defaultDerivedClasses
+datatypesTool :: ToolSettings -> APITool
+datatypesTool = datatypesTool' . defaultDerivedClasses
 
 -- | Tool to generate datatypes and type synonyms corresponding to an
 -- API, where the function specifies the derived classes for each datatype.
@@ -165,28 +163,6 @@ basic_type bt =
       BTutc    -> ConT ''UTCTime
 
 
--- | Default names of classes for which to derive instances, depending
--- on the type of API node.
-defaultDerivedClasses :: APINode -> [Name]
-defaultDerivedClasses an = case anSpec an of
-    SpNewtype sn -> case snType sn of
-                      BTstring -> ''IsString : derive_leaf_nms
-                      BTbinary -> derive_leaf_nms
-                      BTbool   -> derive_leaf_nms
-                      BTint    -> derive_leaf_nms
-                      BTutc    -> derive_leaf_nms
-    SpRecord  _  -> derive_node_nms
-    SpUnion   _  -> derive_node_nms
-    SpEnum    _  -> derive_leaf_nms ++ [''Bounded, ''Enum]
-    SpSynonym _  -> []
-
-derive_leaf_nms :: [Name]
-derive_leaf_nms = [''Show,''Eq,''Ord,''Typeable]
-
-derive_node_nms :: [Name]
-derive_node_nms = [''Show,''Eq,''Typeable]
-
-
 -- | Name of the type corresponding to the API node, e.g. @JobId@
 type_nm :: APINode -> Name
 type_nm an = mkName $ T.unpack $ _TypeName $ anName an