ban-instance: For when a type should never be an instance of a class

[ bsd3, haskell, library ] [ Propose Tags ]

Banning an instance allows the programmer to actively declare that an instance should never be defined, and provide a reason why:

data Foo = -- ...
$(banInstance [t|ToJSON Foo|] "why ToJSON Foo should never be defined")

[Skip to Readme]

Modules

[Index] [Quick Jump]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

Versions [RSS] 0.1.0.0, 0.1.0.1
Change log ChangeLog.md
Dependencies base (>=4.7 && <4.14), template-haskell (>=2.11 && <2.16) [details]
License BSD-3-Clause
Copyright Copyright (C) 2017 Data61
Author Jack Kelly, Alex Mason
Maintainer jack.kelly@data61.csiro.au
Category Haskell
Home page https://github.com/qfpl/ban-instance#readme
Bug tracker https://github.com/qfpl/ban-instance/issues
Source repo head: git clone https://github.com/qfpl/ban-instance
Uploaded by qfpl at 2019-11-08T06:26:22Z
Distributions
Downloads 813 total (8 in the last 30 days)
Rating (no votes yet) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs available [build log]
Last success reported on 2019-11-08 [all 1 reports]

Readme for ban-instance-0.1.0.0

[back to package description]

ban-instance - For when a type should never be an instance of a class

Data61 Logo

Build Status

Synopsis

{-# LANGUAGE TemplateHaskell #-}

-- The generated code requires at least these extensions
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecideableInstances #-}

import Lanuage.Haskell.Instance.Ban

data Foo = -- ...

-- Declare that Foo should never have a ToJSON instance
$(banInstance [t|ToJSON Foo|] "why ToJSON Foo should never be defined")

Code that attempts to use the banned instance will generate a custom error message:

   • Attempt to use banned instance (ToJSON Foo)
      Reason for banning: why ToJSON Foo should never be defined
      Instance banned at [moduleName] filePath:lineNumber

Motivation

Banning an instance allows the programmer to actively declare that this instance should never be defined, and provide a reason why. In terms of what programs the compiler will accept, banning an instance is the same as leaving it undefined.

Our main use case is banning ToJSON/FromJSON instances on "core" data structures to ensure serialisation/deserialisation is defined at API boundaries. We have systems which send and receive values of similar types over multiple different APIs, and which need to vary their JSON representations independently to allow upgrades. Defining serialisation on core data types means that changes to the ToJSON/FromJSON instance can cause breakage at the API layer of some unrelated system, on the other side of the codebase. Better to ban ToJSON/FromJSON on the core data types, and define types for presentation that live alongside the rest of the API:

-- In some "core types" module:
data Foo = -- ...
$(banInstance [t|ToJSON Foo|] "use a newtype wrapper at the API layer")
$(banInstance [t|FromJSON Foo|] "use a newtype wrapper at the API layer")

-- In the module for V1 of the API:
newtype V1 a = V1 a

instance ToJSON (V1 Foo) where -- ...
instance FromJSON (V1 Foo) where -- ...

-- In the module for V2 of the API:
data V2 a = V2 a

instance ToJSON (V2 Foo) where -- ...
instance FromJSON (V2 Foo) where -- ...

Limitations

  • There is currently no support for type classes with associated types or associated data types.
  • Type quotations [t|...|] do not support free variables (GHC#5616).