natural (empty) → 0.1.0.0
raw patch · 6 files changed
+403/−0 lines, 6 filesdep +QuickCheckdep +basedep +checkerssetup-changed
Dependencies added: QuickCheck, base, checkers, hedgehog, lens, natural, tasty, tasty-hedgehog, tasty-hunit, tasty-quickcheck, transformers
Files
- LICENCE +31/−0
- Setup.hs +2/−0
- changelog.md +4/−0
- natural.cabal +51/−0
- src/Natural.hs +313/−0
- test/Tests.hs +2/−0
+ LICENCE view
@@ -0,0 +1,31 @@+Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of QFPL nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,4 @@+0.1.0.0++* This change log starts.+* The initial version of natural.
+ natural.cabal view
@@ -0,0 +1,51 @@+-- documentation, see http://haskell.org/cabal/users-guide/++name: natural+version: 0.1.0.0+synopsis: Natural number+description: + <<http://i.imgur.com/uZnp9ke.png>>+ .+ Natural number+license: BSD3+license-file: LICENCE+author: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright: Copyright (C) 2018 Commonwealth Scientific and Industrial Research Organisation (CSIRO)+category: Control+build-type: Simple+extra-source-files: changelog.md+cabal-version: >=1.10+homepage: https://github.com/qfpl/natural+bug-reports: https://github.com/qfpl/natural/issues+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1++source-repository head+ type: git+ location: git@github.com:qfpl/natural.git++library+ exposed-modules: Natural+ build-depends: base >=4.8 && <4.11+ , lens >=4.15 && < 4.17+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite tests+ build-depends: QuickCheck >=2.9.2 && <2.12+ , base >=4.8 && <4.11+ , checkers >=0.4.6 && <0.5+ , natural+ , hedgehog >=0.5 && <0.6+ , lens >=4.15 && <4.17+ , tasty >=0.11 && <1.1+ , tasty-hunit >=0.9 && <0.11+ , tasty-hedgehog >= 0.1 && <0.3+ , tasty-quickcheck >=0.8.4 && <0.11+ , transformers >=0.4.1 && <5.5+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Natural.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module Natural(+ Natural+, HasNatural(..)+, AsNatural(..)+, ProductNatural(..)+, MaxNatural(..)+, MinNatural(..)+, zero+, zero'+, successor+, successor'+, length+, replicate+, take+, drop+, splitAt+, (!!)+, findIndices+, findIndex+, elemIndices+, elemIndex+) where++import Control.Applicative(Const)+import Control.Category((.), id)+import Control.Lens(Wrapped(_Wrapped', Unwrapped), Rewrapped, Prism', Lens', (^?), ( # ), _Wrapped, prism', iso)+import Control.Monad((>>=))+import Data.Bool(Bool)+import Data.Eq(Eq((==)))+import Data.Foldable(Foldable(foldl))+import Data.Function(const)+import Data.Functor.Identity(Identity)+import Data.Int(Int)+import Data.List(iterate, zip, filter, map, repeat)+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.Tuple(fst, snd)+import Data.Word(Word)+import Prelude(Show, Integral, Integer, (-), (+), (*), fromIntegral)++newtype Natural =+ Natural+ Integer+ deriving (Eq, Ord, Show)++instance Semigroup Natural where+ Natural x <> Natural y =+ Natural (x + y)++instance Monoid Natural where+ mappend =+ (<>)+ mempty =+ Natural 0++class HasNatural a where+ natural ::+ Lens'+ a+ Natural++instance HasNatural Natural where+ natural =+ id++class AsNatural a where+ _Natural ::+ Prism'+ a+ Natural++instance AsNatural Natural where+ _Natural =+ id++integralPrism ::+ Integral a =>+ Prism'+ a+ Natural+integralPrism =+ prism'+ (\(Natural n) -> fromIntegral n)+ (\n -> if n < 0 then Nothing else Just (Natural (fromIntegral n)))++instance AsNatural Int where+ _Natural =+ integralPrism++instance AsNatural Integer where+ _Natural =+ integralPrism++instance AsNatural Word where+ _Natural =+ integralPrism++instance Integral a => AsNatural (Const a b) where+ _Natural =+ integralPrism++instance Integral a => AsNatural (Identity a) where+ _Natural =+ integralPrism++newtype ProductNatural =+ ProductNatural+ Natural+ deriving (Eq, Ord, Show)++instance HasNatural ProductNatural where+ natural =+ _Wrapped . natural++instance AsNatural ProductNatural where+ _Natural =+ _Wrapped . _Natural++instance ProductNatural ~ a =>+ Rewrapped ProductNatural a+ +instance Wrapped ProductNatural where+ type Unwrapped ProductNatural = Natural+ _Wrapped' =+ iso+ (\(ProductNatural x) -> x)+ ProductNatural++instance Semigroup ProductNatural where+ ProductNatural (Natural x) <> ProductNatural (Natural y) =+ ProductNatural (Natural (x * y))++instance Monoid ProductNatural where+ mappend =+ (<>)+ mempty =+ ProductNatural (Natural 1)++newtype MaxNatural =+ MaxNatural+ Natural+ deriving (Eq, Ord, Show)++instance HasNatural MaxNatural where+ natural =+ _Wrapped . natural++instance AsNatural MaxNatural where+ _Natural =+ _Wrapped . _Natural++instance MaxNatural ~ a =>+ Rewrapped MaxNatural a+ +instance Wrapped MaxNatural where+ type Unwrapped MaxNatural = Natural+ _Wrapped' =+ iso+ (\(MaxNatural x) -> x)+ MaxNatural++instance Semigroup MaxNatural where+ MaxNatural (Natural x) <> MaxNatural (Natural y) =+ MaxNatural (Natural (x `max` y))++newtype MinNatural =+ MinNatural+ Natural+ deriving (Eq, Ord, Show)++instance HasNatural MinNatural where+ natural =+ _Wrapped . natural++instance AsNatural MinNatural where+ _Natural =+ _Wrapped . _Natural++instance MinNatural ~ a =>+ Rewrapped MinNatural a+ +instance Wrapped MinNatural where+ type Unwrapped MinNatural = Natural+ _Wrapped' =+ iso+ (\(MinNatural x) -> x)+ MinNatural++instance Semigroup MinNatural where+ MinNatural (Natural x) <> MinNatural (Natural y) =+ MinNatural (Natural (x `min` y))++zero ::+ Prism'+ Natural+ ()+zero =+ prism'+ (\() -> Natural 0)+ (\(Natural n) -> if n == 0 then Nothing else Just ())++zero' ::+ Natural+zero' =+ zero # ()++successor ::+ Prism'+ Natural+ Natural+successor =+ prism'+ (\(Natural n) -> Natural (n + 1))+ (\(Natural n) -> if n == 0 then Nothing else Just (Natural (n - 1)))++successor' ::+ Natural+ -> Natural+successor' =+ (successor #)++length ::+ Foldable f =>+ f a+ -> Natural+length =+ foldl (const . successor') zero'++replicate ::+ Natural+ -> a+ -> [a]+replicate n =+ take n . repeat++take ::+ Natural+ -> [a]+ -> [a]+take _ [] =+ []+take n (h:t) =+ case n ^? successor of+ Nothing ->+ []+ Just p ->+ h : take p t++drop ::+ Natural+ -> [a]+ -> [a]+drop _ [] =+ []+drop n (h:t) =+ case n ^? successor of+ Nothing ->+ h:t+ Just p ->+ drop p t++splitAt ::+ Natural+ -> [a]+ -> ([a], [a])+splitAt n x =+ (take n x, drop n x)++(!!) ::+ [a]+ -> Natural+ -> Maybe a+[] !! _ =+ Nothing+(_:t) !! n =+ (n ^? successor) >>= (t !!)++findIndices ::+ (a -> Bool)+ -> [a]+ -> [Natural]+findIndices p x =+ map snd (filter (p . fst) (zip x (iterate successor' zero')))++findIndex ::+ (a -> Bool)+ -> [a]+ -> Maybe Natural+findIndex p =+ listToMaybe . findIndices p++elemIndices ::+ Eq a =>+ a+ -> [a]+ -> [Natural]+elemIndices =+ findIndices . (==)++elemIndex ::+ Eq a =>+ a+ -> [a]+ -> Maybe Natural+elemIndex =+ findIndex . (==)
+ test/Tests.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "test"