binary-tagged-0.1.4.2: Tagged binary serialisation.

Copyright(C) 2015 Oleg Grenrus
LicenseBSD3
MaintainerOleg Grenrus <oleg.grenrus@iki.fi>
Safe HaskellNone
LanguageHaskell2010

Data.Binary.Tagged

Contents

Description

Structurally tag binary serialisation stream.

Say you have:

data Record = Record
  { _recordFields :: HM.HashMap Text (Integer, ByteString)
  , _recordEnabled :: Bool
  }
  deriving (Eq, Show, Generic)

instance Binary Record
instance HasStructuralInfo Record
instance HasSemanticVersion Record

then you can serialise and deserialise Record values with a structure tag by simply

encodeTaggedFile "cachefile" record
decodeTaggedFile "cachefile" :: IO Record

If structure of Record changes in between, deserialisation will fail early.

Synopsis

Data

newtype BinaryTagged v a Source #

Binary serialisable class, which tries to be less error-prone to data structure changes.

Values are serialised with header consisting of version v and hash of structuralInfo.

Constructors

BinaryTagged 

Fields

Instances

Monad (BinaryTagged k v) Source # 

Methods

(>>=) :: BinaryTagged k v a -> (a -> BinaryTagged k v b) -> BinaryTagged k v b #

(>>) :: BinaryTagged k v a -> BinaryTagged k v b -> BinaryTagged k v b #

return :: a -> BinaryTagged k v a #

fail :: String -> BinaryTagged k v a #

Functor (BinaryTagged k v) Source # 

Methods

fmap :: (a -> b) -> BinaryTagged k v a -> BinaryTagged k v b #

(<$) :: a -> BinaryTagged k v b -> BinaryTagged k v a #

Applicative (BinaryTagged k v) Source # 

Methods

pure :: a -> BinaryTagged k v a #

(<*>) :: BinaryTagged k v (a -> b) -> BinaryTagged k v a -> BinaryTagged k v b #

(*>) :: BinaryTagged k v a -> BinaryTagged k v b -> BinaryTagged k v b #

(<*) :: BinaryTagged k v a -> BinaryTagged k v b -> BinaryTagged k v a #

Foldable (BinaryTagged k v) Source # 

Methods

fold :: Monoid m => BinaryTagged k v m -> m #

foldMap :: Monoid m => (a -> m) -> BinaryTagged k v a -> m #

foldr :: (a -> b -> b) -> b -> BinaryTagged k v a -> b #

foldr' :: (a -> b -> b) -> b -> BinaryTagged k v a -> b #

foldl :: (b -> a -> b) -> b -> BinaryTagged k v a -> b #

foldl' :: (b -> a -> b) -> b -> BinaryTagged k v a -> b #

foldr1 :: (a -> a -> a) -> BinaryTagged k v a -> a #

foldl1 :: (a -> a -> a) -> BinaryTagged k v a -> a #

toList :: BinaryTagged k v a -> [a] #

null :: BinaryTagged k v a -> Bool #

length :: BinaryTagged k v a -> Int #

elem :: Eq a => a -> BinaryTagged k v a -> Bool #

maximum :: Ord a => BinaryTagged k v a -> a #

minimum :: Ord a => BinaryTagged k v a -> a #

sum :: Num a => BinaryTagged k v a -> a #

product :: Num a => BinaryTagged k v a -> a #

Traversable (BinaryTagged k v) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> BinaryTagged k v a -> f (BinaryTagged k v b) #

sequenceA :: Applicative f => BinaryTagged k v (f a) -> f (BinaryTagged k v a) #

mapM :: Monad m => (a -> m b) -> BinaryTagged k v a -> m (BinaryTagged k v b) #

sequence :: Monad m => BinaryTagged k v (m a) -> m (BinaryTagged k v a) #

Generic1 (BinaryTagged k v) Source # 

Associated Types

type Rep1 (BinaryTagged k v :: * -> *) :: * -> * #

Methods

from1 :: BinaryTagged k v a -> Rep1 (BinaryTagged k v) a #

to1 :: Rep1 (BinaryTagged k v) a -> BinaryTagged k v a #

