packages feed

checked-literals (empty) → 0.1.0.0

raw patch · 32 files changed

+2506/−0 lines, 32 filesdep +basedep +checked-literalsdep +directory

Dependencies added: base, checked-literals, directory, filepath, ghc, ghc-typelits-extra, ghc-typelits-knownnat, ghc-typelits-natnormalise, mtl, process, string-interpolate, syb, tasty, tasty-hunit, template-haskell, temporary

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for `checked-literals`++## 0.1.0.0 -- 2026-02-28++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2026, Martijn Bastiaan++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the+   distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,232 @@+`checked-literals` is a GHC plugin that rewrites your programs such that you get a type error+whenever you use a literal that doesn't fit the target type. It works in any context, mono-+or polymorphic. It mostly makes sense in context of custom number types, such as+[clash-lang](https://clash-lang.org/)'s`Unsigned`, `Signed`, and `Index`.++- [How to use](#how-to-use)+- [How it works](#how-it-works)+  - [Integer Literals](#integer-literals)+  - [Rational Literals](#rational-literals)+  - [Examples](#examples)+    - [Out-of-bound, positive literal in monomorphic context](#out-of-bound-positive-literal-in-monomorphic-context)+    - [Out-of-bound, negative literal in monomorphic context](#out-of-bound-negative-literal-in-monomorphic-context)+    - [Inexact rational literal in monomorphic context](#inexact-rational-literal-in-monomorphic-context)+    - [Polymorphic rational context with `UFixed 0 f`](#polymorphic-rational-context-with-ufixed-0-f)+    - [Polymorphic context](#polymorphic-context)+    - [Polymorphic context with `Unsigned n`](#polymorphic-context-with-unsigned-n)+- [FAQ](#faq)+  - [Why not rely on GHC's builtin warnings?](#why-not-rely-on-ghcs-builtin-warnings)+  - [Couldn't you only insert for types you recognize?](#couldnt-you-only-insert-for-types-you-recognize)+  - [Couldn't you write this as a core-to-core plugin?](#couldnt-you-write-this-as-a-core-to-core-plugin)+  - [Couldn't you write this as a type-checker plugin?](#couldnt-you-write-this-as-a-type-checker-plugin)+  - [Why not a warning?](#why-not-a-warning)+  - [What about `Float`/`Double`?](#what-about-floatdouble)++# How to use+Add `checked-literals` to your library's `build-depends` and `-fplugin=CheckedLiterals` to its+`ghc-options`, like this:++```yaml+library+  [..]++  build-depends:+    [..]+    checked-literals++  ghc-options: -fplugin=CheckedLiterals+```++# TODO+- [ ] Test in larger ecosystems (bittide?)+- [ ] Release on Hackage+- [ ] Implement in `clash-prelude`+- [ ] Investigate use of "if instance exist" hackery to get better error messages in completely polymorphic settings? (Low priority, IMO.)++# How it works++## Integer Literals+Every positive integer literal is rewritten as `checkedPositiveIntegerLiteral @lit lit` and every+negative integer literal is rewritten as `checkedNegativeIntegerLiteral @lit (-lit)`. The `checked`+functions themselves act as `id`, but insert a `Checked{Positive,Negative}IntegerLiteral lit a`+constraint where `a` is the type of the literal (possibly polymorphic). Every instance of+this class should insert a constraint that's checkable by the type checkers. For example,+an instance of `Word8` might look like:++```haskell+instance (lit <= 255) => CheckedPositiveIntegerLiteral lit Word8+```++## Rational Literals+Rational literals undergo a very similar rewrite, but use `CheckedPositiveRationalLiteral` and+`CheckedNegativeRationalLiteral` instead. This allows instances to reject both out-of-bounds+values and values that would require rounding.++## Examples+### Out-of-bound, positive literal in monomorphic context+```haskell+x :: Word8+x = 259+```++```haskell+error: [GHC-64725]+    • Literal 259 is out of bounds.+      Word8 has bounds: [0 .. 255].+      Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check.+    • In the expression: checkedPositiveIntegerLiteral @259 259+      In an equation for ‘exampleWord8’:+          x = checkedPositiveIntegerLiteral @259 259+  |+9 | x = 259+  |     ^^^+```++### Out-of-bound, negative literal in monomorphic context+```haskell+x :: Word8+x = -1+```++```haskell+error: [GHC-64725]+    • Negative literal -1 is out of bounds.+      Word8 has bounds: [0 .. 255].+      Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check.+    • In the expression: checkedNegativeIntegerLiteral @1 -1+      In an equation for ‘x’:+          x = checkedNegativeIntegerLiteral @1 -1+  |+9 | x = -1+  |     ^^+```++### Inexact rational literal in monomorphic context+```haskell+x :: UFixed 0 1+x = 0.75+```++```+error: [GHC-64725]+    • Literal 0.75 cannot be represented exactly by Fixed+                                                      CheckedLiterals.Nums.Unsigned.Unsigned 0 1.+      The fractional part needs at least 2 bit(s).+      Possible fix: add a constraint: 2 <= 1.+      Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check.+    • In the expression:+        CheckedLiterals.Class.Rational.checkedPositiveRationalLiteral+          @"0.75" @3 @4 0.75+      In an equation for ‘x’:+          x = CheckedLiterals.Class.Rational.checkedPositiveRationalLiteral+                @"0.75" @3 @4 0.75+  |+6 | x = 0.75+  |     ^^^^+```++### Polymorphic rational context with `UFixed 0 f`+```haskell+x :: (KnownNat f, 1 <= f) => UFixed 0 f+x = 0.75+```++```+error: [GHC-64725]+    • Literal 0.75 cannot be represented exactly by Fixed+                                                      CheckedLiterals.Nums.Unsigned.Unsigned 0 f.+      The fractional part needs at least 2 bit(s).+      Possible fix: add a constraint: 2 <= f.+      Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check.+    • In the expression:+        CheckedLiterals.Class.Rational.checkedPositiveRationalLiteral+          @"0.75" @3 @4 0.75+      In an equation for ‘x’:+          x = CheckedLiterals.Class.Rational.checkedPositiveRationalLiteral+                @"0.75" @3 @4 0.75+  |+6 | x = 0.75+  |     ^^^^+```++### Polymorphic context+```haskell+x :: Num a => a+x = -1+```++```+error: [GHC-39999]+    • Could not deduce ‘CheckedNegativeIntegerLiteral 1 a’+        arising from a use of ‘checkedNegativeIntegerLiteral’+      from the context: Num a+        bound by the type signature for:+                   x :: forall a. Num a => a+        at examples.hs:8:1-15+    • In the expression: checkedNegativeIntegerLiteral @1 - 1+      In an equation for ‘x’: x = checkedNegativeIntegerLiteral @1 - 1+  |+9 | x = -1+  |     ^^+```++### Polymorphic context with `Unsigned n`+```haskell+x :: (4 <= n, KnownNat n) => Unsigned n+x = 255+```++```+error: [GHC-64725]+    • Literal 255 is out of bounds.+      Unsigned n has bounds: [0 .. (2 ^ n) - 1].+      Possible fix: add '8 <= n' to the context.+      Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check.+    • In the expression: checkedPositiveIntegerLiteral @255 255+      In an equation for ‘x’: x = checkedPositiveIntegerLiteral @255 255+  |+9 | x = 255+  |     ^^^+```++# FAQ+## Why not rely on GHC's builtin warnings?+GHC's builtin warnings work fine for builtin types when they're monomorphic:++```haskell+ghci> x = -5 :: Word+<interactive>:1:6: warning: [GHC-97441] [-Woverflowed-literals]+    Literal -5 is out of the Word range 0..18446744073709551615+```++But it's easy to (accidentally) work around:++```haskell+ghci> x = -5 :: Num a => a+ghci> x :: Word+18446744073709551611+```++More importantly, it doesn't work with custom numeric types, such as Clash's `Signed`,+`Unsigned`, and `Index`.++## Couldn't you only insert for types you recognize?+Maybe, but you'd encounter the same issues as GHC's builtin system does. (See previous question.)++## Couldn't you write this as a core-to-core plugin?+You can't insert constraints anymore, as type checking has already run. Yes, you could access+types and write your own solvers, but this would balloon the size of the plugin. More+importantly, it would bypass GHC's usual type checking behavior and user plugins, which+is bound to cause issues where GHC would usually approve/reject constraints, but the plugin+doesn't.++## Couldn't you write this as a type-checker plugin?+Maybe in combination with other passes, but _just_ the type checkers don't have access to+term level literals.++## Why not a warning?+Because there is no `TypeWarning` :-).++## What about `Float`/`Double`?+`Float` and `Double` are supported for rational literals (e.g., `3.14`), however, truncation+is expected for these types.
+ checked-literals.cabal view
@@ -0,0 +1,144 @@+cabal-version: 3.4+name: checked-literals+version: 0.1.0.0+synopsis: GHC plugin for checked numeric literals+description:+  GHC plugin that rewrites numeric literals so out-of-bounds and inexact+  literals fail at compile time.+  See the GitHub README for usage and examples:+  <https://github.com/clash-lang/checked-literals/blob/main/README.md>++homepage: https://github.com/clash-lang/checked-literals+bug-reports: https://github.com/clash-lang/checked-literals/issues+license: BSD-2-Clause+license-file: LICENSE+author: Martijn Bastiaan+maintainer: martijn@hmbastiaan.nl+category: Development+build-type: Simple+extra-doc-files:+  CHANGELOG.md+  README.md++common warnings+  ghc-options: -Wall++common typechecker-plugins+  build-depends:+    ghc-typelits-extra >=0.5 && <0.6,+    ghc-typelits-knownnat >=0.8 && <0.9,+    ghc-typelits-natnormalise >=0.9 && <0.10,++  ghc-options:+    -fplugin=GHC.TypeLits.KnownNat.Solver+    -fplugin=GHC.TypeLits.Normalise+    -fplugin=GHC.TypeLits.Extra.Solver++common sane-records+  default-extensions:+    DisambiguateRecordFields+    DuplicateRecordFields+    NamedFieldPuns+    NoFieldSelectors+    OverloadedRecordDot++source-repository head+  type: git+  location: https://github.com/clash-lang/checked-literals.git++library+  import: warnings, typechecker-plugins, sane-records+  exposed-modules:+    CheckedLiterals+    CheckedLiterals.Class+    CheckedLiterals.Class.Integer+    CheckedLiterals.Class.Rational+    CheckedLiterals.Class.Rational.TypeNats+    CheckedLiterals.Class.TemplateHaskell+    CheckedLiterals.Plugin+    CheckedLiterals.Unchecked++  other-modules:+    Data.Ratio.Extra++  build-depends:+    base >=4.18 && <5,+    ghc >=9.6 && <9.15,+    mtl >=2.2.2 && <2.4,+    syb >=0.7 && <0.8,+    template-haskell >=2.20 && <2.25,++  hs-source-dirs: src+  default-language: GHC2021+  default-extensions:+    DataKinds+    NoStarIsType+    TypeOperators++-- XXX: These modules are just here to provide convincing tests for Clash-like types. They're+--      not tested well in any way, are incomplete in their implementation, and are certainly+--      not translatable to RTL.+library clash-nums+  import: warnings, typechecker-plugins, sane-records+  visibility: private+  exposed-modules:+    CheckedLiterals.Nums.Fixed+    CheckedLiterals.Nums.Signed+    CheckedLiterals.Nums.Unsigned++  build-depends:+    base,+    checked-literals,+    template-haskell,++  hs-source-dirs: src-nums+  default-language: GHC2021+  default-extensions:+    DataKinds+    NoStarIsType+    TypeOperators++test-suite unittests+  import: warnings, typechecker-plugins, sane-records+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+    Data.Ratio.Extra+    Test.Tasty.AssertGhc+    Tests.Common+    Tests.Integer+    Tests.Integer.Case+    Tests.Integer.Fixed+    Tests.Integer.FunctionPattern+    Tests.Integer.Int+    Tests.Integer.Signed+    Tests.Integer.Unsigned+    Tests.Integer.Word+    Tests.Rational+    Tests.Rational.Case+    Tests.Rational.Fixed+    Tests.Rational.FunctionPattern+    Tests.Rational.Ratio++  default-extensions:+    DataKinds+    NoStarIsType+    TypeOperators++  build-depends:+    base,+    checked-literals,+    checked-literals:clash-nums,+    directory,+    filepath,+    process,+    string-interpolate >=0.3.4.0,+    tasty >=0.10,+    tasty-hunit >=0.9,+    temporary,++  hs-source-dirs:+    tests+    src++  default-language: GHC2021
+ src-nums/CheckedLiterals/Nums/Fixed.hs view
@@ -0,0 +1,369 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module CheckedLiterals.Nums.Fixed (+  Fixed (..),+  SFixed,+  UFixed,+) where++import CheckedLiterals (+  CheckedNegativeIntegerLiteral,+  CheckedNegativeRationalLiteral,+  CheckedPositiveIntegerLiteral,+  CheckedPositiveRationalLiteral,+ )+import CheckedLiterals.Class.Rational.TypeNats (IsPowerOfTwo)+import CheckedLiterals.Nums.Signed (Signed (..))+import CheckedLiterals.Nums.Unsigned (Unsigned (..))+import Data.Bits (Bits (..), shiftL, shiftR, (.&.))+import Data.Kind (Constraint, Type)+import Data.Proxy (Proxy (..))+import Data.Ratio (denominator, numerator, (%))+import Data.Type.Bool (If)+import GHC.TypeError (Assert, ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)+import GHC.TypeLits (KnownNat, Nat, natVal, type Div, type (+), type (-), type (<=?), type (^))+import GHC.TypeLits.Extra (CLog)++{- | Fixed-point number++Where:++* @rep@ is the underlying representation (Signed or Unsigned)+* @int@ is the number of bits used to represent the integer part+* @frac@ is the number of bits used to represent the fractional part+-}+newtype Fixed (rep :: Nat -> Type) (int :: Nat) (frac :: Nat)+  = Fixed {unFixed :: rep (int + frac)}++{- | Signed fixed-point number with @int@ integer bits (including sign bit)+and @frac@ fractional bits+-}+type SFixed = Fixed Signed++-- | Unsigned fixed-point number with @int@ integer bits and @frac@ fractional bits+type UFixed = Fixed Unsigned++type PositiveSignedRationalRequiredIntBits (num :: Nat) (den :: Nat) =+  CLog 2 (num + 1) + 1 - CLog 2 den++type NegativeSignedRationalRequiredIntBits (num :: Nat) (den :: Nat) =+  CLog 2 num + 1 - CLog 2 den++type family FitsPositiveSignedRational (num :: Nat) (den :: Nat) (int :: Nat) :: Bool where+  FitsPositiveSignedRational 0 den int = 'True+  FitsPositiveSignedRational num den int =+    PositiveSignedRationalRequiredIntBits num den <=? int++type family FitsNegativeSignedRational (num :: Nat) (den :: Nat) (int :: Nat) :: Bool where+  FitsNegativeSignedRational num den int =+    NegativeSignedRationalRequiredIntBits num den <=? int++instance (KnownNat frac, Integral (rep (int + frac))) => Show (Fixed rep int frac) where+  show (Fixed fRep) = i ++ "." ++ fracStr+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    fRepI = toInteger fRep+    fRepI_abs = abs fRepI+    i =+      if fRepI < 0+        then '-' : show (fRepI_abs `shiftR` nF)+        else show (fRepI `shiftR` nF)+    nom =+      if fRepI < 0+        then fRepI_abs .&. ((2 ^ nF) - 1)+        else fRepI .&. ((2 ^ nF) - 1)+    denom = 2 ^ nF+    fracStr = padZeros nF (show (numerator r'))+     where+      r = nom % denom+      -- Multiply by 10^nF to get decimal representation+      r' =+        iterate+          ( \x ->+              let n = numerator x * 10+                  d = denominator x+               in n % d+          )+          r+          !! nF+    padZeros n str = replicate (n - length str) '0' ++ str++instance (KnownNat frac, Integral (rep (int + frac)), Eq (rep (int + frac))) => Eq (Fixed rep int frac) where+  Fixed a == Fixed b = a == b++instance (KnownNat frac, Integral (rep (int + frac)), Ord (rep (int + frac))) => Ord (Fixed rep int frac) where+  Fixed a `compare` Fixed b = a `compare` b++-- | Num instance for Fixed - operations saturate on overflow+instance+  ( KnownNat frac+  , KnownNat int+  , Integral (rep (int + frac))+  , Bounded (rep (int + frac))+  , Bits (rep (int + frac))+  ) =>+  Num (Fixed rep int frac)+  where+  Fixed a + Fixed b = Fixed (fromInteger sat)+   where+    res = toInteger a + toInteger b+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++  Fixed a * Fixed b = Fixed (fromInteger sat)+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    res = (toInteger a * toInteger b) `shiftR` nF+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++  Fixed a - Fixed b = Fixed (fromInteger sat)+   where+    res = toInteger a - toInteger b+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++  negate (Fixed a) = Fixed (negate a)++  abs (Fixed a) = Fixed (abs a)++  signum (Fixed a)+    | a == 0 = 0+    | a < 0 = -1+    | otherwise = 1++  fromInteger i = Fixed (fromInteger sat)+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    res = i `shiftL` nF+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++-- | Fractional instance for Fixed - division and rational conversion+instance+  ( KnownNat frac+  , KnownNat int+  , Integral (rep (int + frac))+  , Bounded (rep (int + frac))+  , Bits (rep (int + frac))+  ) =>+  Fractional (Fixed rep int frac)+  where+  Fixed a / Fixed b = Fixed (fromInteger sat)+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    -- Shift numerator left by frac bits before division for precision+    num = toInteger a `shiftL` nF+    res = num `quot` toInteger b+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++  recip (Fixed a) = Fixed (fromInteger sat)+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    -- 1.0 in fixed point is 1 << frac+    one = 1 `shiftL` nF :: Integer+    -- (1 << frac) / a in fixed point needs another shift+    num = one `shiftL` nF+    res = num `quot` toInteger a+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++  fromRational r = Fixed (fromInteger sat)+   where+    nF = fromInteger (natVal (Proxy @frac)) :: Int+    n = numerator r `shiftL` (2 * nF)+    d = denominator r `shiftL` nF+    res = n `quot` d+    maxB = toInteger (maxBound :: rep (int + frac))+    minB = toInteger (minBound :: rep (int + frac))+    sat = max minB (min maxB res)++type PositiveUnsignedError strLit lit int typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'Text "Note: integer part needs at least "+          ':<>: 'ShowType (CLog 2 (lit + 1))+          ':<>: 'Text " bit(s)."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 (lit + 1))+          ':<>: 'Text " <= "+          ':<>: 'ShowType int+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 (lit + 1) <=? int))+      (PositiveUnsignedError (ShowType lit) lit int (UFixed int frac) ((2 ^ int) - 1))+  ) =>+  CheckedPositiveIntegerLiteral lit (UFixed int frac)++type NegativeUnsignedError strLit typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is out of bounds, because UFixed cannot represent negative numbers."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  (NegativeUnsignedError ('Text "-" ':<>: 'ShowType lit) (UFixed int frac) ((2 ^ int) - 1)) =>+  CheckedNegativeIntegerLiteral lit (UFixed int frac)++type FixedPointNotPow2Error strLit den typ =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " cannot be represented exactly by "+        ':<>: 'ShowType typ+        ':<>: 'Text "."+        ':$$: 'Text "The reduced denominator "+          ':<>: 'ShowType den+          ':<>: 'Text " is not a power of 2."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++type FixedPointNotEnoughFracError strLit den frac typ =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " cannot be represented exactly by "+        ':<>: 'ShowType typ+        ':<>: 'Text "."+        ':$$: 'Text "The fractional part needs at least "+          ':<>: 'ShowType (CLog 2 den)+          ':<>: 'Text " bit(s)."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 den)+          ':<>: 'Text " <= "+          ':<>: 'ShowType frac+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++type family+  CheckFrac (isPow2 :: Bool) (strLit :: ErrorMessage) (den :: Nat) (frac :: Nat) (typ :: Type) ::+    Constraint+  where+  CheckFrac 'False strLit den frac typ = FixedPointNotPow2Error strLit den typ+  CheckFrac 'True strLit den frac typ =+    Assert+      (CLog 2 den <=? frac)+      (FixedPointNotEnoughFracError strLit den frac typ)++instance+  ( CheckFrac (IsPowerOfTwo den) ('Text str) den frac (UFixed int frac)+  , Assert+      (If (Div num den <=? 0) (Div num den <=? 0) (CLog 2 (Div num den + 1) <=? int))+      (PositiveUnsignedError ('Text str) (Div num den) int (UFixed int frac) ((2 ^ int) - 1))+  ) =>+  CheckedPositiveRationalLiteral str num den (UFixed int frac)++instance+  (NegativeUnsignedError ('Text str) (UFixed int frac) ((2 ^ int) - 1)) =>+  CheckedNegativeRationalLiteral str num den (UFixed int frac)++type PositiveSignedError strLit lit int typ =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'Text "Note: integer part needs at least "+          ':<>: 'ShowType (CLog 2 (lit + 1) + 1)+          ':<>: 'Text " bit(s), including sign bit."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 (lit + 1) + 1)+          ':<>: 'Text " <= "+          ':<>: 'ShowType int+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++type PositiveSignedRationalRangeError strLit num den int =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'Text "Note: integer part needs at least "+          ':<>: 'ShowType (PositiveSignedRationalRequiredIntBits num den)+          ':<>: 'Text " bit(s), including sign bit."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (PositiveSignedRationalRequiredIntBits num den)+          ':<>: 'Text " <= "+          ':<>: 'ShowType int+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 (lit + 1) + 1 <=? int))+      (PositiveSignedError (ShowType lit) lit int (SFixed int frac))+  ) =>+  CheckedPositiveIntegerLiteral lit (SFixed int frac)++type NegativeSignedError strLit lit int typ =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'Text "Note: integer part needs at least "+          ':<>: 'ShowType (CLog 2 lit + 1)+          ':<>: 'Text " bit(s), including sign bit."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 lit + 1)+          ':<>: 'Text " <= "+          ':<>: 'ShowType int+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++type NegativeSignedRationalRangeError strLit num den int =+  TypeError+    ( 'Text "Literal "+        ':<>: strLit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'Text "Note: integer part needs at least "+          ':<>: 'ShowType (NegativeSignedRationalRequiredIntBits num den)+          ':<>: 'Text " bit(s), including sign bit."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (NegativeSignedRationalRequiredIntBits num den)+          ':<>: 'Text " <= "+          ':<>: 'ShowType int+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 lit + 1 <=? int))+      (NegativeSignedError ('Text "-" ':<>: 'ShowType lit) lit int (SFixed int frac))+  ) =>+  CheckedNegativeIntegerLiteral lit (SFixed int frac)++instance+  ( CheckFrac (IsPowerOfTwo den) ('Text str) den frac (SFixed int frac)+  , Assert+      (FitsPositiveSignedRational num den int)+      (PositiveSignedRationalRangeError ('Text str) num den int)+  ) =>+  CheckedPositiveRationalLiteral str num den (SFixed int frac)++instance+  ( CheckFrac (IsPowerOfTwo den) ('Text str) den frac (SFixed int frac)+  , Assert+      (FitsNegativeSignedRational num den int)+      (NegativeSignedRationalRangeError ('Text str) num den int)+  ) =>+  CheckedNegativeRationalLiteral str num den (SFixed int frac)
+ src-nums/CheckedLiterals/Nums/Signed.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module CheckedLiterals.Nums.Signed (+  Signed (..),+) where++import CheckedLiterals (+  CheckedNegativeIntegerLiteral,+  CheckedPositiveIntegerLiteral,+ )+import Data.Bits (Bits (..), FiniteBits (..))+import Data.Proxy (Proxy (..))+import Data.Type.Bool (type If)+import GHC.TypeError (Assert, ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)+import GHC.TypeLits (KnownNat, Nat, natVal, type (+), type (-), type (<=?), type (^))+import GHC.TypeLits.Extra (CLog)++-- | Signed integer with @n@ bits (including sign bit)+newtype Signed (n :: Nat) = Signed Integer+  deriving (Eq, Ord)++instance (KnownNat n) => Show (Signed n) where+  show = show . toInteger++instance (KnownNat n) => Bounded (Signed n) where+  minBound =+    let n = natVal (Proxy @n)+     in Signed $+          if n == 0+            then 0+            else negate (2 ^ (n - 1))+  maxBound =+    let n = natVal (Proxy @n)+     in Signed $+          if n == 0+            then 0+            else 2 ^ (n - 1) - 1++instance (KnownNat n) => Num (Signed n) where+  Signed a + Signed b = fromInteger (a + b)+  Signed a * Signed b = fromInteger (a * b)+  Signed a - Signed b = fromInteger (a - b)+  negate (Signed a) = fromInteger (negate a)+  abs (Signed a) = fromInteger (abs a)+  signum (Signed a) = fromInteger (signum a)+  fromInteger i =+    let s = Signed i'+        Signed minB = minBound `asTypeOf` s+        Signed maxB = maxBound `asTypeOf` s+        i'+          | i < minB = minB+          | i > maxB = maxB+          | otherwise = i+     in s++instance (KnownNat n) => Real (Signed n) where+  toRational (Signed i) = toRational i++instance (KnownNat n) => Enum (Signed n) where+  toEnum = fromInteger . toInteger+  fromEnum (Signed i) = fromInteger i++instance (KnownNat n) => Integral (Signed n) where+  quot (Signed a) (Signed b) = Signed (quot a b)+  rem (Signed a) (Signed b) = Signed (rem a b)+  div (Signed a) (Signed b) = Signed (div a b)+  mod (Signed a) (Signed b) = Signed (mod a b)+  quotRem (Signed a) (Signed b) = let (q, r) = quotRem a b in (Signed q, Signed r)+  divMod (Signed a) (Signed b) = let (q, r) = divMod a b in (Signed q, Signed r)+  toInteger (Signed i) = i++instance (KnownNat n) => Bits (Signed n) where+  Signed a .&. Signed b = fromInteger (a .&. b)+  Signed a .|. Signed b = fromInteger (a .|. b)+  Signed a `xor` Signed b = fromInteger (a `xor` b)+  complement (Signed a) = fromInteger (complement a)+  shift (Signed a) i = fromInteger (shift a i)+  rotate = error "rotate not implemented for Signed"+  bitSize _s = fromInteger (natVal (Proxy @n))+  bitSizeMaybe _s = Just (fromInteger (natVal (Proxy @n)))+  isSigned _ = True+  testBit (Signed a) i = testBit a i+  bit i = fromInteger (bit i)+  popCount (Signed a) = popCount a++instance (KnownNat n) => FiniteBits (Signed n) where+  finiteBitSize _ = fromInteger (natVal (Proxy @n))++type PositiveSignedError lit n typ minVal maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'ShowType lit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 (lit + 1) + 1)+          ':<>: 'Text " <= "+          ':<>: 'ShowType n+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 (lit + 1) + 1 <=? n))+      (PositiveSignedError lit n (Signed n) (2 ^ (n - 1)) ((2 ^ (n - 1)) - 1))+  ) =>+  CheckedPositiveIntegerLiteral lit (Signed n)++type NegativeSignedError lit n typ minVal maxVal =+  TypeError+    ( 'Text "Literal -"+        ':<>: 'ShowType lit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 lit + 1)+          ':<>: 'Text " <= "+          ':<>: 'ShowType n+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 lit + 1 <=? n))+      (NegativeSignedError lit n (Signed n) (2 ^ (n - 1)) ((2 ^ (n - 1)) - 1))+  ) =>+  CheckedNegativeIntegerLiteral lit (Signed n)
+ src-nums/CheckedLiterals/Nums/Unsigned.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE UndecidableInstances #-}++module CheckedLiterals.Nums.Unsigned (+  Unsigned (..),+) where++import CheckedLiterals (+  CheckedNegativeIntegerLiteral,+  CheckedPositiveIntegerLiteral,+  NegativeUnsignedError,+ )+import Data.Bits (Bits (..), FiniteBits (..))+import Data.Proxy (Proxy (..))+import Data.Type.Bool (If)+import GHC.TypeError (Assert, ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)+import GHC.TypeLits (KnownNat, Nat, natVal, type (+), type (-), type (<=?), type (^))+import GHC.TypeLits.Extra (CLog)++-- | Unsigned integer with @n@ bits+newtype Unsigned (n :: Nat) = Unsigned Integer+  deriving (Eq, Ord)++instance (KnownNat n) => Show (Unsigned n) where+  show (Unsigned i) = show i++instance (KnownNat n) => Bounded (Unsigned n) where+  minBound = Unsigned 0+  maxBound =+    let n = natVal (Proxy @n)+     in Unsigned (2 ^ n - 1)++instance (KnownNat n) => Num (Unsigned n) where+  Unsigned a + Unsigned b = fromInteger (a + b)+  Unsigned a * Unsigned b = fromInteger (a * b)+  Unsigned a - Unsigned b = fromInteger (a - b)+  negate (Unsigned a) = fromInteger (negate a)+  abs u = u+  signum (Unsigned 0) = 0+  signum _ = 1+  fromInteger i =+    let u = Unsigned i'+        Unsigned maxB = maxBound `asTypeOf` u+        i'+          | i < 0 = 0+          | i > maxB = maxB+          | otherwise = i+     in u++instance (KnownNat n) => Real (Unsigned n) where+  toRational (Unsigned i) = toRational i++instance (KnownNat n) => Enum (Unsigned n) where+  toEnum = fromInteger . toInteger+  fromEnum (Unsigned i) = fromInteger i++instance (KnownNat n) => Integral (Unsigned n) where+  quot (Unsigned a) (Unsigned b) = Unsigned (quot a b)+  rem (Unsigned a) (Unsigned b) = Unsigned (rem a b)+  div (Unsigned a) (Unsigned b) = Unsigned (div a b)+  mod (Unsigned a) (Unsigned b) = Unsigned (mod a b)+  quotRem (Unsigned a) (Unsigned b) = let (q, r) = quotRem a b in (Unsigned q, Unsigned r)+  divMod (Unsigned a) (Unsigned b) = let (q, r) = divMod a b in (Unsigned q, Unsigned r)+  toInteger (Unsigned i) = i++instance (KnownNat n) => Bits (Unsigned n) where+  Unsigned a .&. Unsigned b = fromInteger (a .&. b)+  Unsigned a .|. Unsigned b = fromInteger (a .|. b)+  Unsigned a `xor` Unsigned b = fromInteger (a `xor` b)+  complement (Unsigned a) = fromInteger (complement a)+  shift (Unsigned a) i = fromInteger (shift a i)+  rotate = error "rotate not implemented for Unsigned"+  bitSize _ = fromInteger (natVal (Proxy @n))+  bitSizeMaybe _ = Just (fromInteger (natVal (Proxy @n)))+  isSigned _ = False+  testBit (Unsigned a) i = testBit a i+  bit i = fromInteger (bit i)+  popCount (Unsigned a) = popCount a++instance (KnownNat n) => FiniteBits (Unsigned n) where+  finiteBitSize _ = fromInteger (natVal (Proxy @n))++type PositiveUnsignedError lit n typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'ShowType lit+        ':<>: 'Text " is (potentially) out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: add a constraint: "+          ':<>: 'ShowType (CLog 2 (lit + 1))+          ':<>: 'Text " <= "+          ':<>: 'ShowType n+          ':<>: 'Text "."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  ( Assert+      (If (lit <=? 0) (lit <=? 0) (CLog 2 (lit + 1) <=? n))+      (PositiveUnsignedError lit n (Unsigned n) ((2 ^ n) - 1))+  ) =>+  CheckedPositiveIntegerLiteral lit (Unsigned n)++instance+  (NegativeUnsignedError lit (Unsigned n) ((2 ^ n) - 1)) =>+  CheckedNegativeIntegerLiteral lit (Unsigned n)
+ src/CheckedLiterals.hs view
@@ -0,0 +1,9 @@+module CheckedLiterals (+  plugin,+  uncheckedLiteral,+  module CheckedLiterals.Class,+) where++import CheckedLiterals.Class+import CheckedLiterals.Plugin (plugin)+import CheckedLiterals.Unchecked (uncheckedLiteral)
+ src/CheckedLiterals/Class.hs view
@@ -0,0 +1,7 @@+module CheckedLiterals.Class (+  module CheckedLiterals.Class.Integer,+  module CheckedLiterals.Class.Rational,+) where++import CheckedLiterals.Class.Integer+import CheckedLiterals.Class.Rational
+ src/CheckedLiterals/Class/Integer.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Type classes and helper functions for checked integer literals.+module CheckedLiterals.Class.Integer where++import CheckedLiterals.Class.TemplateHaskell (maxBoundAsNat, minBoundAsNat)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Kind (Type)+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.TypeError (Assert, ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)+import GHC.TypeNats (Nat, type (<=?))+import Numeric.Natural (Natural)++-- | Constraint used by the plugin to validate positive integer literals.+class CheckedPositiveIntegerLiteral (lit :: Nat) (a :: Type)++instance CheckedPositiveIntegerLiteral lit Natural++type PositiveUnsignedError lit typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'ShowType lit+        ':<>: 'Text " is out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE(T) \+instance \+  (Assert (lit <=? $(maxBoundAsNat @T)) (PositiveUnsignedError lit T $(maxBoundAsNat @T))) => \+  CheckedPositiveIntegerLiteral lit T++CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE (Word)+CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE (Word8)+CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE (Word16)+CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE (Word32)+CHECKED_POSITIVE_UNSIGNED_INTEGER_INSTANCE (Word64)++instance CheckedPositiveIntegerLiteral lit Integer++type PositiveSignedError lit typ minVal maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'ShowType lit+        ':<>: 'Text " is out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE(T) \+instance \+  ( Assert \+      (lit <=? $(maxBoundAsNat @T)) \+      (PositiveSignedError lit T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  ) => \+  CheckedPositiveIntegerLiteral lit T++CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE (Int)+CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE (Int8)+CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE (Int16)+CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE (Int32)+CHECKED_POSITIVE_SIGNED_INTEGER_INSTANCE (Int64)++-- Float/Double always round (or clamp to infinity)+instance CheckedPositiveIntegerLiteral lit Float+instance CheckedPositiveIntegerLiteral lit Double++-- | Identity helper that attaches a positive integer literal check.+checkedPositiveIntegerLiteral :: (CheckedPositiveIntegerLiteral lit a) => a -> a+checkedPositiveIntegerLiteral = id++-- | Constraint used by the plugin to validate negative integer literals.+class CheckedNegativeIntegerLiteral (lit :: Nat) (a :: Type)++type NegativeNaturalError lit typ =+  TypeError+    ( 'Text "Literal -"+        ':<>: 'ShowType lit+        ':<>: 'Text " is out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. ∞]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance (NegativeNaturalError lit Natural) => CheckedNegativeIntegerLiteral lit Natural++#define CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE(T) \+instance (NegativeUnsignedError lit T $(maxBoundAsNat @T)) => CheckedNegativeIntegerLiteral lit T++type NegativeUnsignedError lit typ maxVal =+  TypeError+    ( 'Text "Literal -"+        ':<>: 'ShowType lit+        ':<>: 'Text " is out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE (Word)+CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE (Word8)+CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE (Word16)+CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE (Word32)+CHECKED_NEGATIVE_UNSIGNED_INTEGER_INSTANCE (Word64)++instance CheckedNegativeIntegerLiteral lit Integer++type NegativeSignedError lit typ minVal maxVal =+  TypeError+    ( 'Text "Literal -"+        ':<>: 'ShowType lit+        ':<>: 'Text " is out of bounds."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE(T) \+instance \+  ( Assert \+      (lit <=? $(minBoundAsNat @T)) \+      (NegativeSignedError lit T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  ) => \+  CheckedNegativeIntegerLiteral lit T++CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE (Int)+CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE (Int8)+CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE (Int16)+CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE (Int32)+CHECKED_NEGATIVE_SIGNED_INTEGER_INSTANCE (Int64)++-- Float/Double always round (or clamp to infinity)+instance CheckedNegativeIntegerLiteral lit Float+instance CheckedNegativeIntegerLiteral lit Double++-- | Identity helper that attaches a negative integer literal check.+checkedNegativeIntegerLiteral :: (CheckedNegativeIntegerLiteral lit a) => a -> a+checkedNegativeIntegerLiteral = id
+ src/CheckedLiterals/Class/Rational.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Type classes and helper functions for checked rational literals.+module CheckedLiterals.Class.Rational where++import CheckedLiterals.Class.TemplateHaskell (maxBoundAsNat, minBoundAsNat)+import Data.Fixed (E0, E1, E2, E3, E6, E9, Fixed)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.Kind (Type)+import Data.Ratio (Ratio)+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.TypeError (Assert, ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)+import GHC.TypeLits (Nat, Symbol, type Mod, type (<=?))+import GHC.TypeNats (type (*))+import Numeric.Natural (Natural)++-- | Constraint used by the plugin to validate positive rational literals.+class+  CheckedPositiveRationalLiteral+    (literalAsString :: Symbol)+    (numerator :: Nat)+    (denominator :: Nat)+    (a :: Type)++instance CheckedPositiveRationalLiteral str num den Rational+instance CheckedPositiveRationalLiteral str num den (Ratio Natural)+instance CheckedPositiveRationalLiteral str num den Float+instance CheckedPositiveRationalLiteral str num den Double++type FixedRoundingError str fixedType resolution =+  TypeError+    ( 'Text "Literal "+        ':<>: 'ShowType str+        ':<>: 'Text " requires rounding for "+        ':<>: 'ShowType fixedType+        ':<>: 'Text " (resolution 1/"+        ':<>: 'ShowType resolution+        ':<>: 'Text ")."+        ':$$: 'Text "The literal cannot be represented exactly without rounding."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE(E, RES) \+instance \+  ( Assert \+      ((Mod (num * RES) den) <=? 0) \+      (FixedRoundingError str (Fixed E) RES) \+  ) => \+  CheckedPositiveRationalLiteral str num den (Fixed E)++CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E0, 1)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E1, 10)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E2, 100)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E3, 1_000)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E6, 1_000_000)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE (E9, 1_000_000_000)+CHECKED_POSITIVE_FIXED_RATIONAL_INSTANCE ((res :: Nat), res)++-- | Identity helper that attaches a positive rational literal check.+checkedPositiveRationalLiteral :: (CheckedPositiveRationalLiteral fixed num den a) => a -> a+checkedPositiveRationalLiteral = id++-- | Constraint used by the plugin to validate negative rational literals.+class CheckedNegativeRationalLiteral (str :: Symbol) (numerator :: Nat) (denominator :: Nat) (a :: Type)++instance CheckedNegativeRationalLiteral str num den Rational+instance CheckedNegativeRationalLiteral str num den Float+instance CheckedNegativeRationalLiteral str num den Double++#define CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE(E, RES) \+instance \+  ( Assert \+      ((Mod (num * RES) den) <=? 0) \+      (FixedRoundingError str (Fixed E) RES) \+  ) => \+  CheckedNegativeRationalLiteral str num den (Fixed E)++CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E0, 1)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E1, 10)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E2, 100)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E3, 1_000)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E6, 1_000_000)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE (E9, 1_000_000_000)+CHECKED_NEGATIVE_FIXED_RATIONAL_INSTANCE ((res :: Nat), res)++-- | Identity helper that attaches a negative rational literal check.+checkedNegativeRationalLiteral :: (CheckedNegativeRationalLiteral fixed num den a) => a -> a+checkedNegativeRationalLiteral = id++type PositiveUnsignedRatioNotRepresentable str num den typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'Text str+        ':<>: 'Text " ("+        ':<>: 'ShowType num+        ':<>: 'Text " % "+        ':<>: 'ShowType den+        ':<>: 'Text ")"+        ':<>: 'Text " cannot be represented by "+        ':<>: 'ShowType typ+        ':<>: 'Text "."+        ':$$: 'Text "Make sure both the numerator and the denominator fit "+          ':<>: 'ShowType typ+          ':<>: 'Text "."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE(T) \+instance \+  ( Assert \+      (num <=? $(maxBoundAsNat @T)) \+      (PositiveUnsignedRatioNotRepresentable str num den T $(maxBoundAsNat @T)) \+  \+  , Assert \+      (den <=? $(maxBoundAsNat @T)) \+      (PositiveUnsignedRatioNotRepresentable str num den T $(maxBoundAsNat @T)) \+  ) => \+  CheckedPositiveRationalLiteral str num den (Ratio T)++CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE (Word)+CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE (Word64)+CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE (Word32)+CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE (Word16)+CHECKED_POSITIVE_UNSIGNED_RATIONAL_INSTANCE (Word8)++type PositiveSignedRatioNotRepresentable str num den typ minVal maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'Text str+        ':<>: 'Text " ("+        ':<>: 'ShowType num+        ':<>: 'Text " % "+        ':<>: 'ShowType den+        ':<>: 'Text ")"+        ':<>: 'Text " cannot be represented by "+        ':<>: 'ShowType typ+        ':<>: 'Text "."+        ':$$: 'Text "Make sure both the numerator and the denominator fit "+          ':<>: 'ShowType typ+          ':<>: 'Text "."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE(T) \+instance \+  ( Assert \+      (num <=? $(maxBoundAsNat @T)) \+      (PositiveSignedRatioNotRepresentable str num den T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  \+  , Assert \+      (den <=? $(maxBoundAsNat @T)) \+      (PositiveSignedRatioNotRepresentable str num den T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  ) => \+  CheckedPositiveRationalLiteral str num den (Ratio T)++CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE (Int)+CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE (Int64)+CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE (Int32)+CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE (Int16)+CHECKED_POSITIVE_SIGNED_RATIONAL_INSTANCE (Int8)++type NegativeNaturalRatioNotRepresentable str num den typ =+  TypeError+    ( 'Text "Literal "+        ':<>: 'Text str+        ':<>: 'Text " (-"+        ':<>: 'ShowType num+        ':<>: 'Text " % "+        ':<>: 'ShowType den+        ':<>: 'Text ")"+        ':<>: 'Text " cannot be represented by "+        ':<>: 'ShowType (Ratio typ)+        ':<>: 'Text "."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [0 .. ∞]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++instance+  (NegativeNaturalRatioNotRepresentable str num den Natural) =>+  CheckedNegativeRationalLiteral str num den (Ratio Natural)++type NegativeUnsignedRatioNotRepresentable str num den typ maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'Text str+        ':<>: 'Text " cannot be represented by "+        ':<>: 'ShowType (Ratio typ)+        ':<>: 'Text "."+        ':$$: 'ShowType typ+          ':<>: 'Text " cannot represent negative numbers."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE(T) \+instance \+  (NegativeUnsignedRatioNotRepresentable str num den T $(maxBoundAsNat @T)) => \+  CheckedNegativeRationalLiteral str num den (Ratio T)++CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE (Word)+CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE (Word64)+CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE (Word32)+CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE (Word16)+CHECKED_NEGATIVE_UNSIGNED_RATIONAL_INSTANCE (Word8)++type NegativeSignedRatioNotRepresentable str num den typ minVal maxVal =+  TypeError+    ( 'Text "Literal "+        ':<>: 'Text str+        ':<>: 'Text " (-"+        ':<>: 'ShowType num+        ':<>: 'Text " % "+        ':<>: 'ShowType den+        ':<>: 'Text ")"+        ':<>: 'Text " cannot be represented by "+        ':<>: 'ShowType typ+        ':<>: 'Text "."+        ':$$: 'Text "Make sure both the numerator and the denominator fit "+          ':<>: 'ShowType typ+          ':<>: 'Text "."+        ':$$: 'ShowType typ+          ':<>: 'Text " has bounds: [-"+          ':<>: 'ShowType minVal+          ':<>: 'Text " .. "+          ':<>: 'ShowType maxVal+          ':<>: 'Text "]."+        ':$$: 'Text "Possible fix: use 'uncheckedLiteral' from 'CheckedLiterals' to bypass this check."+    )++#define CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE(T) \+instance \+  ( Assert \+      (num <=? $(minBoundAsNat @T)) \+      (NegativeSignedRatioNotRepresentable str num den T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  \+  , Assert \+      (den <=? $(maxBoundAsNat @T)) \+      (NegativeSignedRatioNotRepresentable str num den T $(minBoundAsNat @T) $(maxBoundAsNat @T)) \+  ) => \+  CheckedNegativeRationalLiteral str num den (Ratio T)++CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE (Int)+CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE (Int64)+CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE (Int32)+CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE (Int16)+CHECKED_NEGATIVE_SIGNED_RATIONAL_INSTANCE (Int8)
+ src/CheckedLiterals/Class/Rational/TypeNats.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Small type-level helpers used by rational literal checks.+module CheckedLiterals.Class.Rational.TypeNats where++import Data.Type.Bool (If)+import GHC.TypeLits++-- | Type-level predicate that checks whether a natural is a power of two.+type family IsPowerOfTwo (n :: Nat) :: Bool where+  IsPowerOfTwo 0 = 'False+  IsPowerOfTwo 1 = 'True+  IsPowerOfTwo n = If (Mod n 2 <=? 0) (IsPowerOfTwo (Div n 2)) 'False
+ src/CheckedLiterals/Class/TemplateHaskell.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Template Haskell helpers used to derive type-level bounds.+module CheckedLiterals.Class.TemplateHaskell where++import Data.Typeable (Proxy (Proxy), Typeable, typeRep)+import Language.Haskell.TH (Q, Type, litT, numTyLit)++-- | Reify a type's @maxBound@ as a type-level natural.+maxBoundAsNat :: forall a. (Bounded a, Typeable a, Integral a) => Q Type+maxBoundAsNat+  | theMaxBound >= 0 = litT (numTyLit theMaxBound)+  | otherwise =+      fail $+        "The type "+          ++ show (typeRep (Proxy @a))+          ++ " has a negative maxBound, so it cannot be used with CheckedLiterals. The maxBound is "+          ++ show theMaxBound+          ++ "."+ where+  theMaxBound = toInteger (maxBound :: a)++-- | Reify the absolute value of a type's non-positive @minBound@ as a type-level natural.+minBoundAsNat :: forall a. (Bounded a, Integral a, Typeable a) => Q Type+minBoundAsNat+  | theMinBound <= 0 = litT (numTyLit (-theMinBound))+  | otherwise =+      fail $+        "The type "+          ++ show (typeRep (Proxy @a))+          ++ " has a positive, non-zero minBound, so it cannot be used with CheckedLiterals. The minBound is "+          ++ show theMinBound+          ++ "."+ where+  theMinBound = toInteger (minBound :: a)
+ src/CheckedLiterals/Plugin.hs view
@@ -0,0 +1,323 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++module CheckedLiterals.Plugin (plugin) where++import GHC.Hs+import Prelude++import Control.Monad.Reader (Reader, ask, runReader)+import Data.Generics (Data, extM, gmapM)+import Data.Ratio.Extra qualified as RatioExtra+import GHC.Iface.Env (lookupOrig)+import GHC.Plugins hiding (rational, (<>))+import GHC.Tc.Types (TcGblEnv, TcM)+import GHC.Tc.Utils.Monad (getTopEnv)+import GHC.Types.SourceText (+  SourceText (NoSourceText, SourceText),+  il_value,+ )++import CheckedLiterals.Class.Integer (+  checkedNegativeIntegerLiteral,+  checkedPositiveIntegerLiteral,+ )+import CheckedLiterals.Class.Rational (+  checkedNegativeRationalLiteral,+  checkedPositiveRationalLiteral,+ )+import CheckedLiterals.Unchecked (uncheckedLiteral)+import Data.Ratio qualified as Ratio+import GHC.Types.SourceText qualified as SourceText+import Language.Haskell.TH qualified as TH++data HelperNames = HelperNames+  { checkedPositiveIntegerLiteralName :: Name+  , checkedNegativeIntegerLiteralName :: Name+  , checkedPositiveRationalLiteralName :: Name+  , checkedNegativeRationalLiteralName :: Name+  , uncheckedLiteralName :: Name+  }++type TransformM = Reader HelperNames++-- | The GHC plugin entry point+plugin :: Plugin+plugin =+  defaultPlugin+    { renamedResultAction = renamedPlugin+    , pluginRecompile = purePlugin+    }++-- | Rewrite numeric literals after renaming, using exact Names for helper detection.+renamedPlugin :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)+renamedPlugin _opts tcGblEnv hsGroup = do+  helperNames <- loadHelperNames+  let transformedGroup = runReader (transformHsGroup hsGroup) helperNames+  pure (tcGblEnv, transformedGroup)++-- | Top-down traversal of HsGroup, transforming expressions and patterns.+transformHsGroup :: HsGroup GhcRn -> TransformM (HsGroup GhcRn)+transformHsGroup hsGroup = gmapM transformData hsGroup++transformData :: (Data a) => a -> TransformM a+transformData =+  gmapM transformData+    `extM` transformLHsExpr+    `extM` transformLPat++loadHelperNames :: TcM HelperNames+loadHelperNames = do+  let lookupHelper quotedName = do+        helperModule <- lookupHelperModule (quotedNameModuleName quotedName)+        lookupOrig helperModule (mkVarOcc (TH.nameBase quotedName))+  HelperNames+    <$> lookupHelper 'checkedPositiveIntegerLiteral+    <*> lookupHelper 'checkedNegativeIntegerLiteral+    <*> lookupHelper 'checkedPositiveRationalLiteral+    <*> lookupHelper 'checkedNegativeRationalLiteral+    <*> lookupHelper 'uncheckedLiteral++lookupHelperModule :: ModuleName -> TcM Module+lookupHelperModule moduleName = do+  hscEnv <- getTopEnv+  case lookupModuleWithSuggestions (hsc_units hscEnv) moduleName NoPkgQual of+    LookupFound foundModule _ -> pure foundModule+    _ -> panic "CheckedLiterals.Plugin: failed to resolve helper module"++quotedNameModuleName :: TH.Name -> ModuleName+quotedNameModuleName name =+  case TH.nameModule name of+    Just moduleName -> mkModuleName moduleName+    Nothing ->+      panic $+        "CheckedLiterals.Plugin: quoted helper name is missing a module: "+          ++ TH.pprint name++-- | Transform a located expression using top-down traversal.+transformLHsExpr :: LHsExpr GhcRn -> TransformM (LHsExpr GhcRn)+transformLHsExpr lexpr@(L loc expr) = do+  helperNames <- ask+  case expr of+    -- Check if this is an application to our checked literal functions. If so, stop recursing+    -- to avoid double transformation.+    HsApp _ fun _ | isCheckedLiteralApp helperNames (unLoc fun) -> return lexpr+    -- Handle negation of fractional literals: detect (negate 3.14) patterns+    NegApp _ (L _ (HsOverLit _ OverLit{ol_val = HsFractional fracLit})) _ -> do+      let+        rational = negate (SourceText.rationalFromFractionalLit fracLit)+        transformedExpr =+          makeCheckedRationalLiteral+            helperNames+            expr+            (fractionalLiteralDisplayText rational fracLit)+            rational+      return (L loc transformedExpr)++    -- Handle negation of integer literals: detect (negate literal) patterns+    NegApp _ (L _ (HsOverLit _ OverLit{ol_val = HsIntegral intLit})) _ -> do+      let+        value = il_value intLit+        transformedExpr = makeCheckedLiteral helperNames expr (negate value)+      return (L loc transformedExpr)++    -- Transform positive fractional literals+    HsOverLit _ OverLit{ol_val = HsFractional fracLit} -> do+      let rational = SourceText.rationalFromFractionalLit fracLit+      return $+        L loc $+          makeCheckedRationalLiteral+            helperNames+            expr+            (fractionalLiteralDisplayText rational fracLit)+            rational++    -- Transform positive integer literals+    HsOverLit _ OverLit{ol_val = HsIntegral intLit} -> do+      let value = il_value intLit+      return $ L loc $ makeCheckedLiteral helperNames expr value++    -- For all other expressions, recurse into children (top-down)+    _ -> L loc <$> gmapM transformData expr++-- | Transform any located pattern, regardless of context.+transformLPat :: LPat GhcRn -> TransformM (LPat GhcRn)+transformLPat lpat@(L loc pat) = do+  helperNames <- ask+  case pat of+    ViewPat _ viewExpr _+      | isCheckedLiteralApp helperNames (unLoc viewExpr) ->+          pure lpat+    NPat _ overLit negation _+      | Just viewExpr <- makeCheckedPatternViewExpr helperNames (unLoc overLit) negation ->+          pure (L loc (ViewPat mkViewPatExt (noLocA viewExpr) lpat))+    _ -> L loc <$> gmapM transformPatData pat++transformPatData :: (Data a) => a -> TransformM a+transformPatData =+  gmapM transformPatData+    `extM` transformLPat+    `extM` transformLHsExpr++makeCheckedPatternViewExpr ::+  HelperNames ->+  HsOverLit GhcRn ->+  Maybe (SyntaxExpr GhcRn) ->+  Maybe (HsExpr GhcRn)+makeCheckedPatternViewExpr helperNames overLit negation =+  case overLit.ol_val of+    HsIntegral intLit ->+      let value = applyPatternNegation negation (il_value intLit)+       in Just (makeCheckedLiteralFunction helperNames value)+    HsFractional fracLit ->+      let rational = applyPatternNegation negation (SourceText.rationalFromFractionalLit fracLit)+       in Just+            ( makeCheckedRationalLiteralFunction+                helperNames+                (fractionalLiteralDisplayText rational fracLit)+                rational+            )+    HsIsString _ _ -> Nothing++applyPatternNegation :: (Num a) => Maybe b -> a -> a+applyPatternNegation Nothing value = value+applyPatternNegation (Just _) value = negate value++mkViewPatExt :: XViewPat GhcRn+mkViewPatExt = Nothing++#if MIN_VERSION_ghc(9,8,0)+unpackFSCompat :: FastString -> String+unpackFSCompat = unpackFS+#else+unpackFSCompat :: String -> String+unpackFSCompat = id+#endif++fractionalLiteralDisplayText :: Rational -> SourceText.FractionalLit -> String+fractionalLiteralDisplayText rational fracLit =+  case SourceText.fl_text fracLit of+    SourceText sourceText ->+      let sourceTextStr = unpackFSCompat sourceText+       in case sourceTextStr of+            '-' : _ -> sourceTextStr+            _ | rational < 0 -> '-' : sourceTextStr+            _ -> sourceTextStr+    NoSourceText ->+      RatioExtra.showFixedPoint rational++{- FOURMOLU_DISABLE -}+-- | Check if an expression is an application to one of our checked literal functions+isCheckedLiteralApp :: HelperNames -> HsExpr GhcRn -> Bool+isCheckedLiteralApp helperNames expr = case expr of+  -- Direct reference to checked literal function+  HsVar _ name -> isCheckedLiteralName helperNames (getNameFromLocatedOcc name)+  -- Parentheses do not change helper identity.+#if MIN_VERSION_ghc(9,10,0)+  HsPar _ innerExpr -> isCheckedLiteralApp helperNames (unLoc innerExpr)+#else+  HsPar _ _ innerExpr _ -> isCheckedLiteralApp helperNames (unLoc innerExpr)+#endif+  -- Type application to checked literal function, e.g.: checkedPositiveIntegerLiteral @N+#if MIN_VERSION_ghc(9,10,0)+  HsAppType _ funExpr _ -> isCheckedLiteralApp helperNames (unLoc funExpr)+#else+  HsAppType _ funExpr _ _ -> isCheckedLiteralApp helperNames (unLoc funExpr)+#endif+  _ -> False+{- FOURMOLU_ENABLE -}++-- | Check if a name is one of our checked literal functions or uncheckedLiteral+isCheckedLiteralName :: HelperNames -> Name -> Bool+isCheckedLiteralName helperNames name =+  name == helperNames.checkedPositiveIntegerLiteralName+    || name == helperNames.checkedNegativeIntegerLiteralName+    || name == helperNames.checkedPositiveRationalLiteralName+    || name == helperNames.checkedNegativeRationalLiteralName+    || name == helperNames.uncheckedLiteralName++#if MIN_VERSION_ghc(9,14,0)+getNameFromLocatedOcc :: LIdOccP GhcRn -> Name+getNameFromLocatedOcc = unLocWithUserRdr+#else+getNameFromLocatedOcc :: LIdP GhcRn -> Name+getNameFromLocatedOcc = unLoc+#endif++#if MIN_VERSION_ghc(9,14,0)+mkLocatedOcc :: Name -> LIdOccP GhcRn+mkLocatedOcc = noLocA . noUserRdr+#else+mkLocatedOcc :: Name -> LIdP GhcRn+mkLocatedOcc = noLocA+#endif++-- | Build the expression, e.g.: checkedPositiveIntegerLiteral @N e+makeCheckedLiteral :: HelperNames -> HsExpr GhcRn -> Integer -> HsExpr GhcRn+makeCheckedLiteral helperNames expr value = fullApp+ where+  withTypeApp = makeCheckedLiteralFunction helperNames value+#if MIN_VERSION_ghc(9,10,0)+  fullApp = HsApp noExtField (noLocA withTypeApp) (noLocA expr)+#else+  fullApp = HsApp noAnn (noLocA withTypeApp) (noLocA expr)+#endif++makeCheckedLiteralFunction :: HelperNames -> Integer -> HsExpr GhcRn+makeCheckedLiteralFunction helperNames value = withTypeApp+ where+  funcName+    | value >= 0 = helperNames.checkedPositiveIntegerLiteralName+    | otherwise = helperNames.checkedNegativeIntegerLiteralName+  funcVar = noLocA (HsVar noExtField (mkLocatedOcc funcName))+  tyLit = HsNumTy NoSourceText (abs value)+#if MIN_VERSION_ghc(9,10,0)+  typeArg = HsWC [] (noLocA (HsTyLit noExtField tyLit))+  withTypeApp = HsAppType noExtField funcVar typeArg+#else+  typeArg = HsWC [] (noLocA (HsTyLit noExtField tyLit))+  atToken = L NoTokenLoc (HsTok @"@")+  withTypeApp = HsAppType noExtField funcVar atToken typeArg+#endif++{- | Build the expression for rational literals, e.g.:+checkedPositiveRationalLiteral @"3.14" @314 @100 (3.14)+-}+makeCheckedRationalLiteral :: HelperNames -> HsExpr GhcRn -> String -> Rational -> HsExpr GhcRn+makeCheckedRationalLiteral helperNames expr stringRepr rational = fullApp+ where+  withAllTypeApps = makeCheckedRationalLiteralFunction helperNames stringRepr rational+#if MIN_VERSION_ghc(9,10,0)+  fullApp = HsApp noExtField (noLocA withAllTypeApps) (noLocA expr)+#else+  fullApp = HsApp noAnn (noLocA withAllTypeApps) (noLocA expr)+#endif++makeCheckedRationalLiteralFunction :: HelperNames -> String -> Rational -> HsExpr GhcRn+makeCheckedRationalLiteralFunction helperNames stringRepr rational = withAllTypeApps+ where+  funcName+    | rational >= 0 = helperNames.checkedPositiveRationalLiteralName+    | otherwise = helperNames.checkedNegativeRationalLiteralName+  funcVar = noLocA (HsVar noExtField (mkLocatedOcc funcName))++  -- Type-level literals+  strTyLit = HsStrTy NoSourceText (mkFastString stringRepr)+  numTyLit = HsNumTy NoSourceText (abs (Ratio.numerator rational))+  denTyLit = HsNumTy NoSourceText (abs (Ratio.denominator rational))+#if MIN_VERSION_ghc(9,10,0)+  strTypeArg = HsWC [] (noLocA (HsTyLit noExtField strTyLit))+  numTypeArg = HsWC [] (noLocA (HsTyLit noExtField numTyLit))+  denTypeArg = HsWC [] (noLocA (HsTyLit noExtField denTyLit))+  withStrTypeApp = HsAppType noExtField funcVar strTypeArg+  withNumTypeApp = HsAppType noExtField (noLocA withStrTypeApp) numTypeArg+  withAllTypeApps = HsAppType noExtField (noLocA withNumTypeApp) denTypeArg+#else+  strTypeArg = HsWC [] (noLocA (HsTyLit noExtField strTyLit))+  numTypeArg = HsWC [] (noLocA (HsTyLit noExtField numTyLit))+  denTypeArg = HsWC [] (noLocA (HsTyLit noExtField denTyLit))+  atToken = L NoTokenLoc (HsTok @"@")+  withStrTypeApp = HsAppType noExtField funcVar atToken strTypeArg+  withNumTypeApp = HsAppType noExtField (noLocA withStrTypeApp) atToken numTypeArg+  withAllTypeApps = HsAppType noExtField (noLocA withNumTypeApp) atToken denTypeArg+#endif
+ src/CheckedLiterals/Unchecked.hs view
@@ -0,0 +1,5 @@+module CheckedLiterals.Unchecked (uncheckedLiteral) where++-- | Identity function used to opt a single literal out of checking.+uncheckedLiteral :: a -> a+uncheckedLiteral = id
+ src/Data/Ratio/Extra.hs view
@@ -0,0 +1,32 @@+module Data.Ratio.Extra where++import Data.Ratio qualified as Ratio++{- | Show a 'Rational' in fixed-point notation, without using scientific notation.++>>> showFixedPoint (1 % 2)+"0.5"+>>> showFixedPoint (-0.1)+"-0.1"+>>> showFixedPoint 10+"10.0"+>>> showFixedPoint 1.154646000+"1.154646"+-}+showFixedPoint :: Rational -> String+showFixedPoint rational+  | numerator < 0 = "-" <> result+  | otherwise = result+ where+  result = show whole <> "." <> concat (go0 fractional)+  (whole, fractional) = abs numerator `quotRem` denominator+  numerator = Ratio.numerator rational+  denominator = Ratio.denominator rational++  go0 0 = ["0"]+  go0 i = go1 i++  go1 0 = []+  go1 i = show w : go1 f+   where+    (w, f) = (10 * i) `quotRem` denominator
+ tests/Main.hs view
@@ -0,0 +1,23 @@+module Main where++import Data.Proxy+import Test.Tasty+import Test.Tasty.AssertGhc (DebugGhc (..))+import Test.Tasty.Options+import Prelude++import Tests.Integer qualified+import Tests.Rational qualified++tests :: TestTree+tests =+  testGroup+    "Tests"+    [ Tests.Integer.tests+    , Tests.Rational.tests+    ]++main :: IO ()+main = defaultMainWithIngredients ingredients tests+ where+  ingredients = includingOptions [Option (Proxy :: Proxy DebugGhc)] : defaultIngredients
+ tests/Test/Tasty/AssertGhc.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE CPP #-}++module Test.Tasty.AssertGhc where++import Prelude++import Data.List (isInfixOf)+import Data.Maybe (fromMaybe)+import System.Environment (lookupEnv)+import System.Exit+import System.IO+import System.IO.Temp+import System.Process+import Test.Tasty (TestTree, askOption)+import Test.Tasty.HUnit+import Test.Tasty.Options+import Text.Read (readMaybe)++data Expected = ExpectFailure [String] | ExpectSuccess++-- | Option to enable debug output of GHC error messages+newtype DebugGhc = DebugGhc Bool+  deriving (Show, Read)++instance IsOption DebugGhc where+  defaultValue = DebugGhc False+  parseValue = fmap DebugGhc . readMaybe+  optionName = return "debug-ghc"+  optionHelp = return "Print full GHC output for error test cases"+  optionCLParser = flagCLParser Nothing (DebugGhc True)++testCaseGhc :: String -> String -> Expected -> TestTree+testCaseGhc name source expected =+  askOption $ \(DebugGhc debugGhc) ->+    testCaseInfo name $ do+      debugOutput <- assertGhc source expected+      if debugGhc then return debugOutput else return ""++{- | Assert that a Haskell code snippet fails to compile with expected error messages+Returns the GHC output for display in test results if debug flag is set+-}+assertGhc :: String -> Expected -> IO String+assertGhc source expected = do+  -- XXX: This will pick the wrong GHC if the HC environment variable (as seen on CI)+  --      isn't set and the test suite is compiled with a GHC compiler other than the+  --      system's default.+  hc <- fromMaybe "ghc" <$> lookupEnv "HC"+  withSystemTempFile "ShouldError.hs" $ \tempFile tempHandle -> do+    -- Write source with proper Main module structure+    hPutStr tempHandle "module Main where\n"+    hPutStr tempHandle source+    hPutStr tempHandle "\nmain :: IO ()\nmain = return ()\n"+    hClose tempHandle+    (exitCode, _, stderrOutput) <-+      readProcessWithExitCode+        hc+        [ "-XCPP"+        , "-XDataKinds"+        , "-XTypeOperators"+        , "-XTypeApplications"+        , "-XTypeFamilies"+        , "-XUndecidableInstances"+        , "-XNoStarIsType"+        , "-XViewPatterns"+        , "-XNoImplicitPrelude"+        , "-fno-code"+        , "-fplugin=GHC.TypeLits.KnownNat.Solver"+        , "-fplugin=GHC.TypeLits.Normalise"+        , "-fplugin=GHC.TypeLits.Extra.Solver"+        , "-fplugin=CheckedLiterals"+        , tempFile+        ]+        ""+    case (exitCode, expected) of+      (ExitSuccess, ExpectSuccess) ->+        return ""+      (ExitSuccess, ExpectFailure _) ->+        assertFailure "Expected compilation to fail but it succeeded" >> return ""+      (ExitFailure _, ExpectSuccess) ->+        assertFailure ("Expected compilation to succeed but it failed with error:\n" ++ stderrOutput)+          >> return ""+      (ExitFailure _, ExpectFailure expectedErrors) ->+        let cleanedStderr = removeProblemChars stderrOutput+            cleanedExpected = map removeProblemChars expectedErrors+         in if all (`isInfixOf` cleanedStderr) cleanedExpected+              then return stderrOutput+              else do+                _ <-+                  assertFailure $+                    "Error message mismatch:\n"+                      ++ "Expected substrings: "+                      ++ show expectedErrors+                      ++ "\n"+                      ++ "Actual output:\n"+                      ++ stderrOutput+                return stderrOutput++{- | Remove problematic characters that vary depending on locale+The kind and amount of quotes in GHC error messages changes depending on+whether or not our locale supports unicode.+-}+removeProblemChars :: String -> String+removeProblemChars = filter (`notElem` problemChars)+ where+  problemChars = "‘’`'"
+ tests/Tests/Common.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE QuasiQuotes #-}++module Tests.Common where++import Data.String.Interpolate (__i)+import Test.Tasty (TestTree)+import Test.Tasty.AssertGhc (Expected (..), testCaseGhc)++toTestCases :: [(String, String, String, [String])] -> [TestTree]+toTestCases = map toTestCase++toTestCase :: (String, String, String, [String]) -> TestTree+toTestCase (moduleName, typeName, literal, expectedErrors) =+  testCaseGhc+    ((if null expectedErrors then "OK , " else "NOK, ") ++ typeName ++ ", " ++ literal)+    [__i|+      import Prelude+      import #{moduleName}+      import GHC.TypeNats+      test :: #{typeName}+      test = #{literal}+    |]+    ( if null expectedErrors+        then ExpectSuccess+        else ExpectFailure expectedErrors+    )++toCaseTestCases :: [(String, String, String, [String])] -> [TestTree]+toCaseTestCases = map toCaseTestCase++toCaseTestCase :: (String, String, String, [String]) -> TestTree+toCaseTestCase (moduleName, typeName, literal, expectedErrors) =+  testCaseGhc+    ((if null expectedErrors then "OK , " else "NOK, ") ++ typeName ++ ", case " ++ literal)+    [__i|+      import Prelude+      import #{moduleName}+      import GHC.TypeNats+      import CheckedLiterals+      test :: #{typeName}+      test = case 0 of+        (#{literal} :: (#{typeName})) -> 0+        _ -> 0+    |]+    ( if null expectedErrors+        then ExpectSuccess+        else ExpectFailure expectedErrors+    )++toFunctionPatternTestCases :: [(String, String, String, [String])] -> [TestTree]+toFunctionPatternTestCases = map toFunctionPatternTestCase++toFunctionPatternTestCase :: (String, String, String, [String]) -> TestTree+toFunctionPatternTestCase (moduleName, typeName, literal, expectedErrors) =+  testCaseGhc+    ((if null expectedErrors then "OK , " else "NOK, ") ++ typeName ++ ", function " ++ literal)+    [__i|+      import Prelude+      import #{moduleName}+      import GHC.TypeNats+      import CheckedLiterals+      test :: Int+      test = match 0+        where+          match :: #{typeName} -> Int+          match #{literal} = 0+          match _ = 1+    |]+    ( if null expectedErrors+        then ExpectSuccess+        else ExpectFailure expectedErrors+    )
+ tests/Tests/Integer.hs view
@@ -0,0 +1,24 @@+module Tests.Integer (tests) where++import Test.Tasty (TestTree, testGroup)++import Tests.Integer.Case qualified+import Tests.Integer.Fixed qualified+import Tests.Integer.FunctionPattern qualified+import Tests.Integer.Int qualified+import Tests.Integer.Signed qualified+import Tests.Integer.Unsigned qualified+import Tests.Integer.Word qualified++tests :: TestTree+tests =+  testGroup+    "Integer"+    [ Tests.Integer.Int.tests+    , Tests.Integer.Case.tests+    , Tests.Integer.FunctionPattern.tests+    , Tests.Integer.Signed.tests+    , Tests.Integer.Fixed.tests+    , Tests.Integer.Unsigned.tests+    , Tests.Integer.Word.tests+    ]
+ tests/Tests/Integer/Case.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE QuasiQuotes #-}++module Tests.Integer.Case (tests) where++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toCaseTestCases)++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Case" $+  toCaseTestCases+    [ ("Data.Word", "Word8", "255", [])+    , ("Data.Word", "Word8", "256", ["Literal 256 is out of bounds.", "Word8 has bounds: [0 .. 255]."])+    , ("Data.Word", "Word8", "-1", ["Literal -1 is out of bounds.", "Word8 has bounds: [0 .. 255]."])+    , ("Data.Word", "Word8", "(uncheckedLiteral -> 256)", [])+    , ("Data.Int", "Int8", "127", [])+    , ("Data.Int", "Int8", "128", ["Literal 128 is out of bounds.", "Int8 has bounds: [-128 .. 127]."])+    ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/Fixed.hs view
@@ -0,0 +1,61 @@+module Tests.Integer.Fixed where++import Prelude++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++fMod :: String+fMod = "CheckedLiterals.Nums.Fixed"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Fixed" $ toTestCases+  [ (fMod, "(KnownNat f) => UFixed 0 f", "0",                      [])+  , (fMod, "(KnownNat f) => UFixed 0 f", "-1",                     ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 0 f", "1",                      ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s)."])+  , (fMod, "(KnownNat f) => UFixed 1 f", "0",                      [])+  , (fMod, "(KnownNat f) => UFixed 1 f", "-1",                     ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 1 f", "1",                      [])+  , (fMod, "(KnownNat f) => UFixed 1 f", "2",                      ["Literal 2 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s)."])+  , (fMod, "(KnownNat f) => UFixed 2 f", "0",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "-1",                     ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 2 f", "1",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "2",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "3",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "4",                      ["Literal 4 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s)."])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "0",          [])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "1",          ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s).", "Possible fix: add a constraint: 1 <= n."])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "-1",         ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "1",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "-1", ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "1",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "-1", ["Literal -1 is out of bounds, because UFixed cannot represent negative numbers."])++  , (fMod, "(KnownNat f) => SFixed 0 f", "0",                      [])+  , (fMod, "(KnownNat f) => SFixed 0 f", "-1",                     ["Literal -1 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 0 f", "1",                      ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 1 f", "0",                      [])+  , (fMod, "(KnownNat f) => SFixed 1 f", "-1",                     [])+  , (fMod, "(KnownNat f) => SFixed 1 f", "1",                      ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 1 f", "2",                      ["Literal 2 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "0",                      [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-1",                     [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-2",                     [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-3",                     ["Literal -3 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "1",                      [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "2",                      ["Literal 2 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "4",                      ["Literal 4 is (potentially) out of bounds.", "Note: integer part needs at least 4 bit(s), including sign bit."])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "0",          [])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "1",          ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit.", "Possible fix: add a constraint: 2 <= n."])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "-1",         ["Literal -1 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= n."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "1",  ["Literal 1 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit.", "Possible fix: add a constraint: 2 <= n."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "-1", [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "1",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "-1", [])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/FunctionPattern.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE QuasiQuotes #-}++module Tests.Integer.FunctionPattern (tests) where++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toFunctionPatternTestCases)++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "FunctionPattern" $+  toFunctionPatternTestCases+    [ ("Data.Word", "Word8", "255", [])+    , ("Data.Word", "Word8", "256", ["Literal 256 is out of bounds.", "Word8 has bounds: [0 .. 255]."])+    , ("Data.Word", "Word8", "(-1)", ["Literal -1 is out of bounds.", "Word8 has bounds: [0 .. 255]."])+    , ("Data.Word", "Word8", "(uncheckedLiteral -> 256)", [])+    , ("Data.Int", "Int8", "127", [])+    , ("Data.Int", "Int8", "128", ["Literal 128 is out of bounds.", "Int8 has bounds: [-128 .. 127]."])+    ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/Int.hs view
@@ -0,0 +1,38 @@+module Tests.Integer.Int (tests) where++import Prelude++import Data.Int+import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Int" $ toTestCases+  [ ("Data.Int", "Int",   "0",                                       [])+  , ("Data.Int", "Int",   show (minBound :: Int),                    [])+  , ("Data.Int", "Int",   show $ pred $ toInteger (minBound @Int),   ["Literal -9223372036854775809 is out of bounds.",  "Int has bounds: [-9223372036854775808 .. 9223372036854775807]"])+  , ("Data.Int", "Int",   show (maxBound :: Int),                    [])+  , ("Data.Int", "Int",   show $ succ $ toInteger (maxBound @Int),   ["Literal 9223372036854775808 is out of bounds.", "Int has bounds: [-9223372036854775808 .. 9223372036854775807]"])+  , ("Data.Int", "Int8",  "0",                                       [])+  , ("Data.Int", "Int8",  show (minBound :: Int8),                   [])+  , ("Data.Int", "Int8",  show $ pred $ toInteger (minBound @Int8),  ["Literal -129 is out of bounds.", "Int8 has bounds: [-128 .. 127]"])+  , ("Data.Int", "Int8",  show (maxBound :: Int8),                   [])+  , ("Data.Int", "Int8",  show $ succ $ toInteger (maxBound @Int8),  ["Literal 128 is out of bounds.", "Int8 has bounds: [-128 .. 127]"])+  , ("Data.Int", "Int16", "0",                                       [])+  , ("Data.Int", "Int16", show (minBound :: Int16),                  [])+  , ("Data.Int", "Int16", show $ pred $ toInteger (minBound @Int16), ["Literal -32769 is out of bounds.", "Int16 has bounds: [-32768 .. 32767]"])+  , ("Data.Int", "Int16", show (maxBound :: Int16),                  [])+  , ("Data.Int", "Int16", show $ succ $ toInteger (maxBound @Int16), ["Literal 32768 is out of bounds.", "Int16 has bounds: [-32768 .. 32767]"])+  , ("Data.Int", "Int32", "0",                                       [])+  , ("Data.Int", "Int32", show (minBound :: Int32),                  [])+  , ("Data.Int", "Int32", show $ pred $ toInteger (minBound @Int32), ["Literal -2147483649 is out of bounds.", "Int32 has bounds: [-2147483648 .. 2147483647]"])+  , ("Data.Int", "Int32", show (maxBound :: Int32),                  [])+  , ("Data.Int", "Int32", show $ succ $ toInteger (maxBound @Int32), ["Literal 2147483648 is out of bounds.", "Int32 has bounds: [-2147483648 .. 2147483647]"])+  , ("Data.Int", "Int64", "0",                                       [])+  , ("Data.Int", "Int64", show (minBound :: Int64),                  [])+  , ("Data.Int", "Int64", show $ pred $ toInteger (minBound @Int64), ["Literal -9223372036854775809 is out of bounds.", "Int64 has bounds: [-9223372036854775808 .. 9223372036854775807]"])+  , ("Data.Int", "Int64", show (maxBound :: Int64),                  [])+  , ("Data.Int", "Int64", show $ succ $ toInteger (maxBound @Int64), ["Literal 9223372036854775808 is out of bounds.", "Int64 has bounds: [-9223372036854775808 .. 9223372036854775807]"])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/Signed.hs view
@@ -0,0 +1,39 @@+module Tests.Integer.Signed where++import Prelude++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++sMod :: String+sMod = "CheckedLiterals.Nums.Signed"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Signed" $ toTestCases+  [ (sMod, "Signed 0", "0",                          [])+  , (sMod, "Signed 0", "-1",                         ["Literal -1 is (potentially) out of bounds."])+  , (sMod, "Signed 0", "1",                          ["Literal 1 is (potentially) out of bounds."])+  , (sMod, "Signed 1", "0",                          [])+  , (sMod, "Signed 1", "-1",                         [])+  , (sMod, "Signed 1", "1",                          ["Literal 1 is (potentially) out of bounds.", "Signed 1 has bounds: [-1 .. 0]"])+  , (sMod, "Signed 2", "0",                          [])+  , (sMod, "Signed 2", "-1",                         [])+  , (sMod, "Signed 2", "-2",                         [])+  , (sMod, "Signed 2", "-3",                         ["Literal -3 is (potentially) out of bounds.", "Signed 2 has bounds: [-2 .. 1]"])+  , (sMod, "Signed 2", "1",                          [])+  , (sMod, "Signed 2", "2",                          ["Signed 2 has bounds: [-2 .. 1]"])+  , (sMod, "(KnownNat n) => Signed n", "0",          [])+  , (sMod, "(KnownNat n) => Signed n", "1",          ["Signed n has bounds: [-2 ^ (n - 1) .. (2 ^ (n - 1)) - 1]", "Possible fix: add a constraint: 2 <= n."])+  , (sMod, "(KnownNat n) => Signed n", "-1",         ["Literal -1 is (potentially) out of bounds.", "Signed n has bounds: [-2 ^ (n - 1) .. (2 ^ (n - 1)) - 1]", "Possible fix: add a constraint: 1 <= n."])+  , (sMod, "(KnownNat n, 1 <= n) => Signed n", "0",  [])+  , (sMod, "(KnownNat n, 1 <= n) => Signed n", "1",  ["Signed n has bounds: [-2 ^ (n - 1) .. (2 ^ (n - 1)) - 1]", "Possible fix: add a constraint: 2 <= n."])+  , (sMod, "(KnownNat n, 1 <= n) => Signed n", "-1", [])+  , (sMod, "(KnownNat n, 2 <= n) => Signed n", "0",  [])+  , (sMod, "(KnownNat n, 2 <= n) => Signed n", "1",  [])+  , (sMod, "(KnownNat n, 2 <= n) => Signed n", "-1", [])+  , (sMod, "(KnownNat n, 3 <= n) => Signed n", "0",  [])+  , (sMod, "(KnownNat n, 3 <= n) => Signed n", "1",  [])+  , (sMod, "(KnownNat n, 3 <= n) => Signed n", "-1", [])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/Unsigned.hs view
@@ -0,0 +1,39 @@+module Tests.Integer.Unsigned where++import Prelude++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++uMod :: String+uMod = "CheckedLiterals.Nums.Unsigned"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Unsigned" $ toTestCases+  [ (uMod, "Unsigned 0", "0",                           [])+  , (uMod, "Unsigned 0", "-1",                          ["Literal -1 is out of bounds.", "Unsigned 0 has bounds: [0 .. 0]."])+  , (uMod, "Unsigned 0", "1",                           ["Literal 1 is (potentially) out of bounds.", "Unsigned 0 has bounds: [0 .. 0]."])+  , (uMod, "Unsigned 1", "0",                           [])+  , (uMod, "Unsigned 1", "-1",                          ["Literal -1 is out of bounds.", "Unsigned 1 has bounds: [0 .. 1]."])+  , (uMod, "Unsigned 1", "1",                           [])+  , (uMod, "Unsigned 1", "2",                           ["Literal 2 is (potentially) out of bounds.", "Unsigned 1 has bounds: [0 .. 1]."])+  , (uMod, "Unsigned 2", "0",                           [])+  , (uMod, "Unsigned 2", "-1",                          ["Literal -1 is out of bounds.", "Unsigned 2 has bounds: [0 .. 3]."])+  , (uMod, "Unsigned 2", "1",                           [])+  , (uMod, "Unsigned 2", "2",                           [])+  , (uMod, "Unsigned 2", "3",                           [])+  , (uMod, "Unsigned 2", "4",                           ["Literal 4 is (potentially) out of bounds.", "Unsigned 2 has bounds: [0 .. 3]."])+  , (uMod, "(KnownNat n) => Unsigned n", "0",           [])+  , (uMod, "(KnownNat n) => Unsigned n", "1",           ["Literal 1 is (potentially) out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1]", "Possible fix: add a constraint: 1 <= n."])+  , (uMod, "(KnownNat n) => Unsigned n", "-1",          ["Literal -1 is out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1]."])+  , (uMod, "(KnownNat n, 1 <= n) => Unsigned n", "0",   [])+  , (uMod, "(KnownNat n, 1 <= n) => Unsigned n", "1",   [])+  , (uMod, "(KnownNat n, 1 <= n) => Unsigned n", "-1",  ["Literal -1 is out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1]."])+  , (uMod, "(KnownNat n, 2 <= n) => Unsigned n", "0",   [])+  , (uMod, "(KnownNat n, 2 <= n) => Unsigned n", "1",   [])+  , (uMod, "(KnownNat n, 2 <= n) => Unsigned n", "-1",  ["Literal -1 is out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1]."])+  , (uMod, "(KnownNat n, 7 <= n) => Unsigned n", "255", ["Literal 255 is (potentially) out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1].", "Possible fix: add a constraint: 8 <= n."])+  , (uMod, "(KnownNat n, 8 <= n) => Unsigned n", "256", ["Literal 256 is (potentially) out of bounds.", "Unsigned n has bounds: [0 .. (2 ^ n) - 1].", "Possible fix: add a constraint: 9 <= n."])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Integer/Word.hs view
@@ -0,0 +1,33 @@+module Tests.Integer.Word (tests) where++import Prelude++import Data.Word+import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Word" $ toTestCases+  [ ("Data.Word", "Word",   show (minBound :: Word),                    [])+  , ("Data.Word", "Word",   show $ pred $ toInteger (minBound @Word),   ["Literal -1 is out of bounds.","Word has bounds: [0 .. 18446744073709551615]"])+  , ("Data.Word", "Word",   show (maxBound :: Word),                    [])+  , ("Data.Word", "Word",   show $ succ $ toInteger (maxBound @Word),   ["Literal 18446744073709551616 is out of bounds.", "Word has bounds: [0 .. 18446744073709551615]"])+  , ("Data.Word", "Word8",  show (minBound :: Word8),                   [])+  , ("Data.Word", "Word8",  show $ pred $ toInteger (minBound @Word8),  ["Literal -1 is out of bounds.", "Word8 has bounds: [0 .. 255]"])+  , ("Data.Word", "Word8",  show (maxBound :: Word8),                   [])+  , ("Data.Word", "Word8",  show $ succ $ toInteger (maxBound @Word8),  ["Literal 256 is out of bounds.", "Word8 has bounds: [0 .. 255]"])+  , ("Data.Word", "Word16", show (minBound :: Word16),                  [])+  , ("Data.Word", "Word16", show $ pred $ toInteger (minBound @Word16), ["Literal -1 is out of bounds.", "Word16 has bounds: [0 .. 65535]"])+  , ("Data.Word", "Word16", show (maxBound :: Word16),                  [])+  , ("Data.Word", "Word16", show $ succ $ toInteger (maxBound @Word16), ["Literal 65536 is out of bounds.", "Word16 has bounds: [0 .. 65535]"])+  , ("Data.Word", "Word32", show (minBound :: Word32),                  [])+  , ("Data.Word", "Word32", show $ pred $ toInteger (minBound @Word32), ["Literal -1 is out of bounds.", "Word32 has bounds: [0 .. 4294967295]"])+  , ("Data.Word", "Word32", show (maxBound :: Word32),                  [])+  , ("Data.Word", "Word32", show $ succ $ toInteger (maxBound @Word32), ["Literal 4294967296 is out of bounds.", "Word32 has bounds: [0 .. 4294967295]"])+  , ("Data.Word", "Word64", show (minBound :: Word64),                  [])+  , ("Data.Word", "Word64", show $ pred $ toInteger (minBound @Word64), ["Literal -1 is out of bounds.", "Word64 has bounds: [0 .. 18446744073709551615]"])+  , ("Data.Word", "Word64", show (maxBound :: Word64),                  [])+  , ("Data.Word", "Word64", show $ succ $ toInteger (maxBound @Word64), ["Literal 18446744073709551616 is out of bounds.", "Word64 has bounds: [0 .. 18446744073709551615]"])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Rational.hs view
@@ -0,0 +1,18 @@+module Tests.Rational (tests) where++import Test.Tasty (TestTree, testGroup)++import Tests.Rational.Case qualified+import Tests.Rational.Fixed qualified+import Tests.Rational.FunctionPattern qualified+import Tests.Rational.Ratio qualified++tests :: TestTree+tests =+  testGroup+    "Rational"+    [ Tests.Rational.Fixed.tests+    , Tests.Rational.Case.tests+    , Tests.Rational.FunctionPattern.tests+    , Tests.Rational.Ratio.tests+    ]
+ tests/Tests/Rational/Case.hs view
@@ -0,0 +1,17 @@+module Tests.Rational.Case (tests) where++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toCaseTestCases)++fMod :: String+fMod = "CheckedLiterals.Nums.Fixed"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Case" $ toCaseTestCases+  [ (fMod, "UFixed 0 1", "0.5",  [])+  , (fMod, "UFixed 0 1", "0.75", ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s)."])+  , (fMod, "UFixed 0 1", "-0.5", ["Literal -0.5 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "UFixed 0 1", "(uncheckedLiteral -> 0.75)", [])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Rational/Fixed.hs view
@@ -0,0 +1,86 @@+module Tests.Rational.Fixed where++import Prelude++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++fMod :: String+fMod = "CheckedLiterals.Nums.Fixed"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Fixed" $ toTestCases+  [ (fMod, "(KnownNat f) => UFixed 0 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 0 f", "-1.0",                     ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 0 f", "1.0",                      ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s)."])+  , (fMod, "(KnownNat f) => UFixed 1 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 1 f", "-1.0",                     ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 1 f", "1.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 1 f", "2.0",                      ["Literal 2.0 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s)."])+  , (fMod, "(KnownNat f) => UFixed 2 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "-1.0",                     ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f) => UFixed 2 f", "1.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "2.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "3.0",                      [])+  , (fMod, "(KnownNat f) => UFixed 2 f", "4.0",                      ["Literal 4.0 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s)."])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "0.0",          [])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "1.0",          ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s).", "Possible fix: add a constraint: 1 <= n."])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "-1.0",         ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "0.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "1.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => UFixed n f", "-1.0", ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "0.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "1.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => UFixed n f", "-1.0", ["Literal -1.0 is out of bounds, because UFixed cannot represent negative numbers."])++  , (fMod, "(KnownNat f) => SFixed 0 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => SFixed 0 f", "-1.0",                     ["Literal -1.0 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 0 f", "1.0",                      ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 1 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => SFixed 1 f", "-1.0",                     [])+  , (fMod, "(KnownNat f) => SFixed 1 f", "1.0",                      ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 1 f", "2.0",                      ["Literal 2.0 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "0.0",                      [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-1.0",                     [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-2.0",                     [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "-3.0",                     ["Literal -3.0 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "1.0",                      [])+  , (fMod, "(KnownNat f) => SFixed 2 f", "2.0",                      ["Literal 2.0 is (potentially) out of bounds.", "Note: integer part needs at least 3 bit(s), including sign bit."])+  , (fMod, "(KnownNat f) => SFixed 2 f", "4.0",                      ["Literal 4.0 is (potentially) out of bounds.", "Note: integer part needs at least 4 bit(s), including sign bit."])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "0.0",          [])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "1.0",          ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit.", "Possible fix: add a constraint: 2 <= n."])+  , (fMod, "(KnownNat f, KnownNat n) => SFixed n f", "-1.0",         ["Literal -1.0 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= n."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "0.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "1.0",  ["Literal 1.0 is (potentially) out of bounds.", "Note: integer part needs at least 2 bit(s), including sign bit.", "Possible fix: add a constraint: 2 <= n."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n) => SFixed n f", "-1.0", [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "0.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "1.0",  [])+  , (fMod, "(KnownNat f, KnownNat n, 2 <= n) => SFixed n f", "-1.0", [])++  , (fMod, "UFixed 0 0", "0.5",                                      ["Literal 0.5 cannot be represented exactly by Fixed", "The fractional part needs at least 1 bit(s)."])+  , (fMod, "UFixed 0 1", "0.5",                                      [])+  , (fMod, "UFixed 0 1", "0.75",                                     ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s)."])+  , (fMod, "UFixed 0 1", "0.1",                                      ["Literal 0.1 cannot be represented exactly by", "The reduced denominator 10 is not a power of 2."])+  , (fMod, "(KnownNat f, 1 <= f) => UFixed 0 f", "0.5",              [])+  , (fMod, "(KnownNat f, 1 <= f) => UFixed 0 f", "0.75",             ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s).", "Possible fix: add a constraint: 2 <= f."])+  , (fMod, "(KnownNat f, 2 <= f) => UFixed 0 f", "0.75",             [])+  , (fMod, "(KnownNat f, 3 <= f) => UFixed 0 f", "0.75",             [])++  , (fMod, "SFixed 0 0", "0.5",                                      ["Literal 0.5 cannot be represented exactly by Fixed", "The fractional part needs at least 1 bit(s)."])+  , (fMod, "SFixed 0 1", "0.5",                                      ["Literal 0.5 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= 0."])+  , (fMod, "SFixed 0 1", "0.75",                                     ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s)."])+  , (fMod, "SFixed 0 1", "0.1",                                      ["Literal 0.1 cannot be represented exactly by", "The reduced denominator 10 is not a power of 2."])+  , (fMod, "(KnownNat f, 1 <= f) => SFixed 0 f", "0.5",              ["Literal 0.5 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= 0."])+  , (fMod, "(KnownNat f, 1 <= f) => SFixed 0 f", "0.75",             ["Literal 0.75 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= 0."])+  , (fMod, "(KnownNat f, 2 <= f) => SFixed 0 f", "0.75",             ["Literal 0.75 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= 0."])+  , (fMod, "(KnownNat f, 3 <= f) => SFixed 0 f", "0.75",             ["Literal 0.75 is (potentially) out of bounds.", "Note: integer part needs at least 1 bit(s), including sign bit.", "Possible fix: add a constraint: 1 <= 0."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n, 1 <= f) => SFixed n f", "0.5",  [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n, 1 <= f) => SFixed n f", "0.75", ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s).", "Possible fix: add a constraint: 2 <= f."])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n, 2 <= f) => SFixed n f", "0.75", [])+  , (fMod, "(KnownNat f, KnownNat n, 1 <= n, 3 <= f) => SFixed n f", "0.75", [])++  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "255.0",        ["Literal 255.0 is (potentially) out of bounds.", "Note: integer part needs at least 8 bit(s).", "Possible fix: add a constraint: 8 <= n."])+  , (fMod, "(KnownNat f, KnownNat n) => UFixed n f", "256.0",        ["Literal 256.0 is (potentially) out of bounds.", "Note: integer part needs at least 9 bit(s).", "Possible fix: add a constraint: 9 <= n."])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Rational/FunctionPattern.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE QuasiQuotes #-}++module Tests.Rational.FunctionPattern (tests) where++import Test.Tasty (TestTree, testGroup)+import Tests.Common (toFunctionPatternTestCases)++fMod :: String+fMod = "CheckedLiterals.Nums.Fixed"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "FunctionPattern" $ toFunctionPatternTestCases+  [ (fMod, "UFixed 0 1", "0.5",  [])+  , (fMod, "UFixed 0 1", "0.75", ["Literal 0.75 cannot be represented exactly by Fixed", "The fractional part needs at least 2 bit(s)."])+  , (fMod, "UFixed 0 1", "(-0.5)", ["Literal -0.5 is out of bounds, because UFixed cannot represent negative numbers."])+  , (fMod, "UFixed 0 1", "(uncheckedLiteral -> 0.75)", [])+  ]+{- FOURMOLU_ENABLE -}
+ tests/Tests/Rational/Ratio.hs view
@@ -0,0 +1,32 @@+module Tests.Rational.Ratio (tests) where++import Prelude++import Data.Ratio ((%))+import Data.Ratio.Extra (showFixedPoint)+import Test.Tasty (TestTree, testGroup)+import Tests.Common (toTestCases)++rMod :: String+rMod = "Data.Ratio; import Data.Word; import Data.Int"++{- FOURMOLU_DISABLE -}+tests :: TestTree+tests = testGroup "Ratio" $ toTestCases+  [ (rMod, "Ratio Word8", "0.0",                    [])+  , (rMod, "Ratio Word8", "1.0",                    [])+  , (rMod, "Ratio Word8", "-1.0",                   ["Literal -1.0 cannot be represented by Ratio Word8.", "Word8 cannot represent negative numbers."])+  , (rMod, "Ratio Word8", showFixedPoint (1 % 256), ["Literal 0.00390625 (1 % 256) cannot be represented by Word8.", "Word8 has bounds: [0 .. 255]."])+  , (rMod, "Ratio Word8", "0.1",                    [])+  , (rMod, "Ratio Word8", "0.01",                   [])+  , (rMod, "Ratio Word8", "0.001",                  ["Literal 0.001 (1 % 1000) cannot be represented by Word8."])+  , (rMod, "Ratio Int8", "0.0",                     [])+  , (rMod, "Ratio Int8", "1.0",                     [])+  , (rMod, "Ratio Int8", "-1.0",                    [])+  , (rMod, "Ratio Int8", "-129.0",                  ["Literal -129.0 (-129 % 1) cannot be represented by Int8.", "Int8 has bounds: [-128 .. 127]."])+  , (rMod, "Ratio Int8", showFixedPoint (1 % 128),  ["Literal 0.0078125 (1 % 128) cannot be represented by Int8.", "Int8 has bounds: [-128 .. 127]."])+  , (rMod, "Ratio Int8", "0.1",                     [])+  , (rMod, "Ratio Int8", "0.01",                    [])+  , (rMod, "Ratio Int8", "0.001",                   ["Literal 0.001 (1 % 1000) cannot be represented by Int8."])+  ]+{- FOURMOLU_ENABLE -}