minlen (empty) → 0.1.0.0
raw patch · 6 files changed
+574/−0 lines, 6 filesdep +basedep +mono-traversabledep +semigroupssetup-changed
Dependencies added: base, mono-traversable, semigroups, transformers
Files
- ChangeLog.md +3/−0
- LICENSE +20/−0
- README.md +5/−0
- Setup.hs +2/−0
- minlen.cabal +26/−0
- src/Data/MinLen.hs +518/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Michael Snoyman, http://www.fpcomplete.com/++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.
+ README.md view
@@ -0,0 +1,5 @@+## minlen++Express the minimum length of a container in its type.++Originally part of mono-traversable, split out into its own package.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ minlen.cabal view
@@ -0,0 +1,26 @@+name: minlen+version: 0.1.0.0+synopsis: Express the minimum length of a container in its type+description: Please see README.md+homepage: https://github.com/snoyberg/mono-traversable#readme+license: MIT+license-file: LICENSE+author: Michael Snoyman+maintainer: michael@snoyman.com+category: Data+build-type: Simple+extra-source-files: README.md ChangeLog.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.MinLen+ build-depends: base >= 4.7 && < 5+ , mono-traversable+ , semigroups+ , transformers+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/snoyberg/mono-traversable
+ src/Data/MinLen.hs view
@@ -0,0 +1,518 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.MinLen+ ( -- * Type level naturals+ -- ** Peano numbers+ -- $peanoNumbers+ Zero (..)+ , Succ (..)+ , TypeNat (..)+ , AddNat+ , MaxNat+ -- * Minimum length newtype wrapper+ , MinLen+ , unMinLen+ , toMinLenZero+ , toMinLen+ , unsafeToMinLen+ , mlcons+ , mlappend+ , mlunion+ , head+ , last+ , tailML+ , initML+ , GrowingAppend+ , ofoldMap1+ , ofold1+ , ofoldr1+ , ofoldl1'+ , maximum+ , minimum+ , maximumBy+ , minimumBy+ ) where++import Prelude (Num (..), Maybe (..), Int, Ordering (..), Eq, Ord (..), Read, Show, Functor (..), ($), flip, const)+import Data.Data (Data)+import Data.Typeable (Typeable)+import Control.Category+import Data.MonoTraversable+import Data.Sequences+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup (..))+#if !MIN_VERSION_base(4,8,0)+import Control.Monad (liftM)+#endif+import Control.Monad.Trans.State.Strict (evalState, state)++-- $peanoNumbers+-- <https://wiki.haskell.org/Peano_numbers Peano numbers> are a simple way to+-- represent natural numbers (0, 1, 2...) using only a 'Zero' value and a+-- successor function ('Succ'). Each application of 'Succ' increases the number+-- by 1, so @Succ Zero@ is 1, @Succ (Succ Zero)@ is 2, etc.++-- | 'Zero' is the base value for the Peano numbers.+data Zero = Zero++-- | 'Succ' represents the next number in the sequence of natural numbers.+--+-- It takes a @nat@ (a natural number) as an argument.+--+-- 'Zero' is a @nat@, allowing @'Succ' 'Zero'@ to represent 1.+--+-- 'Succ' is also a @nat@, so it can be applied to itself, allowing+-- @'Succ' ('Succ' 'Zero')@ to represent 2,+-- @'Succ' ('Succ' ('Succ' 'Zero'))@ to represent 3, and so on.+data Succ nat = Succ nat++-- | Type-level natural number utility typeclass+class TypeNat nat where+ -- | Turn a type-level natural number into a number+ --+ -- @+ -- > 'toValueNat' 'Zero'+ -- 0+ -- > 'toValueNat' ('Succ' ('Succ' ('Succ' 'Zero')))+ -- 3+ -- @+ toValueNat :: Num i => nat -> i++ -- | Get a data representation of a natural number type+ --+ -- @+ -- > 'typeNat' :: 'Succ' ('Succ' 'Zero')+ -- Succ (Succ Zero) -- Errors because Succ and Zero have no Show typeclass,+ -- -- But this is what it would look like if it did.+ -- @+ typeNat :: nat++instance TypeNat Zero where+ toValueNat Zero = 0+ typeNat = Zero+instance TypeNat nat => TypeNat (Succ nat) where+ toValueNat (Succ nat) = 1 + toValueNat nat+ typeNat = Succ typeNat++-- | Adds two type-level naturals.+--+-- See the 'mlappend' type signature for an example.+--+-- @+-- > :t 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero')+--+-- 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero')+-- :: 'Succ' ('Succ' ('Succ' 'Zero'))+-- @+type family AddNat x y+type instance AddNat Zero y = y+type instance AddNat (Succ x) y = AddNat x (Succ y)++-- | Calculates the maximum of two type-level naturals.+--+-- See the 'mlunion' type signature for an example.+--+-- @+-- > :t 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero')+--+-- 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero')+-- :: 'Succ' ('Succ' 'Zero')+-- @+type family MaxNat x y+type instance MaxNat Zero y = y+type instance MaxNat x Zero = x+type instance MaxNat (Succ x) (Succ y) = Succ (MaxNat x y)++-- | A wrapper around a container which encodes its minimum length in the type system.+-- This allows functions like 'head' and 'maximum' to be made safe without using 'Maybe'.+--+-- The length, @nat@, is encoded as a <https://wiki.haskell.org/Peano_numbers Peano number>,+-- which starts with the 'Zero' constructor and is made one larger with each application+-- of 'Succ' ('Zero' for 0, @'Succ' 'Zero'@ for 1, @'Succ' ('Succ' 'Zero')@ for 2, etc.).+-- Functions which require at least one element, then, are typed with @Succ nat@,+-- where @nat@ is either 'Zero' or any number of applications of 'Succ':+--+-- @+-- 'head' :: 'MonoTraversable' mono => 'MinLen' ('Succ' nat) mono -> 'Element' mono+-- @+--+-- The length is also a <https://wiki.haskell.org/Phantom_type phantom type>,+-- i.e. it is only used on the left hand side of the type and doesn't exist at runtime.+-- Notice how @'Succ' 'Zero'@ isn't included in the printed output:+--+-- @+-- > 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- 'Just' ('MinLen' {unMinLen = [1,2,3]})+-- @+--+-- You can still use GHCI's @:i@ command to see the phantom type information:+--+-- @+-- > let xs = 'mlcons' 1 $ 'toMinLenZero' []+-- > :i xs+-- xs :: 'Num' t => 'MinLen' ('Succ' 'Zero') [t]+-- @+newtype MinLen nat mono =+ MinLen {+ unMinLen :: mono -- ^ Get the monomorphic container out of a 'MinLen' wrapper.+ } deriving (Eq, Ord, Read, Show, Data, Typeable)++type instance Element (MinLen nat mono) = Element mono+deriving instance MonoFunctor mono => MonoFunctor (MinLen nat mono)+deriving instance MonoFoldable mono => MonoFoldable (MinLen nat mono)+instance MonoTraversable mono => MonoTraversable (MinLen nat mono) where+ otraverse f (MinLen x) = fmap MinLen (otraverse f x)+ {-# INLINE otraverse #-}+#if !MIN_VERSION_base(4,8,0)+ omapM f (MinLen x) = liftM MinLen (omapM f x)+ {-# INLINE omapM #-}+#endif+deriving instance GrowingAppend mono => GrowingAppend (MinLen nat mono)++-- | This function is unsafe, and must not be exposed from this module.+unsafeMap :: (mono -> mono) -> MinLen nat mono -> MinLen nat mono+unsafeMap f (MinLen x) = MinLen (f x)++instance (Semigroup mono, GrowingAppend mono) => Semigroup (MinLen nat mono) where+ MinLen x <> MinLen y = MinLen (x <> y)++instance SemiSequence seq => SemiSequence (MinLen nat seq) where+ type Index (MinLen nat seq) = Index seq++ intersperse e = unsafeMap $ intersperse e+ reverse = unsafeMap reverse+ find f = find f . unMinLen+ cons x = unsafeMap $ cons x+ snoc xs x = unsafeMap (flip snoc x) xs+ sortBy f = unsafeMap $ sortBy f++instance MonoPointed mono => MonoPointed (MinLen Zero mono) where+ opoint = MinLen . opoint+ {-# INLINE opoint #-}+instance MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) where+ opoint = MinLen . opoint+ {-# INLINE opoint #-}++-- | Get the 'typeNat' of a 'MinLen' container.+natProxy :: TypeNat nat => MinLen nat mono -> nat+natProxy _ = typeNat++-- | Types a container as having a minimum length of zero. This is useful when combined with other 'MinLen'+-- functions that increase the size of the container.+--+-- ==== __Examples__+--+-- @+-- > 1 \`mlcons` 'toMinLenZero' []+-- 'MinLen' {unMinLen = [1]}+-- @+toMinLenZero :: (MonoFoldable mono) => mono -> MinLen Zero mono+toMinLenZero = MinLen++-- | Attempts to add a 'MinLen' constraint to a monomorphic container.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- > xs+-- 'Just' ('MinLen' {unMinLen = [1,2,3]})+--+-- > :i xs+-- xs :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- @+--+-- @+-- > 'toMinLen' [] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- 'Nothing'+-- @+toMinLen :: (MonoFoldable mono, TypeNat nat) => mono -> Maybe (MinLen nat mono)+toMinLen mono =+ case ocompareLength mono (toValueNat nat :: Int) of+ LT -> Nothing+ _ -> Just res'+ where+ nat = natProxy res'+ res' = MinLen mono++-- | __Unsafe__+--+-- Although this function itself cannot cause a segfault, it breaks the+-- safety guarantees of 'MinLen' and can lead to a segfault when using+-- otherwise safe functions.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'unsafeToMinLen' [] :: 'MinLen' ('Succ' 'Zero') ['Int']+-- > 'olength' xs+-- 0+-- > 'head' xs+-- *** Exception: Data.MonoTraversable.headEx: empty+-- @+unsafeToMinLen :: mono -> MinLen nat mono+unsafeToMinLen = MinLen++infixr 5 `mlcons`++-- | Adds an element to the front of a list, increasing its minimum length by 1.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int']+-- > 0 \`mlcons` xs+-- 'MinLen' {unMinLen = [0,1,2,3]}+-- @+mlcons :: IsSequence seq => Element seq -> MinLen nat seq -> MinLen (Succ nat) seq+mlcons e (MinLen seq) = MinLen (cons e seq)+{-# INLINE mlcons #-}++-- | Concatenate two sequences, adding their minimum lengths together.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int']+-- > xs \`mlappend` xs+-- 'MinLen' {unMinLen = [1,2,3,1,2,3]}+-- @+mlappend :: IsSequence seq => MinLen x seq -> MinLen y seq -> MinLen (AddNat x y) seq+mlappend (MinLen x) (MinLen y) = MinLen (x `mappend` y)+{-# INLINE mlappend #-}++-- | Return the first element of a monomorphic container.+--+-- Safe version of 'headEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+head :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono+head = headEx . unMinLen+{-# INLINE head #-}++-- | Return the last element of a monomorphic container.+--+-- Safe version of 'lastEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+last :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono+last = lastEx . unMinLen+{-# INLINE last #-}++-- | Returns all but the first element of a sequence, reducing its 'MinLen' by 1.+--+-- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- > 'fmap' 'tailML' xs+-- 'Just' ('MinLen' {unMinLen = [2,3]})+-- @+tailML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq+tailML = MinLen . tailEx . unMinLen++-- | Returns all but the last element of a sequence, reducing its 'MinLen' by 1.+--+-- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- > 'fmap' 'initML' xs+-- 'Just' ('MinLen' {unMinLen = [1,2]})+-- @+initML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq+initML = MinLen . initEx . unMinLen++-- | Joins two semigroups, keeping the larger 'MinLen' of the two.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'unsafeToMinLen' [1] :: 'MinLen' ('Succ' 'Zero') ['Int']+-- > let ys = xs \`mlunion` xs+-- > ys+-- 'MinLen' {unMinLen = [1,1]}+--+-- > :i ys+-- ys :: 'MinLen' ('Succ' 'Zero') ['Int']+-- @+mlunion :: (Semigroup mono, GrowingAppend mono) => MinLen x mono -> MinLen y mono -> MinLen (MaxNat x y) mono+mlunion (MinLen x) (MinLen y) = MinLen (x <> y)++-- | Map each element of a monomorphic container to a semigroup, and combine the+-- results.+--+-- Safe version of 'ofoldMap1Ex', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = ("hello", 1 :: 'Integer') \`mlcons` (" world", 2) \`mlcons` ('toMinLenZero' [])+-- > 'ofoldMap1' 'fst' xs+-- "hello world"+-- @+ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> MinLen (Succ nat) mono -> m+ofoldMap1 f = ofoldMap1Ex f . unMinLen+{-# INLINE ofoldMap1 #-}++-- | Join a monomorphic container, whose elements are 'Semigroup's, together.+--+-- Safe, only works on monomorphic containers wrapped in a @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' [])+-- > xs+-- 'MinLen' {unMinLen = ["a","b","c"]}+--+-- > 'ofold1' xs+-- "abc"+-- @+ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => MinLen (Succ nat) mono -> Element mono+ofold1 = ofoldMap1 id+{-# INLINE ofold1 #-}++-- | Right-associative fold of a monomorphic container with no base element.+--+-- Safe version of 'ofoldr1Ex', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+--+-- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@+--+-- ==== __Examples__+--+-- @+-- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' [])+-- > 'ofoldr1' (++) xs+-- "abc"+-- @+ofoldr1 :: MonoFoldable mono+ => (Element mono -> Element mono -> Element mono)+ -> MinLen (Succ nat) mono+ -> Element mono+ofoldr1 f = ofoldr1Ex f . unMinLen+{-# INLINE ofoldr1 #-}++-- | Strict left-associative fold of a monomorphic container with no base+-- element.+--+-- Safe version of 'ofoldl1Ex'', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+--+-- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@+--+-- ==== __Examples__+--+-- @+-- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' [])+-- > 'ofoldl1'' (++) xs+-- "abc"+-- @+ofoldl1' :: MonoFoldable mono+ => (Element mono -> Element mono -> Element mono)+ -> MinLen (Succ nat) mono+ -> Element mono+ofoldl1' f = ofoldl1Ex' f . unMinLen+{-# INLINE ofoldl1' #-}++-- | Get the maximum element of a monomorphic container.+--+-- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- > 'fmap' 'maximum' xs+-- 'Just' 3+-- @+maximum :: (MonoFoldable mono, Ord (Element mono))+ => MinLen (Succ nat) mono+ -> Element mono+maximum = maximumEx . unMinLen+{-# INLINE maximum #-}++-- | Get the minimum element of a monomorphic container.+--+-- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+--+-- ==== __Examples__+--+-- @+-- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int'])+-- > 'fmap' 'minimum' xs+-- 'Just' 1+-- @+minimum :: (MonoFoldable mono, Ord (Element mono))+ => MinLen (Succ nat) mono+ -> Element mono+minimum = minimumEx . unMinLen+{-# INLINE minimum #-}++-- | Get the maximum element of a monomorphic container,+-- using a supplied element ordering function.+--+-- Safe version of 'maximumByEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+maximumBy :: MonoFoldable mono+ => (Element mono -> Element mono -> Ordering)+ -> MinLen (Succ nat) mono+ -> Element mono+maximumBy cmp = maximumByEx cmp . unMinLen+{-# INLINE maximumBy #-}++-- | Get the minimum element of a monomorphic container,+-- using a supplied element ordering function.+--+-- Safe version of 'minimumByEx', only works on monomorphic containers wrapped in a+-- @'MinLen' ('Succ' nat)@.+minimumBy :: MonoFoldable mono+ => (Element mono -> Element mono -> Ordering)+ -> MinLen (Succ nat) mono+ -> Element mono+minimumBy cmp = minimumByEx cmp . unMinLen+{-# INLINE minimumBy #-}++-- | 'oextract' is 'head'.+--+-- For @'oextend' f@, the new 'mono' is populated by applying @f@ to+-- successive 'tail's of the original 'mono'.+--+-- For example, for @'MinLen' ('Succ' 'Zero') ['Int']@, or+-- @'NonNull' ['Int']@:+--+-- @+-- 'oextend' f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5]+-- , f [2, 3, 4, 5]+-- , f [3, 4, 5]+-- , f [4, 5]+-- , f [5]+-- ]+-- @+--+-- Meant to be a direct analogy to the instance for 'NonEmpty' @a@.+--+instance IsSequence mono+ => MonoComonad (MinLen (Succ Zero) mono) where+ oextract = head+ oextend f (MinLen mono) = MinLen+ . flip evalState mono+ . ofor mono+ . const+ . state+ $ \mono' -> (f (MinLen mono'), tailEx mono')