uom-plugin-0.3.0.0: Units of measure as a GHC typechecker plugin

Safe HaskellNone
LanguageHaskell2010

Data.UnitsOfMeasure.Singleton

Contents

Description

This module defines singleton types for integers and concrete units.

Synopsis

Singletons for units

data SUnit (u :: UnitSyntax Symbol) where Source #

Singleton type for concrete units of measure represented as lists of base units

Constructors

SUnit :: SList xs -> SList ys -> SUnit (xs :/ ys) 

Instances

TestEquality (UnitSyntax Symbol) SUnit Source # 

Methods

testEquality :: f a -> f b -> Maybe ((SUnit :~: a) b) #

forgetSUnit :: SUnit u -> UnitSyntax String Source #

Extract the runtime syntactic representation from a singleton unit

class KnownUnit (u :: UnitSyntax Symbol) where Source #

A constraint KnownUnit u means that u must be a concrete unit that is statically known but passed at runtime

Minimal complete definition

unitSing

Methods

unitSing :: SUnit u Source #

Instances

(KnownList xs, KnownList ys) => KnownUnit ((:/) Symbol xs ys) Source # 

Methods

unitSing :: SUnit ((Symbol :/ xs) ys) Source #

unitVal :: forall proxy u. KnownUnit u => proxy u -> UnitSyntax String Source #

Extract the runtime syntactic representation of a KnownUnit

testEquivalentSUnit :: SUnit u -> SUnit v -> Maybe (Pack u :~: Pack v) Source #

Test whether two SUnits represent the same units, up to the equivalence relation. TODO: this currently uses unsafeCoerce, but in principle it should be possible to avoid it.

Singletons for lists

data SList (xs :: [Symbol]) where Source #

Singleton type for lists of base units

Constructors

SNil :: SList '[] 
SCons :: KnownSymbol x => proxy x -> SList xs -> SList (x ': xs) 

Instances

TestEquality [Symbol] SList Source # 

Methods

testEquality :: f a -> f b -> Maybe ((SList :~: a) b) #

class KnownList (xs :: [Symbol]) where Source #

A constraint KnownList xs means that xs must be a list of base units that is statically known but passed at runtime

Minimal complete definition

listSing

Methods

listSing :: SList xs Source #

Instances

KnownList ([] Symbol) Source # 
(KnownSymbol x, KnownList xs) => KnownList ((:) Symbol x xs) Source # 

Methods

listSing :: SList ((Symbol ': x) xs) Source #