diff --git a/Data/List/Fair.hs b/Data/List/Fair.hs new file mode 100644 --- /dev/null +++ b/Data/List/Fair.hs @@ -0,0 +1,28 @@ +module Data.List.Fair (Fair (..)) where + +import Control.Applicative +import Data.Foldable +import Data.Functor.Classes +import Numeric.Natural +import Util + +newtype Fair a = Fair { unFair :: [a] } + deriving (Functor, Foldable, Traversable, Eq, Ord, Read, Show, Eq1, Ord1, Read1, Show1) + +instance Applicative Fair where + pure a = Fair [a] + fs <*> xs = fs >>= (<$> xs) + +instance Monad Fair where + Fair xs >>= f = Fair $ [0..] >>= flip diag (unFair . f <$> xs) + +diag :: Natural -> [[a]] -> [a] +diag _ [] = [] +diag 0 _ = [] +diag k (as:ass) = toList (as !!? k) ++ diag (k-1) ass + +instance Semigroup a => Semigroup (Fair a) where + (<>) = liftA2 (<>) + +instance Monoid a => Monoid (Fair a) where + mempty = pure mempty diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright M Farkas-Dyck © 2019 + +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 M Farkas-Dyck 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# fair diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Criterion.Main + +main :: IO () +main = defaultMain [] diff --git a/fair.cabal b/fair.cabal new file mode 100644 --- /dev/null +++ b/fair.cabal @@ -0,0 +1,102 @@ +name: fair +version: 0.1.0.0 +synopsis: Lists with fair choice +-- description: +license: BSD3 +license-file: LICENSE +author: M Farkas-Dyck +maintainer: strake888@gmail.com +copyright: 2019 M Farkas-Dyck +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: . + exposed-modules: Data.List.Fair + build-depends: base >= 4.7 && < 5 + , util >= 0.1.2 && < 0.2 + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , EmptyCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , MonadComprehensions + , StandaloneDeriving + , GeneralizedNewtypeDeriving + , DeriveFunctor, DeriveFoldable, DeriveTraversable + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + -Werror=missing-fields + -Werror=missing-methods + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >=4.11 && <5 + , smallcheck >=1.1.4 + , tasty >=1.0 + , tasty-smallcheck >=0.8 + , fair + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , EmptyCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , MonadComprehensions + , StandaloneDeriving + , DeriveFunctor, DeriveFoldable, DeriveTraversable + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + -Werror=missing-fields + -Werror=missing-methods + +benchmark bench + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + build-depends: base >=4.11 && <5 + , criterion >=1.4.1 + , fair + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , EmptyCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , MonadComprehensions + , StandaloneDeriving + , DeriveFunctor, DeriveFoldable, DeriveTraversable + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns + -Werror=incomplete-record-updates + -Werror=missing-fields + -Werror=missing-methods + +source-repository head + type: git + location: https://github.com/strake/fair.hs diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Test.SmallCheck +import Test.Tasty +import Test.Tasty.SmallCheck + +main :: IO () +main = defaultMain $ testGroup "" []