packages feed

nat-optics (empty) → 1

raw patch · 5 files changed

+229/−0 lines, 5 filesdep +basedep +optics-coredep +text

Dependencies added: base, optics-core, text

Files

+ license.txt view
@@ -0,0 +1,18 @@+Copyright 2021 Mission Valley Software LLC++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ nat-optics.cabal view
@@ -0,0 +1,55 @@+cabal-version: 3.0++name: nat-optics+version: 1+category: Numeric, Optics++synopsis:+    Refinement types for natural numbers with an optics interface++description:+    Modules:++    - "NatOptics.NonNegative" includes 0, 1, 2, 3, ...+    - "NatOptics.Positive" includes 1, 2, 3, 4, ...++    You probably also want to import the "Optics" module+    from the `optics` package.++copyright: 2021 Mission Valley Software LLC+license: MIT+license-file: license.txt++author:     Chris Martin+maintainer: Chris Martin, Julie Moronuki++homepage:    https://github.com/typeclasses/nat-optics+bug-reports: https://github.com/typeclasses/nat-optics/issues++build-type: Simple++source-repository head+  type: git+  location: https://github.com/typeclasses/nat-optics++library+    default-language: Haskell2010+    ghc-options: -Wall+    hs-source-dirs: src++    default-extensions:+        DerivingStrategies+        GeneralizedNewtypeDeriving+        NoImplicitPrelude++    exposed-modules:+        NatOptics.NonNegative+        NatOptics.Positive++    other-modules:+        NatOptics.Internal++    build-depends:+        base        ^>= 4.14 || ^>= 4.15+      , text        ^>= 1.2.3+      , optics-core ^>= 0.4
+ src/NatOptics/Internal.hs view
@@ -0,0 +1,22 @@+module NatOptics.Internal ( strNat, textStr ) where++import Control.Monad   ( mfilter )+import Data.Eq         ( (==) )+import Data.String     ( String )+import Data.Text       ( Text )+import Numeric.Natural ( Natural )+import Optics.Iso      ( Iso', iso )+import Optics.Prism    ( Prism', prism' )+import Text.Read       ( Read, readMaybe )+import Text.Show       ( Show, show )++import qualified Data.Text as Text++textStr :: Iso' Text String+textStr = iso Text.unpack Text.pack++strNat :: Prism' String Natural+strNat = readShowPrism++readShowPrism :: (Read a, Show a) => Prism' String a+readShowPrism = prism' show (\str -> mfilter (\n -> show n == str) (readMaybe str))
+ src/NatOptics/NonNegative.hs view
@@ -0,0 +1,73 @@+module NatOptics.NonNegative+  (+    {- * Type constructor -} NonNegative,++    {- * Optics -}           refine, natPrism, intPrism,+                             natIso, textPrism, stringPrism,++    {- * Re-exports -}       Natural, Integer, Prism', Iso',+                             view, review, preview+  ) where++import Control.Applicative ( (*>) )+import Control.Monad       ( guard )+import Data.Bits           ( Bits, toIntegralSized )+import Data.Eq             ( Eq )+import Data.Function       ( (.) )+import Data.Functor        ( fmap, ($>), (<$>) )+import Data.Maybe          ( Maybe )+import Data.Ord            ( Ord, (>=) )+import Data.String         ( String )+import Data.Text           ( Text )+import NatOptics.Internal  ( strNat, textStr )+import Numeric.Natural     ( Natural )+import Optics.AffineFold   ( preview )+import Optics.Getter       ( view )+import Optics.Iso          ( Iso', iso )+import Optics.Optic        ( (%) )+import Optics.Prism        ( Prism', prism' )+import Optics.Review       ( review )+import Prelude             ( Integer, Integral, Num,+                             fromIntegral, toInteger )+import Text.Show           ( Show )++newtype NonNegative number = NonNegative{ number :: number }+    deriving newtype (Eq, Ord, Show)++{- | For any numeric type @n@,+     @'NonNegative' n@ is a subset of @n@. -}+refine :: (Num n, Ord n) => Prism' n (NonNegative n)+refine = prism' number verify++{- | For any integral type @n@,+     @'NonNegative' n@ is a subset of 'Natural'. -}+natPrism :: (Integral n, Bits n) => Prism' Natural (NonNegative n)+natPrism =+    prism'+        (fromIntegral . number)+        (fmap NonNegative . toIntegralSized) {- No need to verify+            here, because Natural is always non-negative. The only+            check here is when converting from 'Natural' to ensure+            that it does not overflow the max bound of 'n'. -}++{- | For any integral type @n@,+     @'NonNegative' n@ is a subset of 'Integer'. -}+intPrism :: (Integral n, Bits n) => Prism' Integer (NonNegative n)+intPrism = prism' (toInteger . number) verifyAndResize++{- | 'Natural' and @'NonNegative' 'Natural'@ are the same thing. -}+natIso :: Iso' Natural (NonNegative Natural)+natIso = iso NonNegative number++stringPrism :: (Integral n, Bits n) => Prism' String (NonNegative n)+stringPrism = strNat % natPrism++textPrism :: (Integral n, Bits n) => Prism' Text (NonNegative n)+textPrism = textStr % stringPrism++verify :: (Ord n, Num n) => n -> Maybe (NonNegative n)+verify n = guard (n >= 0) $> NonNegative n++verifyAndResize :: (Integral a, Integral b, Bits a, Bits b)+                => a -> Maybe (NonNegative b)+verifyAndResize x = verify x *> (NonNegative <$> toIntegralSized x)
+ src/NatOptics/Positive.hs view
@@ -0,0 +1,61 @@+module NatOptics.Positive+  (+    {- * Type constructor -} Positive,++    {- * Optics -}           refine, natPrism, intPrism,+                             textPrism, stringPrism,++    {- * Re-exports -}       Natural, Integer, Prism',+                             view, review, preview+  ) where++import Control.Applicative ( (*>) )+import Control.Monad       ( guard )+import Data.Bits           ( Bits, toIntegralSized )+import Data.Eq             ( Eq )+import Data.Function       ( (.) )+import Data.Functor        ( ($>), (<$>) )+import Data.Maybe          ( Maybe )+import Data.Ord            ( Ord, (>) )+import Data.String         ( String )+import Data.Text           ( Text )+import NatOptics.Internal  ( strNat, textStr )+import Numeric.Natural     ( Natural )+import Optics.AffineFold   ( preview )+import Optics.Getter       ( view )+import Optics.Optic        ( (%) )+import Optics.Prism        ( Prism', prism' )+import Optics.Review       ( review )+import Prelude             ( Integer, Integral, Num,+                             fromIntegral, toInteger )+import Text.Show           ( Show )++newtype Positive number = Positive{ number :: number }+    deriving newtype (Eq, Ord, Show)++{- | For any numeric type @n@,+     @'Positive' n@ is a subset of @n@.-}+refine :: (Num n, Ord n) => Prism' n (Positive n)+refine = prism' number verify++{- | For any integral type @n@,+     @'Positive' n@ is a subset of 'Natural'. -}+natPrism :: (Integral n, Bits n) => Prism' Natural (Positive n)+natPrism = prism' (fromIntegral . number) verifyAndResize++{- | For any integral type @n@,+     @'Positive' n@ is a subset of 'Integer'. -}+intPrism :: (Integral n, Bits n) => Prism' Integer (Positive n)+intPrism = prism' (toInteger . number) verifyAndResize++stringPrism :: (Integral n, Bits n) => Prism' String (Positive n)+stringPrism = strNat % natPrism++textPrism :: (Integral n, Bits n) => Prism' Text (Positive n)+textPrism = textStr % stringPrism++verify :: (Num n, Ord n) => n -> Maybe (Positive n)+verify n = guard (n > 0) $> Positive n++verifyAndResize :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe (Positive b)+verifyAndResize x = verify x *> (Positive <$> toIntegralSized x)