diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,27 @@ +0.5.1 +===== +* [!1080](https://gitlab.com/morley-framework/morley/-/merge_requests/1080) + Add more `PrettyShow` type instances + + For lists + + Add instances that forbid defining `PrettyShow` for `String`, `Text`, and `ByteString` +* [!1075](https://gitlab.com/morley-framework/morley/-/merge_requests/1075) + Add suitable types for oddly-sized unsigned integers + + Add a dependency on `OddWord`. + + Re-export `Word62`, `Word63` types representing unsigned integer word types with odd sizes in `Prelude`. +* [!1025](https://gitlab.com/morley-framework/morley/-/merge_requests/1025) + Reduce the number of unsafe functions at the call site + + Add `unsafe`, which is primarily needed for making unsafe counter-parts of safe functions, to `Unsafe`. + + Add `unsafeM`, which is similar to `unsafe`, but throws monadic exceptions. +* [!978](https://gitlab.com/morley-framework/morley/-/merge_requests/978) + Make it difficult to misuse 'Show' + + `show` exported from `morley-prelude` now requires the type to be an instance of an open type family `PrettyShow` of kind `Constraint`. This is intended to discourage the use of `show` for user-facing output (use `Buildable` instead). + + The original `show` is exported from `Debug` module, which is intended to be imported qualified. +* [!1035](https://gitlab.com/morley-framework/morley/-/merge_requests/1035) + Better type errors on invalid int casts + 0.5.0 ===== * [!1001](https://gitlab.com/morley-framework/morley/-/merge_requests/1001) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,6 @@ -MIT License Copyright (c) 2021 Tocqueville Group +MIT License +Copyright (c) 2021-2022 Oxhead Alpha +Copyright (c) 2019-2021 Tocqueville Group Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/morley-prelude.cabal b/morley-prelude.cabal --- a/morley-prelude.cabal +++ b/morley-prelude.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morley-prelude -version: 0.5.0 +version: 0.5.1 synopsis: A custom prelude used in Morley description: A custom prelude used in Morley. It re-exports the Universum prelude and makes some tiny changes. category: Prelude @@ -13,7 +13,7 @@ bug-reports: https://gitlab.com/morley-framework/morley/-/issues author: camlCase, Serokell, Tocqueville Group maintainer: Serokell -copyright: 2019-2021 Tocqueville Group +copyright: 2019-2021 Tocqueville Group, 2021-2022 Oxhead Alpha license: MIT license-file: LICENSE build-type: Simple @@ -26,8 +26,11 @@ library exposed-modules: + Debug Morley.Prelude.Boolean Morley.Prelude.FromIntegral + Morley.Prelude.Show + Morley.Prelude.Word Prelude Unsafe other-modules: @@ -57,23 +60,26 @@ FlexibleInstances GADTs GeneralizedNewtypeDeriving + ImportQualifiedPost LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NegativeLiterals - NumericUnderscores NumDecimals + NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms PolyKinds + QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving + StandaloneKindSignatures StrictData TemplateHaskell TupleSections @@ -85,8 +91,13 @@ ViewPatterns ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-unused-packages build-depends: - base-noprelude >=4.7 && <5 + Cabal + , OddWord + , base-noprelude >=4.7 && <5 + , fmt , int-cast , lens + , template-haskell + , time , universum default-language: Haskell2010 diff --git a/src/Debug.hs b/src/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Debug.hs @@ -0,0 +1,24 @@ +-- SPDX-FileCopyrightText: 2022 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA + +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module reexports an unconstrained version of 'show', which can be used +-- to print non-human-readable types. Generally, you don't want this. The cases where +-- this makes sense are: +-- +-- * You want to print specifically a Haskell representation for debugging purposes +-- * There is no meaningful human-readable representation +-- * You're implementing a @Show@ instance +-- +-- It's perfectly okay to use @Debug.show@ in these cases. When the output is intended to be seen +-- by the end user, however, you should use @Fmt.pretty@ instead. +-- +-- This module should be imported qualified: +-- +-- > import qualified Debug (show) +module Debug + ( show + ) where + +import Universum (show) diff --git a/src/Morley/Prelude/Boolean.hs b/src/Morley/Prelude/Boolean.hs --- a/src/Morley/Prelude/Boolean.hs +++ b/src/Morley/Prelude/Boolean.hs @@ -1,6 +1,5 @@ --- SPDX-FileCopyrightText: 2021 Tocqueville Group --- --- SPDX-License-Identifier: LicenseRef-MIT-TQ +-- SPDX-FileCopyrightText: 2021 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA {-# LANGUAGE NoImplicitPrelude #-} @@ -12,7 +11,7 @@ ) where import Universum hiding ((&&), (||)) -import qualified Universum +import Universum qualified -- | Generalized boolean operators. class Boolean a where diff --git a/src/Morley/Prelude/FromIntegral.hs b/src/Morley/Prelude/FromIntegral.hs --- a/src/Morley/Prelude/FromIntegral.hs +++ b/src/Morley/Prelude/FromIntegral.hs @@ -1,13 +1,12 @@ --- SPDX-FileCopyrightText: 2021 Tocqueville Group --- --- SPDX-License-Identifier: LicenseRef-MIT-TQ +-- SPDX-FileCopyrightText: 2021 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA {-# LANGUAGE NoImplicitPrelude #-} -- | Safe(r) converters from @Integral@ types module Morley.Prelude.FromIntegral ( IntBaseType - , IsIntSubType + , CheckIntSubType , fromIntegral , fromIntegralMaybe , fromIntegralNoOverflow @@ -19,18 +18,44 @@ import Data.Bits (Bits) import Data.IntCast (IntBaseType, IsIntSubType, intCast, intCastMaybe) import Data.Ratio ((%)) +import GHC.TypeLits (ErrorMessage(..), TypeError) import System.IO.Unsafe (unsafePerformIO) import Universum hiding (fromInteger, fromIntegral) -import qualified Universum (fromIntegral) +import Universum qualified (fromIntegral) --- | Statically safe converter between 'Integral' --- types, which is just 'intCast' under the hood. --- --- It is used to turn the value of type @a@ into --- the value of type @b@ such that @a@ is subtype --- of @b@. It is needed to prevent silent unsafe --- conversions. -fromIntegral :: (Integral a, Integral b, IsIntSubType a b ~ 'True) => a -> b +-- | Constraint synonym equivalent to @'IsIntSubType' a b ~ 'True@, but with +-- better error messages +type CheckIntSubType a b = + ( CheckIntSubTypeErrors a b (IsIntSubType a b) + , IsIntSubType a b ~ 'True ) + +type family CheckIntSubTypeErrors a b (z :: Bool) :: Constraint where + CheckIntSubTypeErrors _ _ 'True = () + CheckIntSubTypeErrors a b 'False = + TypeError ('Text "Can not safely cast '" + ':<>: 'ShowType a ':<>: 'Text "' to '" ':<>: 'ShowType b ':<>: 'Text "':" + ':$$: 'Text "'" ':<>: 'ShowType a ':<>: 'Text "' is not a subtype of '" ':<>: 'ShowType b + ':<>: 'Text "'" + ) + +{- | Statically safe converter between 'Integral' +types, which is just 'intCast' under the hood. + +It is used to turn the value of type @a@ into +the value of type @b@ such that @a@ is subtype +of @b@. It is needed to prevent silent unsafe +conversions. + +>>> fromIntegral @Int @Word 1 +... +... error: +... Can not safely cast 'Int' to 'Word': +... 'Int' is not a subtype of 'Word' +... +>>> fromIntegral @Word @Natural 1 +1 +-} +fromIntegral :: (Integral a, Integral b, CheckIntSubType a b) => a -> b fromIntegral = intCast -- | Statically safe converter between 'Integral' @@ -49,7 +74,7 @@ -- 'Unsafe.fromIntegral', which are safe actually -- as integral numbers are being casted to -- fractional ones. -fromIntegralToRealFrac :: (Integral a, RealFrac b, IsIntSubType a Integer ~ 'True) => a -> b +fromIntegralToRealFrac :: (Integral a, RealFrac b, CheckIntSubType a Integer) => a -> b fromIntegralToRealFrac = fromRational . (% 1) . fromIntegral {- | Runtime-safe converter between 'Integral' types, which is just diff --git a/src/Morley/Prelude/Show.hs b/src/Morley/Prelude/Show.hs new file mode 100644 --- /dev/null +++ b/src/Morley/Prelude/Show.hs @@ -0,0 +1,108 @@ +-- SPDX-FileCopyrightText: 2022 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA + +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Module defining a version of 'Universum.show' constrained only to types that have a +-- human-readable representation. +-- +-- For printing non-human-readable representation, use module "Debug". +module Morley.Prelude.Show + ( PrettyShow + , show + ) where + +import Data.Fixed (Fixed) +import Data.Time (NominalDiffTime) +import Data.Typeable (TypeRep) +import Data.Word.Odd (Word62, Word63) +import GHC.TypeLits (ErrorMessage(..), TypeError) +import Language.Haskell.Extension (KnownExtension) +import Language.Haskell.TH (Name) +import Language.Haskell.TH.PprLib (Doc) +import Universum hiding (show) +import Universum qualified (show) + +-- | An open type family for types having a human-readable 'Show' representation. The +-- kind is 'Constraint' in case we need to further constrain the instance, and also for +-- convenience to avoid explicitly writing @~ 'True@ everywhere. +type family PrettyShow a :: Constraint + +-- Integrals are human-readable +type instance PrettyShow Word = () +type instance PrettyShow Word8 = () +type instance PrettyShow Word16 = () +type instance PrettyShow Word32 = () +type instance PrettyShow Word62 = () +type instance PrettyShow Word63 = () +type instance PrettyShow Word64 = () +type instance PrettyShow Int = () +type instance PrettyShow Int8 = () +type instance PrettyShow Int16 = () +type instance PrettyShow Int32 = () +type instance PrettyShow Int64 = () +type instance PrettyShow Integer = () +type instance PrettyShow Natural = () + +-- Double and Float are also pretty human-readable +type instance PrettyShow Float = () +type instance PrettyShow Double = () + +-- Fixed is generally very human-readable +type instance PrettyShow (Fixed _) = () + +-- UnicodeException show instance is human-readable instead of machine-readable +type instance PrettyShow UnicodeException = () + +-- TH 'Name' generally just shows the underlying string +type instance PrettyShow Name = () + +-- The Show instance for 'Doc' is the same as render +type instance PrettyShow Doc = () + +-- KnownExtension's show instance pretty much matches exactly with the +-- expectations, e.g. StarIsType. +type instance PrettyShow KnownExtension = () + +-- TypeRep is pretty human-readable, can use show without worry +type instance PrettyShow TypeRep = () + +-- NominalDiffTime show instance is human-readable instead of machine-readable +type instance PrettyShow NominalDiffTime = () + +-- Lists are human-readable if each element in it is +type instance PrettyShow [a] = PrettyShow a + +-- Show instances for String and similar types are not entirely human-readable. +-- For instance: +-- +-- >>> print "A string with \"quotes\"" +-- "A string with \"quotes\"" +-- +-- >>> print "A string with non-ascii characters हि" +-- "A string with non-ascii characters \2361\2367" +type instance PrettyShow Text = TypeError ( + 'Text "Show instance for Text is not pretty" ':$$: + 'Text "Consider relying on the Buildable instance" + ) +type instance PrettyShow LText = TypeError ( + 'Text "Show instance for lazy Text is not pretty" ':$$: + 'Text "Consider relying on the Buildable instance" + ) +type instance PrettyShow Char = TypeError ( + 'Text "Show instance for String and Char is not pretty" ':$$: + 'Text "Consider relying on the Buildable instance" + ) + +type instance PrettyShow ByteString = TypeError ( + 'Text "Show instance for ByteString is not pretty" + ) +type instance PrettyShow LByteString = TypeError ( + 'Text "Show instance for lazy ByteString is not pretty" + ) + +-- | A version of 'Universum.show' that requires the value to have a human-readable +-- 'Show' instance. +show :: forall b a. (PrettyShow a, Show a, IsString b) => a -> b +show = Universum.show diff --git a/src/Morley/Prelude/Word.hs b/src/Morley/Prelude/Word.hs new file mode 100644 --- /dev/null +++ b/src/Morley/Prelude/Word.hs @@ -0,0 +1,15 @@ +-- SPDX-FileCopyrightText: 2022 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA + +{-# LANGUAGE NoImplicitPrelude #-} + +module Morley.Prelude.Word + ( module Data.Word.Odd + ) + where + +import Data.IntCast (IntBaseType, IntBaseTypeK(..)) +import Data.Word.Odd (Word62, Word63) + +type instance IntBaseType Word63 = 'FixedWordTag 63 +type instance IntBaseType Word62 = 'FixedWordTag 62 diff --git a/src/Prelude.hs b/src/Prelude.hs --- a/src/Prelude.hs +++ b/src/Prelude.hs @@ -1,6 +1,5 @@ --- SPDX-FileCopyrightText: 2021 Tocqueville Group --- --- SPDX-License-Identifier: LicenseRef-MIT-TQ +-- SPDX-FileCopyrightText: 2021 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA -- | This module essentially replaces the default "Prelude" with "Universum". -- @@ -16,6 +15,14 @@ , module Boolean -- * Unsafe conversions , Unsafe.fromInteger + -- * Safer @show@ + , module Show + -- * Oddly sized @Word@ types + , module Word + + -- * Re-exports + , Unsafe.unsafe + , Unsafe.unsafeM ) where import Control.Lens @@ -24,8 +31,10 @@ import Data.Traversable (for) import Morley.Prelude.Boolean as Boolean import Morley.Prelude.FromIntegral as FromIntegral +import Morley.Prelude.Show as Show +import Morley.Prelude.Word as Word import Universum hiding (Key, Lens, Lens', Nat, Traversal, Traversal', Val, _1, _2, _3, _4, _5, fromInteger, fromIntegral, - over, preuse, preview, readFile, set, use, view, writeFile, (%~), (&&), (&), (.~), (<&>), (^.), - (^..), (^?), (||)) -import qualified Unsafe (fromInteger) + over, preuse, preview, readFile, set, show, use, view, writeFile, (%~), (&&), (&), (.~), (<&>), + (^.), (^..), (^?), (||)) +import Unsafe qualified (fromInteger, unsafe, unsafeM) diff --git a/src/Unsafe.hs b/src/Unsafe.hs --- a/src/Unsafe.hs +++ b/src/Unsafe.hs @@ -1,6 +1,5 @@ --- SPDX-FileCopyrightText: 2021 Tocqueville Group --- --- SPDX-License-Identifier: LicenseRef-MIT-TQ +-- SPDX-FileCopyrightText: 2021 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA {-# LANGUAGE NoImplicitPrelude #-} @@ -13,8 +12,13 @@ -- * Unsafe converters between @Integral@ types checking for overflow/underflow , Unsafe.fromIntegral , Unsafe.fromInteger + + -- * Unsafe converters from @Either@ for making unsafe counter-parts of safe functions + , unsafe + , unsafeM ) where +import Fmt (Buildable, pretty) import Morley.Prelude.FromIntegral (fromIntegralNoOverflow) import Universum import Universum.Unsafe @@ -41,3 +45,21 @@ -- Note the function is strict in its argument. fromInteger :: (HasCallStack, Integral a) => Integer -> a fromInteger = Unsafe.fromIntegral + +-- | Unsafe converter from 'Either', which uses buildable +-- 'Left' to throw an exception with 'error'. +-- +-- It is primarily needed for making unsafe counter-parts +-- of safe functions. In particular, for replacing +-- @unsafeFName x = either (error . pretty) id@ +-- constructors and converters, which produce many similar +-- functions at the call site, with @unsafe . fName $ x@. +unsafe :: (HasCallStack, Buildable a) => Either a b -> b +unsafe = either (error . pretty) id +{-# INLINE unsafe #-} + +-- | Similar to 'unsafe' converter, but with the use of +-- monadic 'fail' and returning the result wrapped in a monad. +unsafeM :: (MonadFail m, Buildable a) => Either a b -> m b +unsafeM = either (fail . pretty) pure +{-# INLINE unsafeM #-}