Eq a => Eq (BinaryTagged k v a) Source # 

Methods

(==) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

(/=) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

Ord a => Ord (BinaryTagged k v a) Source # 

Methods

compare :: BinaryTagged k v a -> BinaryTagged k v a -> Ordering #

(<) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

(<=) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

(>) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

(>=) :: BinaryTagged k v a -> BinaryTagged k v a -> Bool #

max :: BinaryTagged k v a -> BinaryTagged k v a -> BinaryTagged k v a #

min :: BinaryTagged k v a -> BinaryTagged k v a -> BinaryTagged k v a #

Read a => Read (BinaryTagged k v a) Source # 
Show a => Show (BinaryTagged k v a) Source # 

Methods

showsPrec :: Int -> BinaryTagged k v a -> ShowS #

show :: BinaryTagged k v a -> String #

showList :: [BinaryTagged k v a] -> ShowS #

Generic (BinaryTagged k v a) Source # 

Associated Types

type Rep (BinaryTagged k v a) :: * -> * #

Methods

from :: BinaryTagged k v a -> Rep (BinaryTagged k v a) x #

to :: Rep (BinaryTagged k v a) x -> BinaryTagged k v a #

Monoid a => Monoid (BinaryTagged k v a) Source # 

Methods

mempty :: BinaryTagged k v a #

mappend :: BinaryTagged k v a -> BinaryTagged k v a -> BinaryTagged k v a #

mconcat :: [BinaryTagged k v a] -> BinaryTagged k v a #

(Binary a, HasStructuralInfo a, KnownNat v) => Binary (BinaryTagged Nat v a) Source #

Version and structure hash are prepended to serialised stream

Methods

put :: BinaryTagged Nat v a -> Put #

get :: Get (BinaryTagged Nat v a) #

putList :: [BinaryTagged Nat v a] -> Put #

