packages feed

precursor (empty) → 0.1.0.0

raw patch · 36 files changed

+2033/−0 lines, 36 filesdep +QuickCheckdep +basedep +bifunctorssetup-changed

Dependencies added: QuickCheck, base, bifunctors, bytestring, containers, doctest, mtl, precursor, text, text-show

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright Donnacha Oisín Kidney (c) 2016++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ precursor.cabal view
@@ -0,0 +1,128 @@+name:                precursor+version:             0.1.0.0+synopsis:            Prelude replacement+description:+  Features+  .+  [No more 'String']+  'String' is removed in favor of lazy 'Data.Text.Lazy.Text'.+  .+  [No more 'Num']+  The 'Num' typeclass is now just for types which can be converted from+  integer literals.+  .+  ['Semigroup's]+  'Semigroup's are now in scope by default, as well as some useful+  wrappers.+  .+  ['Semiring's]+  A 'Semiring' has the operations '+' and '*', and the members 'one'+  and 'zero'. 'Bool' is a 'Semiring', as is 'Integer', etc. 'Num' is+  /not/ a superclass of 'Semiring'.+  .+  [Sensibly strict]+  Several functions, such as 'foldl', 'sum', 'product', etc. are strict+  as default.+  .+  [No unnecessary 'Monad's]+  Functions such as 'Control.Monad.sequence', 'Control.Monad.>>', and+  'Control.Monad.replicateM' are removed in favor of the equivalent+  'sequenceA', '*>', and 'replicateA' on 'Applicative's.+  .+  [Fewer partial functions]+  Functions like 'head', 'last', 'minimum', etc. now return 'Nothing'+  when called on empty structures. 'tail' and 'init' return empty+  lists when called on empty lists.+  .+  [Data structures]+  'Map' and 'Set' (the strict variants) are now in scope by default,+  with a minimal, non-colliding aliased api.+  .+  [Transformers]+  'State' is now in scope by default.+  .+  [Debugging]+  Handy functions like 'trace', 'traceShow', and 'notImplemented' are+  in scope by default. They give warnings when used so they can't be+  forgotten.+  .+  [Other handy functions]+  An /O(n*log n)/ 'nub', 'foldr2', 'converge', 'bool', and others.+homepage:            https://github.com/oisdk/precursor#readme+license:             MIT+license-file:        LICENSE+author:              Donnacha Oisín Kidney+maintainer:          mail@doisinkidney.com+copyright:           2016 Donnacha Oisín Kidney+category:            Prelude+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Precursor+                       Precursor.Control.Functor+                       Precursor.Control.Applicative+                       Precursor.Control.Alternative+                       Precursor.Control.Category+                       Precursor.Control.Monad+                       Precursor.Control.State+                       Precursor.Control.Bifunctor+                       Precursor.Structure.Foldable+                       Precursor.Structure.Traversable+                       Precursor.Data.Bool+                       Precursor.Data.Either+                       Precursor.Data.Maybe+                       Precursor.Data.Tuple+                       Precursor.Data.List+                       Precursor.Data.Set+                       Precursor.Data.Map+                       Precursor.Algebra.Enum+                       Precursor.Algebra.Semiring+                       Precursor.Algebra.Semigroup+                       Precursor.Algebra.Ring+                       Precursor.Algebra.Monoid+                       Precursor.Algebra.Eq+                       Precursor.Algebra.Ord+                       Precursor.Numeric.Num+                       Precursor.Numeric.Integral+                       Precursor.Text.Text+                       Precursor.Text.Show+                       Precursor.System.IO+                       Precursor.Function+                       Precursor.Debug+                       Precursor.Coerce+  build-depends:       base >= 4.7 && < 5+                     , containers >= 0.5+                     , mtl >= 2.2+                     , bifunctors >= 5.4+                     , text >= 1.2+                     , bytestring >= 0.10+                     , text-show >= 3.4+  default-extensions:  NoImplicitPrelude+                       DefaultSignatures+                       RebindableSyntax+                       OverloadedStrings+  default-language:    Haskell2010+  ghc-options:         -Wall+                       -fwarn-implicit-prelude++test-suite precursor-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , precursor+                     , QuickCheck+                     , doctest+  ghc-options:         -threaded+                       -rtsopts+                       -with-rtsopts=-N+                       -Wall+  default-extensions:  NoImplicitPrelude+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/oisdk/precursor
+ src/Precursor.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE NoImplicitPrelude #-}++{-|+Module: Precursor+Description: A fun-ish Prelude replacement+License: MIT+Maintainer: mail@doisinkidney.com+Stability: experimental++Features++[No more 'String']+'String' is removed in favor of lazy 'Data.Text.Lazy.Text'.++[No more 'Num']+The 'Num' typeclass is now just for types which can be converted from+integer literals.++['Semigroup's]+'Semigroup's are now in scope by default, as well as some useful+wrappers.++['Semiring's]+A 'Semiring' has the operations '+' and '*', and the members 'one'+and 'zero'. 'Bool' is a 'Semiring', as is 'Integer', etc. 'Num' is+/not/ a superclass of 'Semiring'.++[Sensibly strict]+Several functions, such as 'foldl', 'sum', 'product', etc. are strict+as default.++[No unnecessary 'Monad's]+Functions such as 'Control.Monad.sequence', 'Control.Monad.>>', and+'Control.Monad.replicateM' are removed in favor of the equivalent+'sequenceA', '*>', and 'replicateA' on 'Applicative's.++[Fewer partial functions]+Functions like 'head', 'last', 'minimum', etc. now return 'Nothing'+when called on empty structures. 'tail' and 'init' return empty+lists when called on empty lists.++[Data structures]+'Map' and 'Set' (the strict variants) are now in scope by default,+with a minimal, non-colliding aliased api.++[Transformers]+'State' is now in scope by default.++[Debugging]+Handy functions like 'trace', 'traceShow', and 'notImplemented' are+in scope by default. They give warnings when used so they can't be+forgotten.++[Other handy functions]+An /O(n*log n)/ 'nub', 'foldr2', 'converge', 'bool', and others.+-}++module Precursor+  ( module Precursor.Algebra.Enum+  , module Precursor.Algebra.Eq+  , module Precursor.Algebra.Monoid+  , module Precursor.Algebra.Ord+  , module Precursor.Algebra.Ring+  , module Precursor.Algebra.Semigroup+  , module Precursor.Algebra.Semiring+  , module Precursor.Coerce+  , module Precursor.Control.Alternative+  , module Precursor.Control.Applicative+  , module Precursor.Control.Bifunctor+  , module Precursor.Control.Category+  , module Precursor.Control.Functor+  , module Precursor.Control.Monad+  , module Precursor.Control.State+  , module Precursor.Data.Bool+  , module Precursor.Data.Either+  , module Precursor.Data.List+  , module Precursor.Data.Map+  , module Precursor.Data.Maybe+  , module Precursor.Data.Set+  , module Precursor.Data.Tuple+  , module Precursor.Debug+  , module Precursor.Function+  , module Precursor.Numeric.Integral+  , module Precursor.Numeric.Num+  , module Precursor.Structure.Foldable+  , module Precursor.Structure.Traversable+  , module Precursor.System.IO+  , module Precursor.Text.Show+  , module Precursor.Text.Text+  ) where++import           Precursor.Algebra.Enum+import           Precursor.Algebra.Eq+import           Precursor.Algebra.Monoid+import           Precursor.Algebra.Ord+import           Precursor.Algebra.Ring+import           Precursor.Algebra.Semigroup+import           Precursor.Algebra.Semiring+import           Precursor.Coerce+import           Precursor.Control.Alternative+import           Precursor.Control.Applicative+import           Precursor.Control.Bifunctor+import           Precursor.Control.Category+import           Precursor.Control.Functor+import           Precursor.Control.Monad+import           Precursor.Control.State+import           Precursor.Data.Bool+import           Precursor.Data.Either+import           Precursor.Data.List+import           Precursor.Data.Map+import           Precursor.Data.Maybe+import           Precursor.Data.Set+import           Precursor.Data.Tuple+import           Precursor.Debug+import           Precursor.Function+import           Precursor.Numeric.Integral+import           Precursor.Numeric.Num+import           Precursor.Structure.Foldable+import           Precursor.Structure.Traversable+import           Precursor.System.IO+import           Precursor.Text.Show+import           Precursor.Text.Text
+ src/Precursor/Algebra/Enum.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Algebra.Enum+  ( -- * Enum class+    Enum+  , succ+  , pred+  , toEnum+  , fromEnum+  , enumFrom+  , enumFromThen+  , enumFromTo+  , enumFromThenTo+    -- * Bounded class+  , Bounded(..)+  ) where++import Prelude (Enum(..), Bounded(..))
+ src/Precursor/Algebra/Eq.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Algebra.Eq+  ( Eq+  , (==)+  , (/=)+  ) where++import           Data.Eq
+ src/Precursor/Algebra/Monoid.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Precursor.Algebra.Monoid+  ( -- * 'Monoid' typeclass+    Monoid+  , mempty+  , mappend+  , Dual(..)+  , Endo(..)+    -- * 'Semiring' wrappers+  , Sum(..)+  , Product(..)+  -- * A better monoid for Maybe+  , Option(..)+  , option+  ) where++import           Precursor.Control.Applicative+import           Data.Coerce+import           Data.Semigroup hiding (Product (..), Sum (..))+import           Precursor.Control.Functor+import           GHC.Generics+import           Precursor.Control.Monad+import           Precursor.Numeric.Num+import           Prelude        (Bounded, Eq, Ord)+import           Precursor.Algebra.Semiring+import           Precursor.Text.Show++-- | Monoid under addition.+newtype Sum a = Sum { getSum :: a }+        deriving (Eq, Ord, Bounded, Generic, Generic1, Num)++instance TextShow a => TextShow (Sum a) where showbPrec = gShowPrec++instance Semiring a => Semigroup (Sum a) where+  (<>) =+    (coerce :: (a -> a -> a) -> (Sum a -> Sum a -> Sum a)) (+)++instance Semiring a => Monoid (Sum a) where+  mappend = (<>)+  mempty = Sum zero++instance Functor Sum where+    fmap     = coerce++instance Applicative Sum where+    pure     = Sum+    (<*>)    = coerce++instance Monad Sum where+    m >>= k  = k (getSum m)++-- | Monoid under multiplication.+newtype Product a = Product { getProduct :: a }+        deriving (Eq, Ord, Bounded, Generic, Generic1, Num)++instance TextShow a => TextShow (Product a) where showbPrec = gShowPrec++instance Semiring a => Semigroup (Product a) where+  (<>) =+    (coerce :: (a -> a -> a) -> (Product a -> Product a -> Product a)) (*)++instance Semiring a => Monoid (Product a) where+        mempty = Product one+        mappend = (<>)++instance Functor Product where+    fmap     = coerce++instance Applicative Product where+    pure     = Product+    (<*>)    = coerce++instance Monad Product where+    m >>= k  = k (getProduct m)
+ src/Precursor/Algebra/Ord.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Algebra.Ord+  ( Ord+  , compare+  , (<=)+  , (>=)+  , (<)+  , (>)+  , Ordering(..)+  , Down(..)+  , comparing+  , max+  , min+  ) where++import           Data.Ord
+ src/Precursor/Algebra/Ring.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DefaultSignatures #-}++module Precursor.Algebra.Ring where++import qualified Prelude+import           Precursor.Algebra.Semiring+import           Data.Int  (Int, Int16, Int32, Int64, Int8)+import           GHC.Float (Double, Float)++-- | A 'Ring' is a 'Semiring' with an additive inverse, such that:+--+-- * @∀ r. r ∈ 'Ring' ∃ i. r '-' i = 'zero'@+class Semiring a => Ring a where+  infixl 6 -+  -- | A binary operation such that:+  --+  -- * @∀ r. r ∈ 'Ring' ∃ i. r '-' i = 'zero'@+  (-) :: a -> a -> a++  default (-) :: Prelude.Num a => a -> a -> a+  (-) = (Prelude.-)++instance Ring Int+instance Ring Int8+instance Ring Int16+instance Ring Int32+instance Ring Int64+instance Ring Prelude.Integer+instance Ring Float+instance Ring Double
+ src/Precursor/Algebra/Semigroup.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Algebra.Semigroup+  ( -- * 'Semigroup' typeclass+    Semigroup+  , (<>)+  , sconcat+  , stimesMonoid+  , stimesIdempotent+  , stimesIdempotentMonoid+  , mtimesDefault+  , First(..)+  , Last(..)+  -- * 'Ord' wrappers+  , Min(..)+  , Max(..)+  -- * Backwards compatibility+  , WrappedMonoid(..)+  ) where++import Data.Semigroup
+ src/Precursor/Algebra/Semiring.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax  #-}++module Precursor.Algebra.Semiring where++import           Precursor.Data.Bool+import           Data.Int  (Int, Int16, Int32, Int64, Int8)+import           GHC.Float (Double, Float)+import qualified GHC.Num   as P+import           Precursor.Numeric.Num++-- | A <https://en.wikipedia.org/wiki/Semiring Semiring> is like the+-- the combination of two 'Precursor.Algebra.Monoid.Monoid's. The first+-- is called '+'; it has the identity element 'zero', and it is+-- commutative. The second is called '*'; it has identity element 'one',+-- and it must distribute over '+'.+--+-- = Laws+-- == Normal 'Precursor.Algebra.Monoid.Monoid' laws+-- * @(a '+' b) '+' c = a '+' (b '+' c)@+-- * @'zero' '+' a = a '+' 'zero' = a@+-- * @(a '*' b) '*' c = a '*' (b '*' c)@+-- * @'one' '*' a = a '*' 'one' = a@+--+-- == Commutativity of '+'+-- * @a '+' b = b '+' a@+--+-- == Distribution of '*' over '+'+-- * @a'*'(b '+' c) = (a'*'b) '+' (a'*'c)@+-- * @(a '+' b)'*'c = (a'*'c) '+' (b'*'c)@+--+-- Another useful law, annihilation, may be deduced from the axioms+-- above:+--+-- * @'zero' '*' a = a '*' 'zero' = 'zero'@+class Semiring a where+  -- | The identity of '*'.+  one  :: a+  -- | The identity of '+'.+  zero :: a+  infixl 7 *+  -- | An associative binary operation, which distributes over '+'.+  (*)  :: a -> a -> a+  -- | An associative, commutative binary operation.+  infixl 6 ++  (+)  :: a -> a -> a++  default one :: Num a => a+  default zero :: Num a => a+  one = 1+  zero = 0++  default (+) :: P.Num a => a -> a -> a+  default (*) :: P.Num a => a -> a -> a+  (+) = (P.+)+  (*) = (P.*)++instance Semiring Int+instance Semiring Int8+instance Semiring Int16+instance Semiring Int32+instance Semiring Int64+instance Semiring P.Integer+instance Semiring Float+instance Semiring Double++instance Semiring Bool where+  one = True+  zero = False+  (*) = (&&)+  (+) = (||)++instance Semiring b => Semiring (a -> b) where+  one  _ = one+  zero _ = zero+  (f * g) x = f x * g x+  (f + g) x = f x + g x
+ src/Precursor/Coerce.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Coerce+  ( Coercible+  , coerce+  , (#.)+  ) where++import Data.Coerce++infixr 9 #.+-- | It may be better to use @('#.')@ instead of+-- @('Precursor.Control.Category..')@ to avoid potential efficiency+-- problems relating to #7542. The problem, in a nutshell:+--+-- If @N@ is a newtype constructor, then @N x@ will always have the same+-- representation as @x@ (something similar applies for a newtype+-- deconstructor). However, if @f@ is a function,+--+-- @N 'Precursor.Control.Category..' f = \x -> N (f x)@+--+-- This looks almost the same as @f@, but the eta expansion lifts it--the+-- lhs could be @_|_@, but the rhs never is. This can lead to very+-- inefficient code.  Thus we steal a technique from Shachaf and Edward+-- Kmett and adapt it to the current (rather clean) setting. Instead of+-- using  @N 'Precursor.Control.Category..' f@, we use @N '.#' f@, which+-- is just+--+-- @'coerce' f `'Prelude.asTypeOf'` (N 'Precursor.Control.Category..' f)@+--+-- That is, we just *pretend* that @f@ has the right type, and thanks to+-- the safety of 'coerce', the type checker guarantees that nothing really+-- goes wrong. We still have to be a bit careful, though: remember that+-- '#.' completely ignores the *value* of its left operand.+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _ = coerce+{-# INLINE (#.) #-}
+ src/Precursor/Control/Alternative.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Alternative+  ( -- * Alternative class+    Alternative+  , (<|>)+  , empty+  , some+  , many+    -- * Utility functions+  , optional+  , afilter+  , asum+  , guard+  , ensure+  , eitherA+  , toAlt+  , mapAlt+  ) where++import           Precursor.Control.Applicative+import           Precursor.Data.Bool+import           Precursor.Control.Category+import           Control.Applicative+import           Control.Monad       (guard)+import           Data.Foldable       (asum)+import           Data.Monoid         (getAlt)+import           Precursor.Data.Either+import           Precursor.Structure.Foldable+import           Precursor.Control.Functor+import           Precursor.Control.Monad++-- $setup+-- >>> import Precursor.Numeric.Integral+-- >>> import Precursor.Numeric.Num+-- >>> import Precursor.Data.List+-- >>> import Test.QuickCheck++-- | A generalized version of 'filter', which works on anything which is+-- both a 'Monad' and 'Alternative'.+--+-- prop> \(Blind p) xs -> filter p xs === afilter p xs+afilter :: (Monad m, Alternative m) => (a -> Bool) -> m a -> m a+afilter p = (=<<) (\x -> bool (pure x) empty (p x))++-- | 'ensure' allows you to attach a condition to something+ensure :: (Alternative f) => (a -> Bool) -> a -> f a+ensure p x = x <$ guard (p x)++-- | 'eitherA' is especially useful for parsers.+eitherA :: Alternative f => f a -> f b -> f (Either a b)+eitherA x y = fmap Left x <|> fmap Right y++-- | Convert any 'Foldable' to an 'Alternative'+toAlt :: (Alternative f, Foldable t) => t a -> f a+toAlt = getAlt . foldMap pure++-- | Map a function over a monad, and concat the results. This is a+-- generalized form of the function 'Data.Maybe.mapMaybe'.+mapAlt :: (Monad m, Alternative m, Foldable f) => (a -> f b) -> m a -> m b+mapAlt f = (=<<) (toAlt . f)
+ src/Precursor/Control/Applicative.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Applicative+  ( -- * Applicative functors+    Applicative+  , pure+  , (<*>)+  , (*>)+  , (<*)+    -- * Instances+  , Const(..)+  , WrappedArrow(..)+  , ZipList(..)+    -- * Utility functions+  , liftA2+  , (<**>)+  , forever+  , when+  , unless+  , replicateA+  , replicateA_+  , filterA+  ) where++import           Control.Applicative+import           Control.Monad+import           Precursor.Data.Bool+import           Precursor.Numeric.Num+import qualified Prelude++-- | @'replicateA' n act@ performs the action @n@ times,+-- gathering the results.+replicateA :: (Applicative f) => Prelude.Int -> f a -> f [a]+{-# INLINEABLE replicateA #-}+{-# SPECIALISE replicateA :: Prelude.Int -> Prelude.IO a -> Prelude.IO [a] #-}+{-# SPECIALISE replicateA :: Prelude.Int -> Prelude.Maybe a -> Prelude.Maybe [a] #-}+replicateA cnt0 f =+    loop cnt0+  where+    loop cnt+        | cnt Prelude.<= 0  = pure []+        | otherwise = liftA2 (:) f (loop (cnt Prelude.- 1))++-- | Like 'replicateA', but discards the result.+replicateA_ :: (Applicative f) => Prelude.Int -> f a -> f ()+{-# INLINEABLE replicateA_ #-}+{-# SPECIALISE replicateA_ :: Prelude.Int -> Prelude.IO a -> Prelude.IO () #-}+{-# SPECIALISE replicateA_ :: Prelude.Int -> Prelude.Maybe a -> Prelude.Maybe () #-}+replicateA_ cnt0 f =+    loop cnt0+  where+    loop cnt+        | cnt Prelude.<= 0  = pure ()+        | otherwise = f *> loop (cnt Prelude.- 1)++-- | This generalizes the list-based 'Precursor.Data.List.filter' function.+{-# INLINE filterA #-}+filterA :: Applicative f => (a -> f Bool) -> [a] -> f [a]+filterA = filterM
+ src/Precursor/Control/Bifunctor.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Bifunctor+  ( Bifunctor+  , bimap+  , first+  , second+  ) where++import Data.Bifunctor
+ src/Precursor/Control/Category.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Category+  ( -- * Category+    Category+  , (.)+  , id+    -- ** Composition+  , (<<<)+  , (>>>)+    -- * Arrow+  , Arrow+  , arr+  , (***)+  , (&&&)+    -- ** Arrows+  , Kleisli(..)+    -- *** Derived combinators+  ,  returnA+  , (^>>)+  , (>>^)+    -- *** Right-to-left variants+  , (<<^)+  , (^<<)+    -- ** Monoid operations+  , ArrowZero+  , zeroArrow+  , ArrowPlus+  , (<+>)+    -- ** Conditionals+  , ArrowChoice+  , left+  , right+  , (+++)+  , (|||)+    -- ** Arrow application+  , ArrowApply+  , app+  , ArrowMonad(..)+  , leftApp+    -- ** Feedback+  , ArrowLoop+  , loop+  ) where++import           Control.Arrow+import           Control.Category
+ src/Precursor/Control/Functor.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Functor+  ( Functor(..)+  , ($>)+  , (<$>)+  , void+  , (<&>)+  , (<-<)+  , (>->)+  ) where++import           Precursor.Control.Category+import           Data.Functor++infixl 1 <&>+-- | A flipped version of 'fmap'.+(<&>) :: Functor f => f a -> (a -> b) -> f b+x <&> f = fmap f x+{-# INLINE (<&>) #-}++infixl 1 <-<+-- | Arrow-like operator. Useful for chaining with the '<<<' and+-- 'Precursor.Control.Monad.<=<' combinators.+(<-<) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c+g <-< f = fmap g . f++infixr 1 >->+-- | Arrow-like operator. Useful for chaining with the '>>>' and+-- 'Precursor.Control.Monad.>=>' combinators.+(>->) :: Functor f => (a -> f b) -> (b -> c) -> a -> f c+f >-> g = fmap g . f
+ src/Precursor/Control/Monad.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Control.Monad+  (-- * Monad class+    Monad+  -- * Functions++  -- ** Naming conventions+  -- $naming++  -- ** Basic @Monad@ functions+  , (>>=)+  , (=<<)+  , (>=>)+  , (<=<)+  , join++  -- ** Generalisations of list functions++  , foldlM+  , foldlM_+  , foldrM+  , foldrM_++  -- ** Strict monadic functions++  , (<$!>)++  -- ** Avoid+  , (>>)+  , fail+  , return+ ) where++import           Precursor.Control.Category+import           Control.Monad+import           Data.Foldable hiding (foldlM)+import qualified Data.Foldable as Foldable++{- | The 'foldlM' function is analogous to+'Precursor.Structure.Foldable.foldl', except that its result is+encapsulated in a monad.+++>       foldlM f a1 [x1, x2, ..., xm]++==++>       do+>         a2 <- f a1 x1+>         a3 <- f a2 x2+>         ...+>         f am xm++-}++foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b+foldlM = Foldable.foldlM++-- | Like 'foldlM', but discards the result.+foldlM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()+foldlM_ = foldM_++-- | Like 'foldrM', but discards the result.+foldrM_ :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m ()+foldrM_ f b = void . foldrM f b+{- $naming++The functions in this library use the following naming conventions:++* A postfix \'@M@\' always stands for a function in the Kleisli category:+  The monad type constructor @m@ is added to function results+  (modulo currying) and nowhere else.  So, for example,++>  filter  ::              (a ->   Bool) -> [a] ->   [a]+>  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]++* A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.+  Thus, for example:++>  sequence  :: Monad m => [m a] -> m [a]+>  sequence_ :: Monad m => [m a] -> m ()++* A prefix \'@m@\' generalizes an existing function to a monadic form.+  Thus, for example:++>  sum  :: Num a       => [a]   -> a+>  msum :: MonadPlus m => [m a] -> m a++-}
+ src/Precursor/Control/State.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | Lazy state monads.+--+--      This module is inspired by the paper+--      /Functional Programming with Overloading and Higher-Order Polymorphism/,+--        Mark P Jones (<http://web.cecs.pdx.edu/~mpj/>)+--          Advanced School of Functional Programming, 1995.++module Precursor.Control.State+  ( -- * MonadState class+    MonadState(..)+  , modify+  , modify'+  , gets+  , -- * The State monad+    State+  , runState+  , evalState+  , execState+  , -- * The StateT monad transformer+    StateT(StateT)+  , runStateT+  , evalStateT+  , execStateT+  , module Control.Monad.Fix+  , module Control.Monad.Trans+    -- * Examples+    -- $examples+  ) where++import           Control.Monad.Fix+import           Control.Monad.State+import           Control.Monad.Trans+++-- $examples+-- A function to increment a counter.  Taken from the paper+-- /Generalising Monads to Arrows/, John+-- Hughes (<http://www.math.chalmers.se/~rjmh/>), November 1998:+--+-- > tick :: State Int Int+-- > tick = do n <- get+-- >           put (n+1)+-- >           return n+--+-- Add one to the given number using the state monad:+--+-- > plusOne :: Int -> Int+-- > plusOne n = execState tick n+--+-- A contrived addition example. Works only with positive numbers:+--+-- > plus :: Int -> Int -> Int+-- > plus n x = execState (sequence $ replicate n tick) x+--+-- An example from /The Craft of Functional Programming/, Simon+-- Thompson (<http://www.cs.kent.ac.uk/people/staff/sjt/>),+-- Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a+-- tree of integers in which the original elements are replaced by+-- natural numbers, starting from 0.  The same element has to be+-- replaced by the same number at every occurrence, and when we meet+-- an as-yet-unvisited element we have to find a \'new\' number to match+-- it with:\"+--+-- > data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)+-- > type Table a = [a]+--+-- > numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)+-- > numberTree Nil = return Nil+-- > numberTree (Node x t1 t2)+-- >        =  do num <- numberNode x+-- >              nt1 <- numberTree t1+-- >              nt2 <- numberTree t2+-- >              return (Node num nt1 nt2)+-- >     where+-- >     numberNode :: Eq a => a -> State (Table a) Int+-- >     numberNode x+-- >        = do table <- get+-- >             (newTable, newPos) <- return (nNode x table)+-- >             put newTable+-- >             return newPos+-- >     nNode::  (Eq a) => a -> Table a -> (Table a, Int)+-- >     nNode x table+-- >        = case (findIndexInList (== x) table) of+-- >          Nothing -> (table ++ [x], length table)+-- >          Just i  -> (table, i)+-- >     findIndexInList :: (a -> Bool) -> [a] -> Maybe Int+-- >     findIndexInList = findIndexInListHelp 0+-- >     findIndexInListHelp _ _ [] = Nothing+-- >     findIndexInListHelp count f (h:t)+-- >        = if (f h)+-- >          then Just count+-- >          else findIndexInListHelp (count+1) f t+--+-- numTree applies numberTree with an initial state:+--+-- > numTree :: (Eq a) => Tree a -> Tree Int+-- > numTree t = evalState (numberTree t) []+--+-- > testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil+-- > numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil+--+-- sumTree is a little helper function that does not use the State monad:+--+-- > sumTree :: (Num a) => Tree a -> a+-- > sumTree Nil = 0+-- > sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2)
+ src/Precursor/Data/Bool.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Data.Bool+  ( -- * Booleans+    Bool(..)+    -- ** Operations+  , (&&)+  , (||)+  , not+  , otherwise+  , bool+  , ifThenElse+  ) where++import Data.Bool hiding (bool)++-- | Used for desugaring @if@ expressions.+--+-- >>> ifThenElse True 1 0+-- 1+-- >>> ifThenElse False 1 0+-- 0+ifThenElse :: Bool -> a -> a -> a+ifThenElse True  t _ = t+ifThenElse False _ f = f++-- | Fold over a 'Bool'.+--+-- >>> bool 1 0 True+-- 1+-- >>> bool 1 0 False+-- 0+bool :: a -> a -> Bool -> a+bool t _ True  = t+bool _ f False = f
+ src/Precursor/Data/Either.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Data.Either+  ( Either(..)+  , lefts+  , rights+  , partitionEithers+  ) where++import Data.Either
+ src/Precursor/Data/List.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Data.List+  (+  -- * Basic functions++    uncons++  -- * List transformations+  , init+  , tail++  , reverse++  , intersperse+  , intercalate+  , transpose++  , subsequences+  , permutations++  , nub++  -- * Building lists++  , fromList++  -- ** Scans+  , scanl+  , scanl'+  , scanl1+  , scanr+  , scanr1++  -- ** Infinite lists+  , iterate+  , repeat+  , replicate+  , cycle++  -- ** Unfolding+  , unfoldr+  , unfoldl++  -- * Sublists++  -- ** Extracting sublists+  , take+  , drop+  , splitAt++  , takeWhile+  , dropWhile++  , group++  , inits+  , tails++  -- * Searching with a predicate+  , filter+  , partition++  -- * Zipping and unzipping lists+  , zip+  , zipWith+  , unzip++  , zip3+  , zipWith3+  , unzip3++  -- * Ordered lists+  , sort+  , sortOn++  -- * Generalized functions++  -- | The predicate is assumed to define an equivalence.+  , groupBy++  -- | The function is assumed to define a total ordering.+  , sortBy++  ) where++import           Data.List                     hiding (init, insert, nub, tail)+import           GHC.Exts                      (fromList)+import           Precursor.Algebra.Monoid+import           Precursor.Algebra.Ord+import           Precursor.Control.Applicative+import           Precursor.Control.Category+import           Precursor.Control.State+import           Precursor.Data.Bool+import           Precursor.Data.Maybe+import           Precursor.Data.Set+import           Precursor.Data.Tuple+import           Precursor.Function++-- $setup+-- >>> import Precursor.Control.Alternative+-- >>> import Precursor.Control.Functor+-- >>> import Precursor.Numeric.Integral++-- | 'unfoldl' is the dual of 'foldl', similar to 'unfoldr'. It can be+-- quite useful as a kind of lightweight state-thing:+--+-- >>> let toDigs b = unfoldl (ensure (>0) >-> flip divMod b)+-- >>> toDigs 10 123+-- [1,2,3]+-- >>> toDigs 2 5+-- [1,0,1]+unfoldl :: (b -> Maybe (b, a)) -> b -> [a]+unfoldl f = r [] where r a = maybe a ((uncurry.flip) (r . (:a))) . f++-- | Extract the elements after the head of a list. If the given list is+-- empty, returns an empty list.+--+-- >>> tail [1,2,3]+-- [2,3]+-- >>> tail []+-- []+tail :: [a] -> [a]+tail (_:xs) = xs+tail xs = xs++-- | Return all the elements of a list except the last one.+-- If the given list is empty, returns an empty list.+--+-- >>> init [1,2,3]+-- [1,2]+-- >>> init []+-- []+init :: [a] -> [a]+init []                 =  []+init (x:xs)             =  init' x xs+  where init' _ []     = []+        init' y (z:zs) = y : init' z zs++-- | /O(n*log n)/. The 'nub' function removes duplicate elements from a list.+-- In particular, it keeps only the first occurrence of each element.+-- (The name 'nub' means \`essence\'.)+--+-- >>> nub [1,2,3,2,3,4,1,2,5,2,3]+-- [1,2,3,4,5]+-- >>> take 5 (nub [1..])+-- [1,2,3,4,5]+-- >>> take 5 (nub [10,9..])+-- [10,9,8,7,6]+nub :: Ord a => [a] -> [a]+nub = flip evalState mempty .+      filterA (\x -> gets (not . member x) <* modify' (add x))
+ src/Precursor/Data/Map.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | An efficient implementation of ordered maps from keys to values+-- (dictionaries).+--+-- API of this module is strict in both the keys and the values.+-- If you need value-lazy maps, use "Data.Map.Lazy" instead.+-- The 'Map' type is shared between the lazy and strict modules,+-- meaning that the same 'Map' value can be passed to functions in+-- both modules (although that is rarely needed).+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- >  import qualified Data.Map.Strict as Map+--+-- The implementation of 'Map' is based on /size balanced/ binary trees (or+-- trees of /bounded balance/) as described by:+--+--    * Stephen Adams, \"/Efficient sets: a balancing act/\",+--     Journal of Functional Programming 3(4):553-562, October 1993,+--     <http://www.swiss.ai.mit.edu/~adams/BB/>.+--    * J. Nievergelt and E.M. Reingold,+--      \"/Binary search trees of bounded balance/\",+--      SIAM journal of computing 2(1), March 1973.+--+--  Bounds for 'union', 'intersection', and 'difference' are as given+--  by+--+--    * Guy Blelloch, Daniel Ferizovic, and Yihan Sun,+--      \"/Just Join for Parallel Ordered Sets/\",+--      <https://arxiv.org/abs/1602.02120v3>.+--+-- Note that the implementation is /left-biased/ -- the elements of a+-- first argument are always preferred to the second, for example in+-- 'union' or 'insert'.+--+-- /Warning/: The size of the map must not exceed @maxBound::Int@. Violation of+-- this condition is not detected and if the size limit is exceeded, its+-- behaviour is undefined.+--+-- Operation comments contain the operation time complexity in+-- the Big-O notation (<http://en.wikipedia.org/wiki/Big_O_notation>).+--+-- Be aware that the 'Functor', 'Traversable' and 'Data' instances+-- are the same as for the "Data.Map.Lazy" module, so if they are used+-- on strict maps, the resulting maps will be lazy.++module Precursor.Data.Map+  ( Map+  , lookup+  , insert+  , delete+  ) where++import Data.Map.Strict+
+ src/Precursor/Data/Maybe.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Data.Maybe+  ( Maybe(..)+  , maybe+  , fromMaybe+  ) where++import Data.Maybe
+ src/Precursor/Data/Set.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | An efficient implementation of sets.+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- >  import Data.Set (Set)+-- >  import qualified Data.Set as Set+--+-- The implementation of 'Set' is based on /size balanced/ binary trees (or+-- trees of /bounded balance/) as described by:+--+--    * Stephen Adams, \"/Efficient sets: a balancing act/\",+--      Journal of Functional Programming 3(4):553-562, October 1993,+--      <http://www.swiss.ai.mit.edu/~adams/BB/>.+--    * J. Nievergelt and E.M. Reingold,+--      \"/Binary search trees of bounded balance/\",+--      SIAM journal of computing 2(1), March 1973.+--+--  Bounds for 'union', 'intersection', and 'difference' are as given+--  by+--+--    * Guy Blelloch, Daniel Ferizovic, and Yihan Sun,+--      \"/Just Join for Parallel Ordered Sets/\",+--      <https://arxiv.org/abs/1602.02120v3>.+--+-- Note that the implementation is /left-biased/ -- the elements of a+-- first argument are always preferred to the second, for example in+-- 'union' or 'insert'.  Of course, left-biasing can only be observed+-- when equality is an equivalence relation instead of structural+-- equality.+--+-- /Warning/: The size of the set must not exceed @maxBound::Int@. Violation of+-- this condition is not detected and if the size limit is exceeded, its+-- behaviour is undefined.++module Precursor.Data.Set+  ( Set+  , add+  , remove+  , member+  ) where++import           Data.Set+import           Precursor.Algebra.Ord++-- | /O(log n)/. Add an element to a set.+-- If the set already contains an element equal to the given value,+-- it is replaced with the new value.+add :: Ord a => a -> Set a -> Set a+add = insert++-- | /O(log n)/. Remove an element from a set.+remove :: Ord a => a -> Set a -> Set a+remove = delete
+ src/Precursor/Data/Tuple.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Data.Tuple+  ( fst+  , snd+  , curry+  , uncurry+  , swap+  ) where++import Data.Tuple
+ src/Precursor/Debug.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Precursor.Debug+  ( undefined+  , trace+  , traceShow+  , notImplemented+  ) where++import           Precursor.Control.Functor+import           Precursor.System.IO+import           Prelude          (error, undefined)+import           System.IO.Unsafe (unsafePerformIO)+import           Precursor.Text.Text+import           Precursor.Text.Show++{-# WARNING trace "'trace' remains in code" #-}+-- | Used for tracing a message along with a pure value. For debugging+-- purposes only.+trace :: Text -> b -> b+trace msg x = unsafePerformIO (putStrLn msg $> x)++{-# WARNING notImplemented "'notImplemented' remains in code" #-}+-- | Used to fill in holes in code for later implementation.+notImplemented :: a+notImplemented = error "Not implemented"++{-# WARNING traceShow "'traceShow' remains in code" #-}+-- | Prints a value to stdout when it's evaluated. For debugging+-- purposes only.+traceShow :: TextShow a => a -> a+traceShow x = trace (show x) x
+ src/Precursor/Function.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Function+ ( const+ , fix+ , flip+ , on+ , ($)+ , (&)+ , applyN+ , converge+ , (.:)+ ) where++import           Precursor.Data.Bool+import           Precursor.Control.Category+import           Data.Function hiding ((.))+import           Precursor.Algebra.Eq+import           Precursor.Numeric.Num+import           Precursor.Algebra.Ord+import           Precursor.Algebra.Ring++-- $setup+-- >>> import Precursor.Algebra.Semiring+-- >>> import Precursor.Data.List+-- >>> import Test.QuickCheck++-- | >>> applyN (2+) 2 0+-- 4+applyN :: (a -> a) -> Int -> a -> a+applyN f = go . max 0 where+  go 0 x = x+  go n x = go (n-1) (f x)++-- | Apply a function until it no longer changes its input.+--+-- prop> converge tail xs === []+converge :: Eq a => (a -> a) -> a -> a+converge f = r where+  r x | x == y = y+      | otherwise = r y+      where y = f x++infixr 8 .:+-- | \"Blackbird\" operator. For example:+--+-- @aggregate f xs = sum (map f xs)@+--+-- @aggregate = sum .: map@+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d+(f .: g) x y = f (g x y)
+ src/Precursor/Numeric/Integral.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Numeric.Integral+  ( Integral(..)+  , even+  , odd+  )where++import           Data.Int                   (Int, Int16, Int32, Int64, Int8)+import           Precursor.Algebra.Semiring+import           Prelude                    (even, odd)+import qualified Prelude++-- | An integral domain. Members of this class must be 'Semiring's with+-- commutative '*'.+--+-- * @a '*' b = b '*' a@+-- * @(a '//' b) '*' b '+' (a '%' b) = a@+-- * @(a'+'k'*'b) '%' b = a '%' b@+-- * @'zero' '%' b = 'zero'@+class Semiring a => Integral a where+  {-# MINIMAL divMod | ((//), (%)) #-}+  -- | The divisor and modulo+  divMod :: a -> a -> (a, a)+  infixl 7 //+  -- | Integer division+  (//) :: a -> a -> a+  infixl 7 %+  -- | Modulo+  (%)  :: a -> a -> a+  x // y = let (d,_) = divMod x y in d+  x %  y = let (_,m) = divMod x y in m+  divMod x y = (x % y, x // y)++instance Integral Int where divMod = Prelude.divMod+instance Integral Int8 where divMod = Prelude.divMod+instance Integral Int16 where divMod = Prelude.divMod+instance Integral Int32 where divMod = Prelude.divMod+instance Integral Int64 where divMod = Prelude.divMod+instance Integral Prelude.Integer where divMod = Prelude.divMod
+ src/Precursor/Numeric/Num.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Numeric.Num+  ( Num(..)+  , Double+  , Float+  , Int+  , Integer+  ) where++import           Data.Int  (Int, Int16, Int32, Int64, Int8)+import           GHC.Float (Double, Float)+import           Prelude   (Integer)+import qualified Prelude++-- | A class which represents things that can be converted from integer+-- literals+class Num a where+  fromInteger :: Integer -> a+  default fromInteger :: Prelude.Num a => Integer -> a+  fromInteger = Prelude.fromInteger++instance Num Prelude.Integer+instance Num Int+instance Num Int8+instance Num Int16+instance Num Int32+instance Num Int64+instance Num Double+instance Num Float
+ src/Precursor/Structure/Foldable.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Structure.Foldable+  ( -- * Folds+    Foldable+  , fold+  , foldMap+  , foldr+  , foldr'+  , foldl+  , foldlLazy+  , foldl1+  , foldr1+  , toList+  , null+  , length+  , elem+  , minimum+  , maximum+  , sum+  , product+  , head+  , last+  , (!!)+    -- ** Specialized folds+  , concat+  , concatMap+  , and+  , or+  , any+  , all+  , maximumBy+  , minimumBy+  , foldr2+  , foldr3+    -- ** Searches+  , notElem+  , find+  ) where++import           Data.Foldable              hiding (foldl, foldl1, foldr1,+                                             maximum, maximumBy, minimum,+                                             minimumBy, product, sum)+import qualified Data.Foldable+import           Precursor.Algebra.Eq+import           Precursor.Algebra.Monoid+import           Precursor.Algebra.Ord+import           Precursor.Algebra.Ring+import           Precursor.Algebra.Semiring+import           Precursor.Coerce+import           Precursor.Control.Category+import           Precursor.Data.Bool+import           Precursor.Data.Maybe+import           Precursor.Function+import           Precursor.Numeric.Num++-- $setup+-- >>> import Precursor.Data.List+-- >>> import Precursor.Algebra.Ord+-- >>> import Test.QuickCheck++-- | Left-associative fold of a structure.+--+-- In the case of lists, 'foldl', when applied to a binary+-- operator, a starting value (typically the left-identity of the operator),+-- and a list, reduces the list using the binary operator, from left to+-- right:+--+-- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+--+-- Note that to produce the outermost application of the operator the+-- entire input list must be traversed. This means that 'foldl' will+-- diverge if given an infinite list.+--+-- This version is strict, in contrast to Prelude's 'Data.Foldable.foldl'.+--+-- This ensures that each step of the fold is forced to weak head normal+-- form before being applied, avoiding the collection of thunks that would+-- otherwise occur. This is often what you want to strictly reduce a finite+-- list to a single, monolithic result (e.g. 'length').+--+-- For a lazy version, use 'foldlLazy'.+--+-- For a general 'Foldable' structure this should be semantically identical+-- to,+--+-- @foldl f z = 'List.foldl' f z . 'toList'@+--+foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b+foldl = foldl'++-- | Left-associative fold of a structure but with lazy application of+-- the operator.+--+-- Note that if you want an efficient left-fold, you probably want to+-- use 'foldl' instead of 'foldlLazy'. The reason for this is that latter does+-- not force the "inner" results (e.g. @z `f` x1@ in the above example)+-- before applying them to the operator (e.g. to @(`f` x2)@). This results+-- in a thunk chain @O(n)@ elements long, which then must be evaluated from+-- the outside-in.+--+-- For a general 'Foldable' structure this should be semantically identical+-- to,+--+-- @foldlLazy f z = 'List.foldl' f z . 'toList'@+foldlLazy :: Foldable t => (b -> a -> b) -> b -> t a -> b+foldlLazy = Data.Foldable.foldl++-- | A variant of 'foldr' that has no base case,+-- and returns 'Nothing' for empty structures.+--+-- @'foldr1' f = 'List.foldr1' f . 'toList'@+foldr1 :: Foldable t => (a -> a -> a) -> t a -> Maybe a+foldr1 f = foldr (\x -> Just . maybe x (f x)) Nothing++-- | A variant of 'foldl' that has no base case,+-- and returns 'Nothing' for empty structures.+--+-- @'foldl1' f = 'List.foldl1' f . 'toList'@+foldl1 :: Foldable t => (a -> a -> a) -> t a -> Maybe a+foldl1 f = foldl g Nothing where+  g Nothing   x = Just x+  g (Just xs) x = Just (f xs x)++-- | A Scott-ish encoding of a zip. Possibly very inefficient.+newtype ScottZip a b =+  ScottZip (a -> (ScottZip a b -> b) -> b)++-- | Fold over two 'Foldable's at once.+--+-- prop> zip xs ys === foldr2 (\x y zs -> (x,y) : zs) [] xs ys+foldr2 :: (Foldable f, Foldable g) => (a -> b -> c -> c) -> c -> f a -> g b -> c+foldr2 c i xs = foldr f (const i) xs . ScottZip #. foldr g (\_ _ -> i) where+  g e2 r2 e1 r1 = c e1 e2 (coerce r1 r2)+  f e r (ScottZip x) = x e r++-- | Fold over three 'Foldable's at once.+--+-- prop> zip3 ws xs ys === foldr3 (\w x y zs -> (w,x,y) : zs) [] ws xs ys+foldr3 :: (Foldable f, Foldable g, Foldable h)+       => (a -> b -> c -> d -> d)+       -> d -> f a -> g b -> h c -> d+foldr3 c i xs ys =+  foldr f (const i) xs . ScottZip . foldr2 g (\_ _ -> i) ys where+    g e2 e3 r2 e1 r1 = c e1 e2 e3 (coerce r1 r2)+    f e r (ScottZip x) = x e r+++newtype Max a = Max {getMax :: Maybe a}+newtype Min a = Min {getMin :: Maybe a}++instance Ord a => Monoid (Max a) where+  mempty = Max Nothing++  {-# INLINE mappend #-}+  m `mappend` Max Nothing = m+  Max Nothing `mappend` n = n+  (Max m@(Just x)) `mappend` (Max n@(Just y))+    | x >= y    = Max m+    | otherwise = Max n++instance Ord a => Monoid (Min a) where+  mempty = Min Nothing++  {-# INLINE mappend #-}+  m `mappend` Min Nothing = m+  Min Nothing `mappend` n = n+  (Min m@(Just x)) `mappend` (Min n@(Just y))+    | x <= y    = Min m+    | otherwise = Min n++-- | The largest element of a structure with respect to the given comparison+-- function. Returns 'Nothing' on an empty input.+--+-- prop> maximum (xs :: [Int]) === maximumBy compare xs+maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a+maximumBy cmp = foldr1 max'+  where max' x y = case cmp x y of+                        LT -> y+                        _  -> x++-- | The least element of a structure with respect to the given comparison+-- function. Returns 'Nothing' on an empty input.+--+-- prop> minimum (xs :: [Int]) === minimumBy compare xs+minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a+minimumBy cmp = foldr1 min'+  where min' x y = case cmp x y of+                        GT -> y+                        _  -> x++-- | The largest element of a structure. Returns 'Nothing' on empty+-- structures.+--+-- >>> maximum [1,2,3]+-- Just 3+-- >>> maximum []+-- Nothing+maximum :: (Ord a, Foldable t) => t a -> Maybe a+maximum =+    getMax . foldMap (Max #. (Just :: a -> Maybe a))++-- | The least element of a structure. Returns 'Nothing' on empty+-- structures.+--+-- >>> minimum [1,2,3]+-- Just 1+-- >>> minimum []+-- Nothing+minimum :: (Ord a, Foldable t) => t a -> Maybe a+minimum =+    getMin . foldMap (Min #. (Just :: a -> Maybe a))++-- | The 'sum' function computes the sum of the numbers of a structure.+--+-- prop> sum (xs :: [Integer]) === foldl (+) 0 xs+sum :: (Semiring a, Foldable t) => t a -> a+sum = foldl' (+) zero+{-# INLINE sum #-}++-- | The 'product' function computes the product of the numbers of a+-- structure.+--+-- prop> product (xs :: [Integer]) === foldl (*) 1 xs+product :: (Semiring a, Foldable t) => t a -> a+product = foldl' (*) one+{-# INLINE product #-}++-- | The first element of a structure, or 'Nothing' if it's empty.+--+-- >>> head [1,2,3]+-- Just 1+-- >>> head []+-- Nothing+--+-- prop> head xs === last (reverse xs)+head :: Foldable t => t a -> Maybe a+head = foldr1 const++-- | The last element of a structure, or 'Nothing' if it's empty.+--+-- >>> last [1,2,3]+-- Just 3+-- >>> last []+-- Nothing+--+-- prop> last xs === head (reverse xs)+last :: Foldable t => t a -> Maybe a+last = foldl1 (flip const)++infixl 9 !!+-- | Index (subscript) operator, starting from 0. Returns 'Nothing' for+-- out-of-range indices.+--+-- >>> [1,2,3] !! 0+-- Just 1+-- >>> [1,2,3] !! (-1)+-- Nothing+-- >>> [1,2,3] !! 3+-- Nothing+(!!) :: Foldable f => f a -> Int -> Maybe a+(!!) _ m | m < 0 = Nothing+(!!) xs m = foldr f b xs m where+  b = const Nothing+  f e _ 0 = Just e+  f _ a n = a (n-1)
+ src/Precursor/Structure/Traversable.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes        #-}++module Precursor.Structure.Traversable+  ( -- * The 'Traversable' class+    Traversable+  , traverse+  , traverse_+  , sequenceA+  , sequence+  , sequence_+    -- * Utility functions+  , for+  , for_+  , mapAccumL+  , mapAccumR+  , zipInto+  ) where++import           Data.Foldable                 (Foldable, for_, sequenceA_,+                                                traverse_)+import           Data.Traversable              hiding (sequence)+import           Precursor.Control.Applicative+import           Precursor.Control.Category+import           Precursor.Control.Functor+import           Precursor.Data.Maybe+import           Precursor.Function+import           Precursor.Structure.Foldable++-- $setup+-- >>> import Test.QuickCheck+-- >>> import Precursor.Numeric.Num++-- | Evaluate each action in the structure from left to right, and+-- and collect the results. For a version that ignores the results+-- see 'sequence_'.+sequence :: (Traversable t, Applicative f) => t (f a) -> f (t a)+sequence = sequenceA++-- | Evaluate each action in the structure from left to right, and+-- ignore the results. For a version that doesn't ignore the results+-- see 'sequence'.+sequence_ :: (Foldable t, Applicative f) => t (f a) -> f ()+sequence_ = sequenceA_++-- | A Scott-encoding of a list. This probably isn't very efficient.+newtype List a =+  List (forall b. b -> (a -> List a -> b) -> b)++newtype State s a =+  State (forall c. (a -> s -> c) -> s -> c)++instance Functor (State s) where+  fmap f (State m) = State (\t -> m (t . f))+  {-# INLINABLE fmap #-}++instance Applicative (State s) where+  pure x = State (\t -> t x)+  {-# INLINABLE pure #-}+  State fs <*> State xs =+    State (\t -> fs (\f -> xs (t . f)))+  {-# INLINABLE (<*>) #-}++evalState :: State s a -> s -> a+evalState (State x) = x const+{-# INLINABLE evalState #-}++-- | Zip two structures together, preserving the shape of the left.+--+-- prop> zipInto const (xs :: [Int]) (ys :: [Int]) === xs+zipInto+  :: (Traversable t, Foldable f)+  => (a -> Maybe b -> c)+  -> t a+  -> f b+  -> t c+zipInto f xs =+  evalState (traverse (flip fmap pop . f) xs) . foldr cons nil where+    cons y ys = List (const (\g -> g y ys))+    nil = List const+    pop = State (\t (List l) -> l (t Nothing nil) (t . Just))+{-# INLINABLE zipInto #-}
+ src/Precursor/System/IO.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.System.IO+  ( -- * The IO monad+    IO++    -- * IO class+  , MonadIO+  , liftIO++    -- * Files and handles+  , FilePath++    -- * File-at-a-time operations+  , readFile+  , writeFile+  , appendFile++  -- * Special cases for standard input and output+  , interact+  , getContents+  , getLine+  , putStr+  , putStrLn+  ) where++import           Control.Monad.IO.Class+import           Data.Text.Lazy+import qualified Data.Text.Lazy.IO          as Text+import           Precursor.Control.Category+import           Precursor.Function+import           System.IO                  (FilePath, IO)++-- | Read a file and return its contents as a string.  The file is+-- read lazily, as with 'getContents'.+readFile :: MonadIO m => FilePath -> m Text+readFile = liftIO . Text.readFile++-- | Write a string to a file.  The file is truncated to zero length+-- before writing begins.+writeFile :: MonadIO m => FilePath -> Text -> m ()+writeFile = liftIO .: Text.writeFile++-- | Write a string the end of a file.+appendFile :: MonadIO m => FilePath -> Text -> m ()+appendFile = liftIO .: Text.appendFile++-- | The 'interact' function takes a function of type @Text -> Text@+-- as its argument. The entire input from the standard input device is+-- passed (lazily) to this function as its argument, and the resulting+-- string is output on the standard output device.+interact :: MonadIO m => (Text -> Text) -> m ()+interact = liftIO . Text.interact++-- | Lazily read all user input on 'stdin' as a single string.+getContents :: MonadIO m => m Text+getContents = liftIO Text.getContents++-- | Read a single line of user input from 'stdin'.+getLine :: MonadIO m => m Text+getLine = liftIO Text.getLine++-- | Write a string to 'stdout'.+putStr :: MonadIO m => Text -> m ()+putStr = liftIO . Text.putStr++-- | Write a string to 'stdout', followed by a newline.+putStrLn :: MonadIO m => Text -> m ()+putStrLn = liftIO . Text.putStrLn
+ src/Precursor/Text/Show.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts  #-}++module Precursor.Text.Show+  ( TextShow(..)+  , show+  , gShowPrec+  , print+  ) where++import           Data.Text.Lazy (Text)+import           TextShow+import           TextShow.Generic+import           GHC.Generics+import           Prelude ((.), Int)+import           Data.Text.Lazy.IO (putStrLn)+import           Control.Monad.IO.Class (MonadIO, liftIO)++show :: TextShow a => a -> Text+show = toLazyText . showb++gShowPrec :: (Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Builder+gShowPrec = genericShowbPrec++print :: (TextShow a, MonadIO m) => a -> m ()+print = liftIO . putStrLn . show
+ src/Precursor/Text/Text.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Precursor.Text.Text+  ( fromString+  , IsText(..)+  , IsBytes(..)+  , Text+  , ByteString+  , StrictText+  , StrictByteString+  , singleton+  , fromChunks+  , toChunks+  , toCaseFold+  , toLower+  , toUpper+  , toTitle+  , lines+  , words+  , unlines+  , unwords+  , isPrefixOf+  , isSuffixOf+  , isInfixOf+  ) where+++import qualified Data.ByteString               as Strict+import           Data.ByteString.Lazy          (ByteString)+import qualified Data.ByteString.Lazy          as ByteString+import qualified Data.Text                     as Strict+import qualified Data.Text.Encoding            as Strict+import           Data.Text.Encoding.Error+import           Data.Text.Lazy+import           Data.Text.Lazy.Encoding+import           GHC.Exts                      (fromString)+import           Precursor.Control.Applicative+import           Precursor.Control.Category+import           Precursor.Control.Functor+import           Precursor.Data.Either++type StrictText = Strict.Text+type StrictByteString = Strict.ByteString++class IsText a where+  {-# MINIMAL (fromText | fromText'), (readBytes | readBytes') #-}+  fromText   :: Text -> a+  fromText'  :: StrictText -> a+  readBytes' :: StrictByteString -> Either UnicodeException a+  readBytes  :: ByteString -> Either UnicodeException a+  fromText   = fromText'  . toStrict+  fromText'  = fromText   . fromStrict+  readBytes  = readBytes' . ByteString.toStrict+  readBytes' = readBytes  . ByteString.fromStrict++class IsText a => IsBytes a where+  {-# MINIMAL (fromBytes | fromBytes') #-}+  fromBytes  :: ByteString -> a+  fromBytes' :: StrictByteString -> a+  fromBytes  = fromBytes' . ByteString.toStrict+  fromBytes' = fromBytes . ByteString.fromStrict++instance IsText Text where+  fromText   = id+  fromText'  = fromStrict+  readBytes  = decodeUtf8'+  readBytes' = fmap fromStrict . Strict.decodeUtf8'++instance IsText Strict.Text where+  fromText   = toStrict+  fromText'  = id+  readBytes' = Strict.decodeUtf8'+  readBytes  = fmap toStrict  . decodeUtf8'++instance IsText ByteString where+  fromText  = encodeUtf8+  readBytes = pure++instance IsText Strict.ByteString where+  fromText'  = Strict.encodeUtf8+  readBytes' = pure++instance IsBytes ByteString where+  fromBytes = id++instance IsBytes Strict.ByteString where+  fromBytes' = id
+ test/Spec.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE TemplateHaskell #-}++import           Test.DocTest+import           Test.QuickCheck+import           Precursor++prop_OneIsOne :: Property+prop_OneIsOne = once (1 === (1 :: Integer))++return []++runTests :: IO Bool+runTests = $quickCheckAll++main :: IO Bool+main = do+  doctest [ "-isrc"+          , "src/Precursor.hs"+          , "src/Precursor/Control/Functor.hs"+          , "src/Precursor/Control/Applicative.hs"+          , "src/Precursor/Control/Alternative.hs"+          , "src/Precursor/Structure/Foldable.hs"+          , "src/Precursor/Structure/Traversable.hs"+          , "src/Precursor/Control/Category.hs"+          , "src/Precursor/Data/Bool.hs"+          , "src/Precursor/Data/Either.hs"+          , "src/Precursor/Control/Monad.hs"+          , "src/Precursor/Numeric/Num.hs"+          , "src/Precursor/Algebra/Semiring.hs"+          , "src/Precursor/Algebra/Semigroup.hs"+          , "src/Precursor/Algebra/Ring.hs"+          , "src/Precursor/Algebra/Monoid.hs"+          , "src/Precursor/Algebra/Eq.hs"+          , "src/Precursor/Algebra/Ord.hs"+          , "src/Precursor/Function.hs"+          , "src/Precursor/Data/Maybe.hs"+          , "src/Precursor/Data/Tuple.hs"+          , "src/Precursor/Data/List.hs"+          , "src/Precursor/Control/State.hs"+          , "src/Precursor/Data/Set.hs"+          , "src/Precursor/Data/Map.hs"+          , "src/Precursor/Control/Bifunctor.hs"+          , "src/Precursor/Debug.hs"+          , "src/Precursor/Text/Show.hs"+          , "src/Precursor/System/IO.hs"+          , "src/Precursor/Text/Text.hs"+          , "src/Precursor/Coerce.hs"+          , "src/Precursor/Algebra/Enum.hs" ]+  runTests