notzero (empty) → 0.0.1
raw patch · 8 files changed
+518/−0 lines, 8 filesdep +QuickCheckdep +basedep +bifunctorsbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, bifunctors, directory, doctest, filepath, lens, mtl, semigroupoids, semigroups, template-haskell, transformers
Files
- LICENSE +27/−0
- Setup.lhs +44/−0
- changelog +4/−0
- notzero.cabal +77/−0
- src/Data/AccNotZeroOr.hs +113/−0
- src/Data/NotZero.hs +42/−0
- src/Data/NotZeroOr.hs +179/−0
- test/doctests.hs +32/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2015 NICTA Limited++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.lhs view
@@ -0,0 +1,44 @@+#!/usr/bin/env runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+ let dir = autogenModulesDir lbi+ createDirectoryIfMissingVerbose verbosity True dir+ withLibLBI pkg lbi $ \_ libcfg -> do+ withTestLBI pkg lbi $ \suite suitecfg -> do+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+ [ "module Build_" ++ testName suite ++ " where"+ , "deps :: [String]"+ , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+ ]+ where+ formatdeps = map (formatone . snd)+ formatone p = case packageName p of+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
+ changelog view
@@ -0,0 +1,4 @@+0.0.1++Initial version+
+ notzero.cabal view
@@ -0,0 +1,77 @@+name: notzero+version: 0.0.1+license: BSD3+license-file: LICENSE+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+copyright: Copyright (C) 2015 NICTA Limited+synopsis: A data type for representing numeric values, except zero.+category: Data, Numeric+description: + <<http://i.imgur.com/Ns5hntl.jpg>>+ .+ A data type for representing numeric values, except zero. This might be useful in working with process exit codes.+homepage: https://github.com/NICTA/notzero+bug-reports: https://github.com/NICTA/notzero/issues+cabal-version: >= 1.10+build-type: Custom+extra-source-files: changelog++source-repository head+ type: git+ location: git@github.com:NICTA/notzero.git++flag small_base+ description: Choose the new, split-up base package.++library+ default-language:+ Haskell2010++ build-depends:+ base >= 3 && < 5+ , mtl >= 2.0 && < 2.3+ , semigroups >= 0.8+ , semigroupoids >= 4.0+ , bifunctors >= 3.0+ , lens >= 4.0 && < 5+ , transformers >= 0.3 && < 0.5++ ghc-options:+ -Wall++ default-extensions:+ NoImplicitPrelude++ hs-source-dirs:+ src++ exposed-modules:+ Data.AccNotZeroOr+ Data.NotZero+ Data.NotZeroOr++test-suite doctests+ type:+ exitcode-stdio-1.0++ main-is:+ doctests.hs++ default-language:+ Haskell2010++ build-depends:+ base < 5 && >= 3+ , doctest >= 0.9.7+ , filepath >= 1.3+ , directory >= 1.1+ , QuickCheck >= 2.0+ , template-haskell >= 2.8++ ghc-options:+ -Wall+ -threaded++ hs-source-dirs:+ test
+ src/Data/AccNotZeroOr.hs view
@@ -0,0 +1,113 @@+module Data.AccNotZeroOr(+ AccNotZeroOr(..)+, _IsAccNotZero+, _OrAccNotZero+, isoAccNotZeroOr+, OneNotZeroOr+, isoOneNotZeroOr+, isoOneNotZeroOrNumber+, isoOneNotZeroOrT+) where++import Control.Applicative(Applicative(pure, (<*>)))+import Control.Category(Category((.)))+import Control.Lens(Prism, prism, Iso, iso)+import Data.Either(Either(Left, Right))+import Data.Eq(Eq)+import Data.Functor.Alt+import Data.Functor.Identity(Identity(Identity))+import Data.NotZero(NotZero)+import Data.NotZeroOr(NotZeroOr(IsNotZero, OrNotZero), NotZeroOrT, isoNumber, isoNotZeroOrT)+import Prelude(Num)++data AccNotZeroOr f a x =+ IsAccNotZero (f (NotZero a))+ | OrAccNotZero x++_IsAccNotZero ::+ Prism (AccNotZeroOr f a x) (AccNotZeroOr f b x) (f (NotZero a)) (f (NotZero b))+_IsAccNotZero =+ prism+ IsAccNotZero+ (\z -> case z of+ IsAccNotZero o ->+ Right o+ OrAccNotZero x ->+ Left (OrAccNotZero x))++_OrAccNotZero ::+ Prism (AccNotZeroOr f a x) (AccNotZeroOr f a y) x y+_OrAccNotZero =+ prism+ OrAccNotZero+ (\z -> case z of+ IsAccNotZero o ->+ Left (IsAccNotZero o)+ OrAccNotZero x ->+ Right x)++isoAccNotZeroOr ::+ Iso (AccNotZeroOr f a x) (AccNotZeroOr g a x) (Either (f (NotZero a)) x) (Either (g (NotZero a)) x)+isoAccNotZeroOr =+ iso+ (\z -> case z of+ IsAccNotZero o ->+ Left o+ OrAccNotZero x ->+ Right x)+ (\e -> case e of+ Left o ->+ IsAccNotZero o+ Right x ->+ OrAccNotZero x)++type OneNotZeroOr a x =+ AccNotZeroOr Identity a x++isoOneNotZeroOr ::+ Iso (OneNotZeroOr a x) (OneNotZeroOr b y) (NotZeroOr a x) (NotZeroOr b y) +isoOneNotZeroOr =+ iso+ (\z -> case z of+ IsAccNotZero (Identity o) ->+ IsNotZero o+ OrAccNotZero x ->+ OrNotZero x)+ (\z -> case z of+ IsNotZero o ->+ IsAccNotZero (Identity o)+ OrNotZero x ->+ OrAccNotZero x)++isoOneNotZeroOrNumber ::+ (Eq a, Num a) =>+ Iso (OneNotZeroOr a ()) (OneNotZeroOr a ()) a a+isoOneNotZeroOrNumber =+ isoOneNotZeroOr . isoNumber++isoOneNotZeroOrT ::+ Iso (OneNotZeroOr a x) (OneNotZeroOr b y) (NotZeroOrT a Identity x) (NotZeroOrT b Identity y)+isoOneNotZeroOrT =+ isoOneNotZeroOr . isoNotZeroOrT++instance Functor f => Functor (AccNotZeroOr f a) where+ fmap _ (IsAccNotZero z) =+ IsAccNotZero z+ fmap f (OrAccNotZero x) =+ OrAccNotZero (f x)++instance Alt f => Apply (AccNotZeroOr f a) where+ IsAccNotZero z1 <.> IsAccNotZero z2 =+ IsAccNotZero (z1 <!> z2)+ IsAccNotZero z1 <.> OrAccNotZero _ =+ IsAccNotZero z1+ OrAccNotZero _ <.> IsAccNotZero z2 =+ IsAccNotZero z2+ OrAccNotZero f <.> OrAccNotZero a =+ OrAccNotZero (f a)+ +instance Alt f => Applicative (AccNotZeroOr f a) where+ pure =+ OrAccNotZero+ (<*>) =+ (<.>)
+ src/Data/NotZero.hs view
@@ -0,0 +1,42 @@+module Data.NotZero(+ NotZero+, getNotZero+, notZero+) where++import Control.Lens(Prism', prism')+import Data.Monoid(Monoid(mappend, mempty))+import Data.Semigroup(Semigroup((<>)))+import Data.Bool(bool)+import Data.Eq(Eq((==)))+import Data.Maybe(Maybe(Just, Nothing))+import Data.Ord(Ord)+import Prelude(Num((*)), Show)++newtype NotZero a =+ NotZero a+ deriving (Eq, Ord, Show)++getNotZero ::+ NotZero a+ -> a+getNotZero (NotZero a) =+ a++notZero :: + (Eq a, Num a) =>+ Prism' a (NotZero a)+notZero =+ prism'+ getNotZero+ (\a -> bool (Just (NotZero a)) Nothing (a == 0))++instance Num a => Semigroup (NotZero a) where+ NotZero a <> NotZero b = + NotZero (a * b)++instance Num a => Monoid (NotZero a) where+ mappend =+ (<>)+ mempty =+ NotZero 1
+ src/Data/NotZeroOr.hs view
@@ -0,0 +1,179 @@+module Data.NotZeroOr(+ NotZeroOr(..)+, _IsNotZero+, _OrNotZero+, isoNotZeroOr+, Number+, getNumber+, isoNumber+, NotZeroOrT(..)+, isoNotZeroOrT+) where++import Control.Applicative(Applicative(pure, (<*>)), liftA2)+import Control.Category(Category((.)))+import Control.Lens(Prism, prism, Iso, iso, (^?))+import Control.Monad(Monad(return, (>>=)))+import Control.Monad.Trans.Class(MonadTrans(lift))+import Data.Either(Either(Left, Right))+import Data.Eq(Eq)+import Data.Functor(Functor(fmap))+import Data.Functor.Apply(Apply((<.>)), liftF2)+import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Bind.Trans(BindTrans(liftB))+import Data.Functor.Identity(Identity(Identity))+import Data.Maybe(Maybe(Nothing, Just))+import Data.NotZero(NotZero, notZero, getNotZero)+import Data.Ord(Ord)+import Prelude(Show, Num)++data NotZeroOr a x =+ IsNotZero (NotZero a)+ | OrNotZero x+ deriving (Eq, Ord, Show)++_IsNotZero ::+ Prism (NotZeroOr a x) (NotZeroOr b x) (NotZero a) (NotZero b)+_IsNotZero =+ prism+ IsNotZero+ (\z -> case z of+ IsNotZero o ->+ Right o+ OrNotZero x ->+ Left (OrNotZero x))++_OrNotZero ::+ Prism (NotZeroOr a x) (NotZeroOr a y) x y+_OrNotZero =+ prism+ OrNotZero+ (\z -> case z of+ IsNotZero o ->+ Left (IsNotZero o)+ OrNotZero x ->+ Right x)++isoNotZeroOr ::+ Iso (NotZeroOr a x) (NotZeroOr a x) (Either (NotZero a) x) (Either (NotZero a) x)+isoNotZeroOr =+ iso+ (\z -> case z of+ IsNotZero o ->+ Left o+ OrNotZero x ->+ Right x)+ (\e -> case e of+ Left o ->+ IsNotZero o+ Right x ->+ OrNotZero x)++type Number a =+ NotZeroOr a ()++getNumber ::+ Num a =>+ Number a+ -> a+getNumber (IsNotZero o) =+ getNotZero o+getNumber (OrNotZero ()) =+ 0++isoNumber ::+ (Eq a, Num a) =>+ Iso (Number a) (Number a) a a+isoNumber =+ iso+ getNumber+ (\a -> case a ^? notZero of+ Nothing -> OrNotZero ()+ Just z -> IsNotZero z)++instance Functor (NotZeroOr a) where+ fmap _ (IsNotZero z) =+ IsNotZero z+ fmap f (OrNotZero x) =+ OrNotZero (f x)++instance Apply (NotZeroOr a) where+ IsNotZero z <.> _ =+ IsNotZero z+ OrNotZero _ <.> IsNotZero z =+ IsNotZero z+ OrNotZero f <.> OrNotZero a =+ OrNotZero (f a)++instance Applicative (NotZeroOr a) where+ pure =+ OrNotZero+ (<*>) =+ (<.>)++instance Bind (NotZeroOr a) where+ IsNotZero z >>- _ =+ IsNotZero z+ OrNotZero x >>- f =+ f x++instance Monad (NotZeroOr a) where+ return =+ pure+ (>>=) =+ (>>-)++newtype NotZeroOrT a f x =+ NotZeroOrT (f (NotZeroOr a x))++isoNotZeroOrT ::+ Iso (NotZeroOr a x) (NotZeroOr b y) (NotZeroOrT a Identity x) (NotZeroOrT b Identity y)+isoNotZeroOrT =+ iso+ (NotZeroOrT . Identity)+ (\(NotZeroOrT (Identity x)) -> x)++instance Functor f => Functor (NotZeroOrT a f) where+ fmap f (NotZeroOrT q) =+ NotZeroOrT (fmap (fmap f) q)++instance Apply f => Apply (NotZeroOrT a f) where+ NotZeroOrT f <.> NotZeroOrT a =+ NotZeroOrT (liftF2 (<*>) f a)++instance Applicative f => Applicative (NotZeroOrT a f) where+ pure =+ NotZeroOrT . pure . pure+ NotZeroOrT f <*> NotZeroOrT a =+ NotZeroOrT (liftA2 (<*>) f a)++bind ::+ Monad f =>+ NotZeroOrT a f x ->+ (x -> NotZeroOrT a f y)+ -> NotZeroOrT a f y+NotZeroOrT q `bind` f =+ NotZeroOrT (q >>= \n -> case n of+ IsNotZero z ->+ return (IsNotZero z)+ OrNotZero x ->+ let NotZeroOrT r = f x+ in r)++instance (Apply f, Monad f) => Bind (NotZeroOrT a f) where+ (>>-) =+ bind++instance Monad f => Monad (NotZeroOrT a f) where+ return =+ NotZeroOrT . return . return+ (>>=) =+ bind++instance BindTrans (NotZeroOrT a) where+ liftB =+ NotZeroOrT . fmap OrNotZero++instance MonadTrans (NotZeroOrT a) where+ lift =+ NotZeroOrT . fmap OrNotZero
+ test/doctests.hs view
@@ -0,0 +1,32 @@+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++main ::+ IO ()+main =+ getSources >>= \sources -> doctest $+ "-isrc"+ : "-idist/build/autogen"+ : "-optP-include"+ : "-optPdist/build/autogen/cabal_macros.h"+ : "-hide-all-packages"+ : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+ where+ go dir = do+ (dirs, files) <- getFilesAndDirectories dir+ (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c