type Rep1 (BinaryTagged k v) Source # 
type Rep1 (BinaryTagged k v) = D1 (MetaData "BinaryTagged" "Data.Binary.Tagged" "binary-tagged-0.1.4.2-9gk4kY9TWNRGOLKMYQd9UR" True) (C1 (MetaCons "BinaryTagged" PrefixI True) (S1 (MetaSel (Just Symbol "unBinaryTagged") NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1))
type Rep (BinaryTagged k v a) Source # 
type Rep (BinaryTagged k v a) = D1 (MetaData "BinaryTagged" "Data.Binary.Tagged" "binary-tagged-0.1.4.2-9gk4kY9TWNRGOLKMYQd9UR" True) (C1 (MetaCons "BinaryTagged" PrefixI True) (S1 (MetaSel (Just Symbol "unBinaryTagged") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))

data StructuralInfo Source #

Data type structure, with (some) nominal information.

Instances

Eq StructuralInfo Source # 
Ord StructuralInfo Source # 
Show StructuralInfo Source # 
Generic StructuralInfo Source # 

Associated Types

type Rep StructuralInfo :: * -> * #

Binary StructuralInfo Source # 
HasSemanticVersion StructuralInfo Source # 

Associated Types

type SemanticVersion StructuralInfo :: Nat Source #

HasStructuralInfo StructuralInfo Source # 
type Rep StructuralInfo Source # 
type SemanticVersion StructuralInfo Source # 

Serialisation

taggedEncode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => a -> ByteString Source #

Tagged version of encode

taggedDecode :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => ByteString -> a Source #

Tagged version of decode

IO functions for serialisation

taggedEncodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> a -> IO () Source #

Tagged version of encodeFile

taggedDecodeFile :: forall a. (HasStructuralInfo a, HasSemanticVersion a, Binary a) => FilePath -> IO a Source #

Tagged version of decodeFile

Class

class HasStructuralInfo a where Source #

Type class providing StructuralInfo for each data type.

For regular non-recursive ADTs HasStructuralInfo can be derived generically.

data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic)
instance hasStructuralInfo Record

For stable types, you can provide only type name

instance HasStructuralInfo Int where structuralInfo = ghcNominalType -- infer name from Generic information
instance HasStructuralInfo Integer where structuralInfo _ = NominalType "Integer"

Recursive type story is a bit sad atm. If the type structure is stable, you can do:

instance HasStructuralInfo a => HasStructuralInfo [a] where structuralInfo = ghcStructuralInfo1

Instances

HasStructuralInfo Bool Source # 
HasStructuralInfo Char Source # 
HasStructuralInfo Double Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo Float Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo Int Source # 
HasStructuralInfo Int8 Source # 
HasStructuralInfo Int16 Source # 
HasStructuralInfo Int32 Source # 
HasStructuralInfo Int64 Source # 
HasStructuralInfo Integer Source # 
HasStructuralInfo Ordering Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo Word Source # 
HasStructuralInfo Word8 Source # 
HasStructuralInfo Word16 Source # 
HasStructuralInfo Word32 Source # 
HasStructuralInfo Word64 Source # 
HasStructuralInfo () Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo ByteString Source # 
HasStructuralInfo ByteString Source # 
HasStructuralInfo Text Source # 
HasStructuralInfo UTCTime Source # 
HasStructuralInfo Value Source # 
HasStructuralInfo Text Source # 
HasStructuralInfo Natural Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo E0 Source # 
HasStructuralInfo E1 Source # 
HasStructuralInfo E2 Source # 
HasStructuralInfo E3 Source # 
HasStructuralInfo E6 Source # 
HasStructuralInfo E9 Source # 
HasStructuralInfo E12 Source # 
HasStructuralInfo Version Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo All Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo Any Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo IntSet Source # 
HasStructuralInfo LocalTime Source # 
HasStructuralInfo TimeOfDay Source # 
HasStructuralInfo TimeZone Source # 
HasStructuralInfo NominalDiffTime Source # 
HasStructuralInfo Day Source # 
HasStructuralInfo UniversalTime Source # 
HasStructuralInfo DiffTime Source # 
HasStructuralInfo StructuralInfo Source # 
HasStructuralInfo a => HasStructuralInfo [a] Source # 
HasStructuralInfo a => HasStructuralInfo (Maybe a) Source # 
HasStructuralInfo a => HasStructuralInfo (Ratio a) Source # 
HasStructuralInfo a => HasStructuralInfo (Min a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (Max a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (First a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (Last a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (WrappedMonoid a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (Option a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (NonEmpty a) Source # 
HasStructuralInfo a => HasStructuralInfo (Fixed a) Source #

Since binary-tagged-0.1.3.0

HasStructuralInfo a => HasStructuralInfo (Dual a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (Sum a) Source # 
HasStructuralInfo a => HasStructuralInfo (Product a) Source # 
HasStructuralInfo a => HasStructuralInfo (First a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (Last a) Source #

Since binary-tagged-0.1.4.0

HasStructuralInfo a => HasStructuralInfo (IntMap a) Source # 
HasStructuralInfo a => HasStructuralInfo (Seq a) Source # 
HasStructuralInfo a => HasStructuralInfo (Set a) Source # 
HasStructuralInfo a => HasStructuralInfo (HashSet a) Source # 
HasStructuralInfo a => HasStructuralInfo (Vector a) Source # 
HasStructuralInfo a => HasStructuralInfo (Vector a) Source # 
HasStructuralInfo a => HasStructuralInfo (Vector a) Source # 
(HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (Either a b) Source # 
(HasStructuralInfo a, HasStructuralInfo b) => HasStructuralInfo (a, b) Source # 
(HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (HashMap k v) Source # 
(HasStructuralInfo k, HasStructuralInfo v) => HasStructuralInfo (Map k v) Source # 
(HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (UArray i e) Source # 
(HasStructuralInfo i, HasStructuralInfo e) => HasStructuralInfo (Array i e) Source # 
(HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c) => HasStructuralInfo (a, b, c) Source # 

Methods

structuralInfo :: Proxy * (a, b, c) -> StructuralInfo Source #

(HasStructuralInfo a, HasStructuralInfo b, HasStructuralInfo c, HasStructuralInfo d) => HasStructuralInfo (a, b, c, d) Source # 

Methods

structuralInfo :: Proxy * (a, b, c, d) -> StructuralInfo Source #

class KnownNat (SemanticVersion a) => HasSemanticVersion a Source #

A helper type family for encodeTaggedFile and decodeTaggedFile.

The default definition is SemanticVersion a = 0

Associated Types

type SemanticVersion a :: Nat Source #

Instances

HasSemanticVersion Bool Source # 

Associated Types

type SemanticVersion Bool :: Nat Source #

HasSemanticVersion Char Source # 

Associated Types

type SemanticVersion Char :: Nat Source #

HasSemanticVersion Double Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion Double :: Nat Source #

HasSemanticVersion Float Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion Float :: Nat Source #

HasSemanticVersion Int Source # 

Associated Types

type SemanticVersion Int :: Nat Source #

HasSemanticVersion Int8 Source # 

Associated Types

type SemanticVersion Int8 :: Nat Source #

HasSemanticVersion Int16 Source # 

Associated Types

type SemanticVersion Int16 :: Nat Source #

HasSemanticVersion Int32 Source # 

Associated Types

type SemanticVersion Int32 :: Nat Source #

HasSemanticVersion Int64 Source # 

Associated Types

type SemanticVersion Int64 :: Nat Source #

HasSemanticVersion Integer Source # 

Associated Types

type SemanticVersion Integer :: Nat Source #

HasSemanticVersion Ordering Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion Ordering :: Nat Source #

HasSemanticVersion Word Source # 

Associated Types

type SemanticVersion Word :: Nat Source #

HasSemanticVersion Word8 Source # 

Associated Types

type SemanticVersion Word8 :: Nat Source #

HasSemanticVersion Word16 Source # 

Associated Types

type SemanticVersion Word16 :: Nat Source #

HasSemanticVersion Word32 Source # 

Associated Types

type SemanticVersion Word32 :: Nat Source #

HasSemanticVersion Word64 Source # 

Associated Types

type SemanticVersion Word64 :: Nat Source #

HasSemanticVersion () Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion () :: Nat Source #

HasSemanticVersion ByteString Source # 

Associated Types

type SemanticVersion ByteString :: Nat Source #

HasSemanticVersion ByteString Source # 

Associated Types

type SemanticVersion ByteString :: Nat Source #

HasSemanticVersion Text Source # 

Associated Types

type SemanticVersion Text :: Nat Source #

HasSemanticVersion UTCTime Source # 

Associated Types

type SemanticVersion UTCTime :: Nat Source #

HasSemanticVersion Value Source # 

Associated Types

type SemanticVersion Value :: Nat Source #

HasSemanticVersion Text Source # 

Associated Types

type SemanticVersion Text :: Nat Source #

HasSemanticVersion Natural Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion Natural :: Nat Source #

HasSemanticVersion Version Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion Version :: Nat Source #

HasSemanticVersion All Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion All :: Nat Source #

HasSemanticVersion Any Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion Any :: Nat Source #

HasSemanticVersion IntSet Source # 

Associated Types

type SemanticVersion IntSet :: Nat Source #

HasSemanticVersion LocalTime Source # 

Associated Types

type SemanticVersion LocalTime :: Nat Source #

HasSemanticVersion TimeOfDay Source # 

Associated Types

type SemanticVersion TimeOfDay :: Nat Source #

HasSemanticVersion TimeZone Source # 

Associated Types

type SemanticVersion TimeZone :: Nat Source #

HasSemanticVersion NominalDiffTime Source # 

Associated Types

type SemanticVersion NominalDiffTime :: Nat Source #

HasSemanticVersion Day Source # 

Associated Types

type SemanticVersion Day :: Nat Source #

HasSemanticVersion UniversalTime Source # 

Associated Types

type SemanticVersion UniversalTime :: Nat Source #

HasSemanticVersion DiffTime Source # 

Associated Types

type SemanticVersion DiffTime :: Nat Source #

HasSemanticVersion StructuralInfo Source # 

Associated Types

type SemanticVersion StructuralInfo :: Nat Source #

HasSemanticVersion a => HasSemanticVersion [a] Source # 

Associated Types

type SemanticVersion [a] :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Maybe a) Source # 

Associated Types

type SemanticVersion (Maybe a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Ratio a) Source # 

Associated Types

type SemanticVersion (Ratio a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Min a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Min a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Max a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Max a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (First a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (First a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Last a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Last a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (WrappedMonoid a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (WrappedMonoid a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Option a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Option a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (NonEmpty a) Source # 

Associated Types

type SemanticVersion (NonEmpty a) :: Nat Source #

HasSemanticVersion (Fixed a) Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion (Fixed a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Dual a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Dual a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Sum a) Source # 

Associated Types

type SemanticVersion (Sum a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Product a) Source # 

Associated Types

type SemanticVersion (Product a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (First a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (First a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Last a) Source #

Since binary-tagged-0.1.4.0

Associated Types

type SemanticVersion (Last a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (IntMap a) Source # 

Associated Types

type SemanticVersion (IntMap a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Seq a) Source # 

Associated Types

type SemanticVersion (Seq a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Set a) Source # 

Associated Types

type SemanticVersion (Set a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (HashSet a) Source # 

Associated Types

type SemanticVersion (HashSet a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Vector a) Source # 

Associated Types

type SemanticVersion (Vector a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Vector a) Source # 

Associated Types

type SemanticVersion (Vector a) :: Nat Source #

HasSemanticVersion a => HasSemanticVersion (Vector a) Source # 

Associated Types

type SemanticVersion (Vector a) :: Nat Source #

(HasSemanticVersion a, HasSemanticVersion b, KnownNat (SemanticVersion (Either a b))) => HasSemanticVersion (Either a b) Source # 

Associated Types

type SemanticVersion (Either a b) :: Nat Source #

(HasSemanticVersion a, HasSemanticVersion b, KnownNat (SemanticVersion (a, b))) => HasSemanticVersion (a, b) Source # 

Associated Types

type SemanticVersion (a, b) :: Nat Source #

(HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (HashMap k v))) => HasSemanticVersion (HashMap k v) Source # 

Associated Types

type SemanticVersion (HashMap k v) :: Nat Source #

(HasSemanticVersion k, HasSemanticVersion v, KnownNat (SemanticVersion (Map k v))) => HasSemanticVersion (Map k v) Source # 

Associated Types

type SemanticVersion (Map k v) :: Nat Source #

(HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (UArray i e))) => HasSemanticVersion (UArray i e) Source # 

Associated Types

type SemanticVersion (UArray i e) :: Nat Source #

(HasSemanticVersion i, HasSemanticVersion e, KnownNat (SemanticVersion (Array i e))) => HasSemanticVersion (Array i e) Source # 

Associated Types

type SemanticVersion (Array i e) :: Nat Source #

(HasSemanticVersion a, HasSemanticVersion b, HasSemanticVersion c, KnownNat (SemanticVersion (a, b, c))) => HasSemanticVersion (a, b, c) Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion (a, b, c) :: Nat Source #

(HasSemanticVersion a, HasSemanticVersion b, HasSemanticVersion c, HasSemanticVersion d, KnownNat (SemanticVersion (a, b, c, d))) => HasSemanticVersion (a, b, c, d) Source #

Since binary-tagged-0.1.3.0

Associated Types

type SemanticVersion (a, b, c, d) :: Nat Source #

type Version = Word32 Source #

Type the semantic version is serialised with.

Type level calculations

type Interleave n m = SumUpTo (n + m) + m Source #

Interleaving

3 | 9  .  .  .  .
2 | 5  8  .  .  .
1 | 2  4  7 11  .
0 | 0  1  3  6 10
-----------------
    0  1  2  3  4

This can be calculated by f x y = sum ([0..x+y]) + y

type SumUpTo n = Div2 (n * (n + 1)) Source #

type family Div2 (n :: Nat) :: Nat where ... Source #

Equations

Div2 0 = 0 
Div2 1 = 0 
Div2 n = 1 + Div2 (n - 2) 

Generic derivation

GHC

SOP

SOP direct

Hash