diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,14 @@ +0.3.0.2 + +* fix bug in `zero` and `one` prisms. +* rename `Natural` to `Positive`. +* rename `Whole` to `Natural`. + +0.2.0.2 + +* change `data Natural` to have a minimum bound of 1. +* add `data Whole` which has a minimum bound of 0. + 0.1.0.2 * add `minus` function. diff --git a/natural.cabal b/natural.cabal --- a/natural.cabal +++ b/natural.cabal @@ -1,7 +1,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: natural -version: 0.1.0.2 +version: 0.3.0.2 synopsis: Natural number description: <> @@ -28,6 +28,7 @@ exposed-modules: Natural build-depends: base >=4.8 && <4.12 , lens >=4.15 && < 4.18 + , semigroupoids >= 5 && < 6 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Natural.hs b/src/Natural.hs --- a/src/Natural.hs +++ b/src/Natural.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -module Natural( +module Natural ( Natural , HasNatural(..) , AsNatural(..) @@ -12,8 +12,6 @@ , MinNatural(..) , zero , zero' -, one -, one' , successor , successor' , length @@ -28,11 +26,35 @@ , elemIndex , minus , list +, Positive +, HasPositive(..) +, AsPositive(..) +, SumPositive(..) +, MaxPositive(..) +, MinPositive(..) +, one +, one' +, successor1 +, successor1' +, successorW +, notZero +, length1 +, replicate1 +, take1 +, drop1 +, splitAt1 +, (!!!) +, findIndices1 +, findIndex1 +, elemIndices1 +, elemIndex1 +, minus1 +, list1 ) where import Control.Applicative(Const) import Control.Category((.), id) -import Control.Lens(Wrapped(_Wrapped', Unwrapped), Rewrapped, Prism', Lens', Iso', (^?), ( # ), _Wrapped, prism', iso) +import Control.Lens(Wrapped(_Wrapped', Unwrapped), Rewrapped, Prism', Lens', Iso', (^?), ( # ), (^.), _Wrapped, prism', iso) import Control.Monad((>>=)) import Data.Bool(Bool) import Data.Eq(Eq((==))) @@ -41,10 +63,13 @@ import Data.Functor.Identity(Identity) import Data.Int(Int) import Data.List(iterate, zip, filter, map, repeat) +import Data.List.NonEmpty(NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty(iterate, zip, filter) import Data.Maybe(listToMaybe, Maybe(Just, Nothing)) import Data.Monoid(Monoid(mappend, mempty)) import Data.Ord(Ord((<)), min, max) import Data.Semigroup(Semigroup((<>))) +import Data.Semigroup.Foldable(Foldable1(foldMap1)) import Data.Tuple(fst, snd) import Data.Word(Word) import Prelude(Show, Integral, Integer, (-), (+), (*), fromIntegral) @@ -208,27 +233,13 @@ zero = prism' (\() -> Natural 0) - (\(Natural n) -> if n == 0 then Nothing else Just ()) + (\(Natural n) -> if n == 0 then Just () else Nothing) zero' :: Natural zero' = zero # () -one :: - Prism' - Natural - () -one = - prism' - (\() -> Natural 1) - (\(Natural n) -> if n == 1 then Nothing else Just ()) - -one' :: - Natural -one' = - one # () - successor :: Prism' Natural @@ -345,3 +356,286 @@ iso (\n -> replicate n ()) length + +---- + +newtype Positive = + Positive + Integer + deriving (Eq, Ord, Show) + +instance Semigroup Positive where + Positive x <> Positive y = + Positive (x + y) + +instance Monoid Positive where + mappend = + (<>) + mempty = + Positive 0 + +class HasPositive a where + positive :: + Lens' + a + Positive + +instance HasPositive Positive where + positive = + id + +class AsPositive a where + _Positive :: + Prism' + a + Positive + +instance AsPositive Positive where + _Positive = + id + +integralPrism1 :: + Integral a => + Prism' + a + Positive +integralPrism1 = + prism' + (\(Positive n) -> fromIntegral n) + (\n -> if n < 1 then Nothing else Just (Positive (fromIntegral n))) + +instance AsPositive Int where + _Positive = + integralPrism1 + +instance AsPositive Integer where + _Positive = + integralPrism1 + +instance AsPositive Word where + _Positive = + integralPrism1 + +instance Integral a => AsPositive (Const a b) where + _Positive = + integralPrism1 + +instance Integral a => AsPositive (Identity a) where + _Positive = + integralPrism1 + +newtype SumPositive = + SumPositive + Positive + deriving (Eq, Ord, Show) + +instance HasPositive SumPositive where + positive = + _Wrapped . positive + +instance AsPositive SumPositive where + _Positive = + _Wrapped . _Positive + +instance SumPositive ~ a => + Rewrapped SumPositive a + +instance Wrapped SumPositive where + type Unwrapped SumPositive = Positive + _Wrapped' = + iso + (\(SumPositive x) -> x) + SumPositive + +instance Semigroup SumPositive where + SumPositive (Positive x) <> SumPositive (Positive y) = + SumPositive (Positive (x + y)) + +newtype MaxPositive = + MaxPositive + Positive + deriving (Eq, Ord, Show) + +instance HasPositive MaxPositive where + positive = + _Wrapped . positive + +instance AsPositive MaxPositive where + _Positive = + _Wrapped . _Positive + +instance MaxPositive ~ a => + Rewrapped MaxPositive a + +instance Wrapped MaxPositive where + type Unwrapped MaxPositive = Positive + _Wrapped' = + iso + (\(MaxPositive x) -> x) + MaxPositive + +instance Semigroup MaxPositive where + MaxPositive (Positive x) <> MaxPositive (Positive y) = + MaxPositive (Positive (x `max` y)) + +newtype MinPositive = + MinPositive + Positive + deriving (Eq, Ord, Show) + +instance HasPositive MinPositive where + positive = + _Wrapped . positive + +instance AsPositive MinPositive where + _Positive = + _Wrapped . _Positive + +instance MinPositive ~ a => + Rewrapped MinPositive a + +instance Wrapped MinPositive where + type Unwrapped MinPositive = Positive + _Wrapped' = + iso + (\(MinPositive x) -> x) + MinPositive + +instance Semigroup MinPositive where + MinPositive (Positive x) <> MinPositive (Positive y) = + MinPositive (Positive (x `min` y)) + +one :: + Prism' + Positive + () +one = + prism' + (\() -> Positive 1) + (\(Positive n) -> if n == 1 then Just () else Nothing) + +one' :: + Positive +one' = + one # () + +successor1 :: + Prism' + Positive + Positive +successor1 = + prism' + (\(Positive n) -> Positive (n + 1)) + (\(Positive n) -> if n == 1 then Nothing else Just (Positive (n - 1))) + +successor1' :: + Positive + -> Positive +successor1' = + (successor1 #) + +successorW :: + Iso' + Natural + Positive +successorW = + iso + (\(Natural n) -> Positive (n + 1)) + (\(Positive n) -> Natural (n - 1)) + +notZero :: + Prism' + Natural + Positive +notZero = + prism' + (\(Positive n) -> Natural n) + (\(Natural n) -> if n == 0 then Nothing else Just (Positive n)) + +length1 :: + Foldable1 f => + f a + -> Positive +length1 x = + foldMap1 (const (SumPositive one')) x ^. _Wrapped + +replicate1 :: + Positive + -> a + -> NonEmpty a +replicate1 n a = + take1 n (a :| repeat a) + +take1 :: + Positive + -> NonEmpty a + -> NonEmpty a +take1 n (h:|t) = + h :| take (successorW # n) t + +drop1 :: + Positive + -> NonEmpty a + -> [a] +drop1 n (_:|t) = + drop (successorW # n) t + +splitAt1 :: + Positive + -> NonEmpty a + -> (NonEmpty a, [a]) +splitAt1 n x = + (take1 n x, drop1 n x) + +(!!!) :: + NonEmpty a + -> Positive + -> Maybe a +(_:|t) !!! n = + t !! (successorW # n) + +findIndices1 :: + (a -> Bool) + -> NonEmpty a + -> [Positive] +findIndices1 p x = + map snd (NonEmpty.filter (p . fst) (NonEmpty.zip x (NonEmpty.iterate successor1' one'))) + +findIndex1 :: + (a -> Bool) + -> NonEmpty a + -> Maybe Positive +findIndex1 p = + listToMaybe . findIndices1 p + +elemIndices1 :: + Eq a => + a + -> NonEmpty a + -> [Positive] +elemIndices1 = + findIndices1 . (==) + +elemIndex1 :: + Eq a => + a + -> NonEmpty a + -> Maybe Positive +elemIndex1 = + findIndex1 . (==) + +minus1 :: + Positive + -> Positive + -> Positive +minus1 (Positive x) (Positive y) = + Positive (if x < y then 1 else x - y) + +list1 :: + Iso' + Positive + (NonEmpty ()) +list1 = + iso + (\n -> replicate1 n ()) + length1