packages feed

first-and-last (empty) → 0.1.0.0

raw patch · 7 files changed

+390/−0 lines, 7 filesdep +Cabaldep +basedep +first-and-lastsetup-changed

Dependencies added: Cabal, base, first-and-last

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Mark Andrus Roberts++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 Mark Andrus Roberts nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dist/build/GoldenStub/GoldenStub-tmp/GoldenStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import Golden ( tests )+main :: IO ()+main = stubMain tests
+ first-and-last.cabal view
@@ -0,0 +1,44 @@+name:                first-and-last+version:             0.1.0.0+synopsis:            First and Last generalized to return up to n values+description:+  This library provides data types @<Data-Monoid-First.html#t:First-39- First' n>@ and @<Data-Monoid-Last.html#t:Last-39- Last' n>@ generalizing @First@ and @Last@ from @<https://hackage.haskell.org/package/base/docs/Data-Monoid.html Data.Monoid>@ to return up to @n@ values.+  .+  >>> getFirst' (foldMap pure [1,2,3,4] :: First' 2 Int)+  [1,2]+  .+  >>> getLast' (foldMap pure [1,2,3,4] :: Last' 2 Int)+  [3,4]+  .+  It also provides API-compatible type synonyms @<Data-Monoid-First.html#t:First First>@ and @<Data-Monoid-Last.html#t:Last Last>@ as well as functions @<Data-Monoid-First.html#v:getFirst getFirst>@ and @<Data-Monoid-Last.html#v:getLast getLast>@, allowing you to use it as a drop-in replacement.+homepage:            https://github.com/markandrus/first-and-last+license:             BSD3+license-file:        LICENSE+author:              Mark Andrus Roberts+maintainer:          markandrusroberts@gmail.com+copyright:           Copyright (C) 2015 Mark Andrus Roberts+category:            Data+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/markandrus/first-and-last++library+  exposed-modules:     Data.Monoid.First,+                       Data.Monoid.Last+  build-depends:       base >=4.8 && <4.9+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite Golden+  type:                detailed-0.9+  test-module:         Golden+  build-depends:       base >=4.8 && <4.9,+                       Cabal >=1.22.4,+                       first-and-last+  hs-source-dirs:      test+  default-language:    Haskell2010+  ghc-options:         -Wall
+ src/Data/Monoid/First.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}+-------------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.First+-- Copyright   :  (C) 2015 Mark Andrus Roberts+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Mark Andrus Roberts <markandrusroberts@gmail.com>+-- Stability   :  provisional+--+-- @'First'' n@ is a generalization of the @First@ exported by @Data.Monoid@:+-- whereas @Data.Monoid.First@ returns up to one value, @'First'' n@ returns+-- up to @n@ values.+--+-- @+-- Data.Monoid.First    a ≡+--             'First'' 1 a ≡+--             'First'    a+-- @+--+-- This library also provides an API-compatible type synonym 'First' and+-- function 'getFirst' allowing you to use it as a drop-in replacement.+-------------------------------------------------------------------------------+module Data.Monoid.First+  ( -- * @First@+    First+  , getFirst+    -- * @First'@+  , First'+  , getFirst'+  ) where++import Control.Applicative (Applicative((<*>), pure), Alternative)+import Data.Data (Data)+import Data.Proxy (Proxy(Proxy))+import Data.String (IsString(fromString))+import GHC.Generics (Generic, Generic1)+import GHC.TypeLits (KnownNat, Nat, natVal)+import Prelude (($), (.), Char, Eq, Foldable(foldr), Functor, Maybe(Just, Nothing), Monoid(mappend, mempty), Ord, Read, Show, Traversable, fromIntegral, head, take)++--------------------------------------------------------------------------------+-- * First+--------------------------------------------------------------------------------++-- | A type isomorphic to @Data.Monoid.First@+type First a = First' 1 a++-- | Get the first value of type @a@, if any.+--+-- >>> getFirst (foldMap pure [])+-- Nothing+--+-- >>> getFirst (foldMap pure [1,2,3,4])+-- Just 1+getFirst :: First a -> Maybe a+getFirst (First' []) = Nothing+getFirst (First' as) = Just . head $ take 1 as++--------------------------------------------------------------------------------+-- * First'+--------------------------------------------------------------------------------++-- | A generalized version of @Data.Monoid.First@+newtype First' (n :: Nat) a = First' { _getFirst' :: [a] } deriving +  ( Alternative+  , Data+  , Eq+  , Foldable+  , Functor+  , Generic+  , Generic1+  , Ord+  , Read+  , Show+  , Traversable+  )++-- | Get the first @n@ values or fewer of type @a@.+--+-- >>> getFirst' (foldMap pure [1,2,3,4] :: First' 0 Int)+-- []+--+-- >>> getFirst' (foldMap pure [1,2,3,4] :: First' 1 Int)+-- [1]+--+-- >>> getFirst' (foldMap pure [1,2,3,4] :: First' 2 Int)+-- [1,2]+getFirst' :: First' n a -> [a]+getFirst' = _getFirst'++instance KnownNat n => Applicative (First' n) where+  First' l <*> First' r = First' $ l <*> r+  pure a = case natVal (Proxy :: Proxy n) of+    0 -> mempty+    _ -> First' $ pure a++instance KnownNat n => Monoid (First' n a) where+  First' l `mappend` First' r =+    let n = fromIntegral $ natVal (Proxy :: Proxy n)+    in  First' . take n $ l `mappend` r+  mempty = First' mempty++instance KnownNat n => IsString (First' n Char) where+  fromString = foldr (\c a -> pure c `mappend` a) mempty
+ src/Data/Monoid/Last.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}+-------------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Last+-- Copyright   :  (C) 2015 Mark Andrus Roberts+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Mark Andrus Roberts <markandrusroberts@gmail.com>+-- Stability   :  provisional+--+-- @'Last'' n@ is a generalization of the @Last@ exported by @Data.Monoid@:+-- whereas @Data.Monoid.Last@ returns up to one value, @'Last'' n@ returns+-- up to @n@ values.+--+-- @+-- Data.Monoid.Last    a ≡+--             'Last'' 1 a ≡+--             'Last'    a+-- @+--+-- This library also provides an API-compatible type synonym 'Last' and+-- function 'getLast' allowing you to use it as a drop-in replacement.+-------------------------------------------------------------------------------+module Data.Monoid.Last+  ( -- * @Last@+    Last+  , getLast+    -- * @Last'@+  , Last'+  , getLast'+  ) where++import Control.Applicative (Applicative((<*>), pure), Alternative)+import Data.Data (Data)+import Data.Proxy (Proxy(Proxy))+import Data.String (IsString(fromString))+import GHC.Generics (Generic, Generic1)+import GHC.TypeLits (KnownNat, Nat, natVal)+import Prelude (($), (.), Char, Eq, Foldable(foldr), Functor, Int, Maybe(Just, Nothing), Monoid(mappend, mempty), Ord, Read, Show, Traversable, fromIntegral, drop, error, head)++--------------------------------------------------------------------------------+-- * Last+--------------------------------------------------------------------------------++-- | A type isomorphic to @Data.Monoid.Last@+type Last a = Last' 1 a++-- | Get the last value of type @a@, if any.+--+-- >>> getLast (foldMap pure [])+-- Nothing+--+-- >>> getLast (foldMap pure [1,2,3,4])+-- Just 4+getLast :: Last a -> Maybe a+getLast (Last' []) = Nothing+getLast (Last' as) = Just . head $ takeR 1 as++--------------------------------------------------------------------------------+-- * Last'+--------------------------------------------------------------------------------++-- | A generalized version of @Data.Monoid.Last@+newtype Last' (n :: Nat) a = Last' { _getLast' :: [a] } deriving+  ( Alternative+  , Data+  , Eq+  , Foldable+  , Functor+  , Generic+  , Generic1+  , Ord+  , Read+  , Show+  , Traversable+  )++-- | Get the last @n@ values or fewer of type @a@.+--+-- >>> getLast' (foldMap pure [1,2,3,4] :: Last' 0 Int)+-- []+--+-- >>> getLast' (foldMap pure [1,2,3,4] :: Last' 1 Int)+-- [4]+--+-- >>> getLast' (foldMap pure [1,2,3,4] :: Last' 2 Int)+-- [3,4]+getLast' :: Last' n a -> [a]+getLast' = _getLast'++instance KnownNat n => Applicative (Last' n) where+  Last' l <*> Last' r = Last' $ l <*> r+  pure a = case natVal (Proxy :: Proxy n) of+    0 -> mempty+    _ -> Last' $ pure a++instance KnownNat n => Monoid (Last' n a) where+  Last' l `mappend` Last' r =+    let n = fromIntegral $ natVal (Proxy :: Proxy n)+    in  Last' . takeR n $ l `mappend` r+  mempty = Last' mempty++-- https://www.joachim-breitner.de/blog/600-On_taking_the_last_n_elements_of_a_list+takeR :: Int -> [a] -> [a]+takeR n l = go (drop n l) l+  where+    go [] r = r+    go (_:xs) (_:ys) = go xs ys+    go (_:_) [] = error "impossible!"++instance KnownNat n => IsString (Last' n Char) where+  fromString = foldr (\c a -> pure c `mappend` a) mempty
+ test/Golden.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+-------------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.First+-- Copyright   :  (C) 2015 Mark Andrus Roberts+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Mark Andrus Roberts <markandrusroberts@gmail.com>+-- Stability   :  provisional+-------------------------------------------------------------------------------+module Golden where++import Data.Monoid.First+import Data.Monoid.Last+import Distribution.TestSuite (Progress(Finished), Result(Error, Pass), Test(Test), TestInstance(TestInstance, name, options, run, setOption, tags))+import Prelude (($), (++), (.), Bool, Eq((==)), Char, Int, IO, Show(show), String, foldMap, pure)++assert :: String -> Bool -> String -> Test+assert name' assertion error' =+  let test = TestInstance+        { name      = name'+        , options   = []+        , run       = pure . Finished $+                        if assertion+                          then Pass+                          else Error error'+        , setOption = \_ _ -> pure test+        , tags      = []+        }+  in  Test test++assertEqual :: (Eq a, Show a) => (a, a) -> Test+assertEqual (a, b)+  = assert (show a ++ " == " ++ show b) (a == b) (show a ++ " /= " ++ show b)++firstTest :: Test+firstTest = assertEqual+  (getFirst (foldMap pure [1, 2, 3, 4]), pure 1)++first'0PureTest :: Test+first'0PureTest = assertEqual+  (getFirst' (pure 1 :: First' 0 Int), [])++first'OverloadedStringTest :: Test+first'OverloadedStringTest = assertEqual+  ("abcd" :: First' 2 Char, "ab" :: First' 2 Char)++firstOverloadedStringTest :: Test+firstOverloadedStringTest = assertEqual+  ("abcd" :: First Char, "a" :: First Char)++lastTest :: Test+lastTest = assertEqual+  (getLast (foldMap pure [1, 2, 3, 4]), pure 4)++last'0PureTest :: Test+last'0PureTest = assertEqual+  (getLast' (pure 1 :: Last' 0 Int), [])++last'OverloadedStringTest :: Test+last'OverloadedStringTest = assertEqual+  ("abcd" :: Last' 2 Char, "cd" :: Last' 2 Char)++lastOverloadedStringTest :: Test+lastOverloadedStringTest = assertEqual+  ("abcd" :: Last Char, "d" :: Last Char)++tests :: IO [Test]+tests = pure+  [ firstTest+  , first'0PureTest+  , first'OverloadedStringTest+  , firstOverloadedStringTest+  , lastTest+  , last'0PureTest+  , last'OverloadedStringTest+  , lastOverloadedStringTest+  ]