endo (empty) → 0.1.0.0
raw patch · 17 files changed
+1822/−0 lines, 17 filesdep +basedep +betweendep +transformerssetup-changed
Dependencies added: base, between, transformers
Files
- ChangeLog.md +14/−0
- LICENSE +30/−0
- README.md +257/−0
- Setup.hs +2/−0
- endo.cabal +116/−0
- example/Example/Config.hs +35/−0
- example/Example/Config/Lens.hs +32/−0
- example/Example/Config/Setters.hs +31/−0
- example/Example1.hs +29/−0
- example/Example2.hs +34/−0
- example/Example3.hs +35/−0
- example/Example4.hs +37/−0
- example/Example5.hs +30/−0
- example/Example6.hs +43/−0
- example/Example7.hs +119/−0
- src/Data/Monoid/Endo.hs +65/−0
- src/Data/Monoid/Endo/Fold.hs +913/−0
+ ChangeLog.md view
@@ -0,0 +1,14 @@+# ChangeLog / ReleaseNotes+++## Version 0.1.0.0++* First public release.+* Uploaded to [Hackage][]:+ <http://hackage.haskell.org/package/endo-0.1.0.0>++++[Hackage]:+ http://hackage.haskell.org/+ "HackageDB (or just Hackage) is a collection of releases of Haskell packages."
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013-2015, Peter Trško++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 Peter Trško 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.
+ README.md view
@@ -0,0 +1,257 @@+# Endo++[][Haskell.org]+[][tl;dr Legal: BSD3]+++## Description++Endomorphism utilities.+++## Usage Examples++Lets define simple application `Config` data type as:++````Haskell+data Verbosity = Silent | Normal | Verbose | Annoying+ deriving (Show)++data Config = Config+ { _verbosity :: Verbosity+ , _outputFile :: FilePath+ }+ deriving (Show)+````++Now lets define setters for `_verbosity` and `_outputFile`:++````Haskell+setVerbosity :: Verbosity -> E Config+setVerbosity b cfg = cfg{_verbosity = b}++setOutputFile :: FilePath -> E Config+setOutputFile b cfg = cfg{_outputFile = b}+````++Note that E is defined in `Data.Monoid.Endo` module and it looks like:++````Haskell+type E a = a -> a+````++Its purpose is to simplify type signatures.++Now lets get to our first example:++````Haskell+example1 :: E Config+example1 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile "an.out.put"+````++Above example shows us that it is possible to modify `Config` as if it was a+monoid, but without actually having to state it as such. In practice it is+not always possible to define it as `Monoid` or at least a `Semigroup`. What+usually works are endomorphisms, like in this example.++Now, `FilePath` has one pathological case, and that is `""`. There is a lot of+ways to handle it. Here we will concentrate only few basic techniques to+illustrate versatility of our approach.++````Haskell+-- | Trying to set output file to \"\" will result in keeping original value.+setOutputFile2 :: FilePath -> E Config+setOutputFile2 "" = id+setOutputFile2 fp = setOutputFile fp++example2 :: E Config+example2 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile2 "an.out.put"+````++Same as above, but exploits `instance AnEndo a => AnEndo Maybe a`:++````Haskell+setOutputFile3 :: FilePath -> Maybe (E Config)+setOutputFile3 "" = Nothing+setOutputFile3 fp = Just $ setOutputFile fp++example3 :: E Config+example3 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile3 "an.out.put"+````++Following example uses common pattern of using `Either` as error reporting+monad. This approach can be easily modified for arbitrary error reporting+monad.++````Haskell+setOutputFile4 :: FilePath -> Either String (E Config)+setOutputFile4 "" = Left "Output file: Empty file path."+setOutputFile4 fp = Right $ setOutputFile fp++example4 :: Either String (E Config)+example4 = appEndo <&$> foldEndo+ <*> pure (setVerbosity Annoying)+ <*> setOutputFile4 "an.out.put"+````++Notice, that above example uses applicative style. Normally when using this+style, for setting record values, one needs to keep in sync order of+constructor arguments and order of operations. Using `foldEndo` (and its+dual `dualFoldEndo`) doesn't have this restriction.++Instead of setter functions one may want to use lenses (in terms of+[lens package][Hackage: lens]):++````Haskell+verbosity :: Lens' Config Verbosity+verbosity = _verbosity ~@@^> \s b -> s{_verbosity = b}++outputFile :: Lens' Config FilePath+outputFile = _outputFile ~@@^> \s b -> s{_outputFile = b}+````++Now setting values of `Config` would look like:++````Haskell+example5 :: E Config+example5 = appEndo $ foldEndo+ &$ verbosity .~ Annoying+ &$ outputFile .~ "an.out.put"+````++Probably one of the most interesting things that can be done with this+module is following:++````Haskell+instance AnEndo Verbosity where+ type EndoOperatesOn Verbosity = Config+ anEndo = Endo . set verbosity++newtype OutputFile = OutputFile FilePath++instance AnEndo OutputFile where+ type EndoOperatesOn OutputFile = Config+ anEndo (OutputFile fp) = Endo $ outputFile .~ fp++example6 :: E Config+example6 = appEndo $ foldEndo+ &$ Annoying+ &$ OutputFile "an.out.put"+````+++### Using with optparse-applicative++This is a more complex example that defines parser for+[optparse-applicative][Hackage: optparse-applicative] built on top of some of+the above definitions:++````Haskell+options :: Parser Config+options = runIdentityT $ runEndo defaultConfig <$> options'+ where+ options' :: IdentityT Parser (Endo Config)+ options' = foldEndo+ <*> outputOption -- :: IdentityT Parser (Maybe (E Config))+ <*> verbosityOption -- :: IdentityT Parser (Maybe (E Config))+ <*> annoyingFlag -- :: IdentityT Parser (E Config)+ <*> silentFlag -- :: IdentityT Parser (E Config)+ <*> verboseFlag -- :: IdentityT Parser (E Config)++ defaultConfig :: Config+ defaultConfig = Config Normal ""++-- >>> :main -o an.out.put --annoying+-- Config {_verbosity = Annoying, _outputFile = "an.out.put"}+main :: IO ()+main = execParser (info options fullDesc) >>= print+````++Parsers for individual options and flags are wrapped in 'IdentityT', because+there is no `instance FoldEndoArgs r => FoldEndoArgs (Parser r)`, but there is+`instance FoldEndoArgs r => FoldEndoArgs (IdentityT r)`.++Functions used by the above code:++````Haskell+outputOption :: IdentityT Parser (Maybe (E Config))+outputOption =+ IdentityT . optional . option (set outputFile <$> parseFilePath)+ $ short 'o' <> long "output" <> metavar "FILE"+ <> help "Store output in to a FILE."+ where+ parseFilePath = eitherReader $ \s ->+ if null s+ then Left "Option argument can not be empty file path."+ else Right s++verbosityOption :: IdentityT Parser (Maybe (E Config))+verbosityOption =+ IdentityT . optional . option (set verbosity <$> parseVerbosity)+ $ long "verbosity" <> metavar "LEVEL" <> help "Set verbosity to LEVEL."+ where+ verbosityToStr = map toLower . Data.showConstr . Data.toConstr+ verbosityIntValues = [(show $ fromEnum v, v) | v <- [Silent .. Annoying]]+ verbosityStrValues =+ ("default", Normal) : [(verbosityToStr v, v) | v <- [Silent .. Annoying]]++ parseVerbosityError = unwords+ [ "Verbosity can be only number from interval"+ , show $ map fromEnum [minBound, maxBound :: Verbosity]+ , "or one of the following:"+ , concat . intersperse ", " $ map fst verbosityStrValues+ ]++ parseVerbosity = eitherReader $ \s ->+ case lookup s $ verbosityIntValues ++ verbosityStrValues of+ Just v -> Right v+ Nothing -> Left parseVerbosityError++annoyingFlag :: IdentityT Parser (E Config)+annoyingFlag = IdentityT . flag id (verbosity .~ Annoying)+ $ long "annoying" <> help "Set verbosity to maximum."++silentFlag :: IdentityT Parser (E Config)+silentFlag = IdentityT . flag id (verbosity .~ Silent)+ $ short 's' <> long "silent" <> help "Set verbosity to minimum."++verboseFlag :: IdentityT Parser (E Config)+verboseFlag = IdentityT . flag id (verbosity .~ Verbose)+ $ short 'v' <> long "verbose" <> help "Be verbose."+````+++Building Options+----------------++* `-fpedantic` (disabled by default)++ Pass additional warning flags to GHC.+++Contributions+-------------++Contributions, pull requests and bug reports are welcome! Please don't be+afraid to contact author using GitHub or by e-mail.++++[Hackage: lens]:+ http://hackage.haskell.org/package/lens+ "lens package on Hackage"+[Hackage: optparse-applicative]:+ http://hackage.haskell.org/package/optparse-applicative+ "optparse-applicative package on Hackage"+[Haskell.org]:+ http://www.haskell.org+ "The Haskell Programming Language"+[tl;dr Legal: BSD3]:+ https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29+ "BSD 3-Clause License (Revised)"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ endo.cabal view
@@ -0,0 +1,116 @@+name: endo+version: 0.1.0.0+synopsis: Endomorphism utilities.+description:+ Package defines extra functions for 'Data.Monoid.Endo' data type, and also+ generic endomorphism folding machinery. Generic endomorphism folding can be+ used for various purposes, including as a builder.+ .+ Here is an example how to use with+ <http://hackage.haskell.org/package/optparse-applicative optparse-applicative>+ package:+ .+ > data Verbosity = Silent | Normal | Verbose | Annoying+ > deriving (Show)+ .+ > data Config = Config Verbosity FilePath+ > deriving (Show)+ .+ > options :: Parser Config+ > options = runIdentityT $ runEndo defaultConfig <$> options'+ > where+ > options' :: IdentityT Parser (Endo Config)+ > options' = foldEndo+ > <*> outputOption -- IdentityT Parser (Maybe (E Config))+ > <*> verbosityOption -- IdentityT Parser (Maybe (E Config))+ > <*> annoyingFlag -- IdentityT Parser (E Config)+ > <*> silentFlag -- IdentityT Parser (E Config)+ > <*> verboseFlag -- IdentityT Parser (E Config)+ >+ > defaultConfig :: Config+ > defaultConfig = Config Normal ""+ .+ > main :: IO ()+ > main = execParser (info options fullDesc) >>= print+ .+ > ghci> :main -o an.out.put --annoying+ > Config Annoying "an.out.put"+ .+ For details how individual option parsers look like see module+ "Data.Monoid.Endo.Fold" which contains other examples as well as this one.++homepage: https://github.com/trskop/endo+bug-reports: https://github.com/trskop/endo/issues+license: BSD3+license-file: LICENSE+author: Peter Trško+maintainer: peter.trsko@gmail.com+copyright: (c) 2013-2015 Peter Trško+category: Data+build-type: Simple+cabal-version: >=1.10++-- Examples require lens and optparse-applicative packages in addition to this+-- packackage's dependencies. When using sandbox it is possible to use "cabal+-- repl" to test examples by using following command:+--+-- cabal repl \+-- --ghc-option="-iexample" \+-- --ghc-options="-package lens" \+-- --ghc-options="-package optparse-applicative" \+-- --ghc-options="-package transformers"+extra-source-files:+ ChangeLog.md+ , README.md+ , example/Example/Config/*.hs+ , example/Example/*.hs+ , example/*.hs++flag pedantic+ description: Pass additional warning flags to GHC.+ default: False+ manual: True++library+ hs-source-dirs: src+ exposed-modules:+ Data.Monoid.Endo+ , Data.Monoid.Endo.Fold++ default-language: Haskell2010+ other-extensions:+ DeriveDataTypeable+ , DeriveGeneric+ , FlexibleInstances+ , NoImplicitPrelude+ , TypeFamilies++ build-depends:+ -- {{{ Distributed with GHC or Haskell Platform ---------------------------+ base >=4.6 && <4.8+ , transformers >=0.3 && <0.5+ -- }}} Distributed with GHC or Haskell Platform ---------------------------++ , between == 0.9.*++ if impl(GHC >= 7.8)+ cpp-options: -DHAVE_MINIMAL_PRAGMA+ -DKIND_POLYMORPHIC_TYPEABLE+ if impl(GHC >= 7.9)+ cpp-options: -DAPPLICATIVE_MONAD++ ghc-options: -Wall+ if flag(pedantic)+ ghc-options:+ -fwarn-tabs+ -fwarn-implicit-prelude+-- -Werror++source-repository head+ type: git+ location: git://github.com/trskop/endo.git++source-repository this+ type: git+ location: git://github.com/trskop/endo.git+ tag: 0.1.0.0
+ example/Example/Config.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Simple example of Config data type.+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Simple example of 'Config' data type. Definitions from this package are used+-- in other examples.+module Example.Config (Config(..), Verbosity(..))+ where++import Prelude (Bounded, Enum)++import Data.Data (Data)+import Data.Eq (Eq)+import Data.Ord (Ord)+import Text.Show (Show)+import Data.Typeable (Typeable)+import System.IO (FilePath)+++data Verbosity = Silent | Normal | Verbose | Annoying+ deriving (Bounded, Data, Enum, Eq, Ord, Show, Typeable)++data Config = Config+ { _verbosity :: Verbosity+ , _outputFile :: FilePath+ }+ deriving (Show)
+ example/Example/Config/Lens.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Simple setters for Config data type.+-- Copyright: (c) 2013-2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Simple setters for 'Config' data type. Definitions from this package are+-- used in other examples.+module Example.Config.Lens+ ( outputFile+ , verbosity+ )+ where++import System.IO (FilePath)++import Control.Lens (Lens')+import Data.Function.Between ((~@@^>))++import Example.Config (Config(..), Verbosity)+++verbosity :: Lens' Config Verbosity+verbosity = _verbosity ~@@^> \s b -> s{_verbosity = b}++outputFile :: Lens' Config FilePath+outputFile = _outputFile ~@@^> \s b -> s{_outputFile = b}
+ example/Example/Config/Setters.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Simple setters for Config data type.+-- Copyright: (c) 2013-2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Simple setters for 'Config' data type. Definitions from this package are+-- used in other examples.+module Example.Config.Setters+ ( setOutputFile+ , setVerbosity+ )+ where++import System.IO (FilePath)++import Data.Monoid.Endo (E)++import Example.Config (Config(..), Verbosity)+++setVerbosity :: Verbosity -> E Config+setVerbosity b cfg = cfg{_verbosity = b}++setOutputFile :: FilePath -> E Config+setOutputFile b cfg = cfg{_outputFile = b}
+ example/Example1.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 1+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 1.+module Example1+ where++import Data.Function (($))+import Data.Monoid (Endo(appEndo))++import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold ((&$), foldEndo)++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Setters (setOutputFile, setVerbosity)+++example1 :: E Config+example1 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile "an.out.put"
+ example/Example2.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 2+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 2.+module Example2+ where++import Data.Function (($), id)+import Data.Monoid (Endo(appEndo))++import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold ((&$), foldEndo)++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Setters (setOutputFile, setVerbosity)+++-- | Trying to set output file to \"\" will result in keeping original value.+setOutputFile2 :: FilePath -> E Config+setOutputFile2 "" = id+setOutputFile2 fp = setOutputFile fp++example2 :: E Config+example2 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile2 "an.out.put"
+ example/Example3.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 3+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 3.+module Example3+ where++import Data.Function (($))+import Data.Maybe (Maybe(Just, Nothing))+import Data.Monoid (Endo(appEndo))+import System.IO (FilePath)++import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold ((&$), foldEndo)++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Setters (setOutputFile, setVerbosity)+++setOutputFile3 :: FilePath -> Maybe (E Config)+setOutputFile3 "" = Nothing+setOutputFile3 fp = Just $ setOutputFile fp++example3 :: E Config+example3 = appEndo $ foldEndo+ &$ setVerbosity Annoying+ &$ setOutputFile3 "an.out.put"
+ example/Example4.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 4+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 4.+module Example4+ where++import Control.Applicative (Applicative((<*>), pure))+import Data.Either (Either(Left, Right))+import Data.Function (($))+import Data.Monoid (Endo(appEndo))+import Data.String (String)+import System.IO (FilePath)++import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold (foldEndo, (<&$>))++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Setters (setOutputFile, setVerbosity)+++setOutputFile4 :: FilePath -> Either String (E Config)+setOutputFile4 "" = Left "Output file: Empty file path."+setOutputFile4 fp = Right $ setOutputFile fp++example4 :: Either String (E Config)+example4 = appEndo <&$> foldEndo+ <*> pure (setVerbosity Annoying)+ <*> setOutputFile4 "an.out.put"
+ example/Example5.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 5+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 5.+module Example5+ where++import Data.Function (($))+import Data.Monoid (Endo(appEndo))++import Control.Lens ((.~))+import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold ((&$), foldEndo)++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Lens (outputFile, verbosity)+++example5 :: E Config+example5 = appEndo $ foldEndo+ &$ verbosity .~ Annoying+ &$ outputFile .~ "an.out.put"
+ example/Example6.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module: $HEADER$+-- Description: Example 6+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude, TypeFamilies+--+-- Example 6.+module Example6+ where++import Data.Function ((.), ($))+import Data.Monoid (Endo(Endo, appEndo))+import System.IO (FilePath)++import Control.Lens ((.~), set)+import Data.Monoid.Endo (E)+import Data.Monoid.Endo.Fold (AnEndo(anEndo), EndoOperatesOn, (&$), foldEndo)++import Example.Config (Config, Verbosity(Annoying))+import Example.Config.Lens (outputFile, verbosity)+++-- Please ignore warning about orphan instances.+instance AnEndo Verbosity where+ type EndoOperatesOn Verbosity = Config+ anEndo = Endo . set verbosity++newtype OutputFile = OutputFile FilePath++instance AnEndo OutputFile where+ type EndoOperatesOn OutputFile = Config+ anEndo (OutputFile fp) = Endo $ outputFile .~ fp++example6 :: E Config+example6 = appEndo $ foldEndo+ &$ Annoying+ &$ OutputFile "an.out.put"
+ example/Example7.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Example 7+-- Copyright: (c) 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Example 2.+module Example7+ where++import Prelude (Bounded(maxBound, minBound), Enum(fromEnum))++import Control.Applicative (Applicative((<*>)), (<$>))+import Control.Monad (Monad((>>=)))+import Data.Char (toLower)+import qualified Data.Data as Data (Data(toConstr), showConstr)+import Data.Either (Either(Left, Right))+import Data.Function ((.), ($), id)+import Data.List ((++))+import Data.List (concat, intersperse, lookup, map, null, unwords)+import Data.Maybe (Maybe(Just, Nothing))+import Data.Monoid (Endo, (<>))+import Data.Tuple (fst)+import System.IO (IO, print)+import Text.Show (Show(show))++import Control.Monad.Trans.Identity (IdentityT(IdentityT, runIdentityT))++import Control.Lens ((.~), set)+import Options.Applicative+ ( Parser+ , eitherReader+ , execParser+ , flag+ , fullDesc+ , help+ , info+ , long+ , metavar+ , option+ , optional+ , short+ )++import Data.Monoid.Endo (E, runEndo)+import Data.Monoid.Endo.Fold (foldEndo)++import Example.Config (Config(Config), Verbosity(..))+import Example.Config.Lens (outputFile, verbosity)+++options :: Parser Config+options = runIdentityT $ runEndo defaultConfig <$> options'+ where+ options' :: IdentityT Parser (Endo Config)+ options' = foldEndo+ <*> outputOption -- :: IdentityT Parser (Maybe (E Config))+ <*> verbosityOption -- :: IdentityT Parser (Maybe (E Config))+ <*> annoyingFlag -- :: IdentityT Parser (E Config)+ <*> silentFlag -- :: IdentityT Parser (E Config)+ <*> verboseFlag -- :: IdentityT Parser (E Config)++ defaultConfig :: Config+ defaultConfig = Config Normal ""++-- >>> :main -o an.out.put --annoying+-- Config {_verbosity = Annoying, _outputFile = "an.out.put"}+main :: IO ()+main = execParser (info options fullDesc) >>= print++outputOption :: IdentityT Parser (Maybe (E Config))+outputOption =+ IdentityT . optional . option (set outputFile <$> parseFilePath)+ $ short 'o' <> long "output" <> metavar "FILE"+ <> help "Store output in to a FILE."+ where+ parseFilePath = eitherReader $ \s ->+ if null s+ then Left "Option argument can not be empty file path."+ else Right s++verbosityOption :: IdentityT Parser (Maybe (E Config))+verbosityOption =+ IdentityT . optional . option (set verbosity <$> parseVerbosity)+ $ long "verbosity" <> metavar "LEVEL" <> help "Set verbosity to LEVEL."+ where+ verbosityToStr = map toLower . Data.showConstr . Data.toConstr+ verbosityIntValues = [(show $ fromEnum v, v) | v <- [Silent .. Annoying]]+ verbosityStrValues =+ ("default", Normal) : [(verbosityToStr v, v) | v <- [Silent .. Annoying]]++ parseVerbosityError = unwords+ [ "Verbosity can be only number from interval"+ , show $ map fromEnum [minBound, maxBound :: Verbosity]+ , "or one of the following:"+ , concat . intersperse ", " $ map fst verbosityStrValues+ ]++ parseVerbosity = eitherReader $ \s ->+ case lookup s $ verbosityIntValues ++ verbosityStrValues of+ Just v -> Right v+ Nothing -> Left parseVerbosityError++annoyingFlag :: IdentityT Parser (E Config)+annoyingFlag = IdentityT . flag id (verbosity .~ Annoying)+ $ long "annoying" <> help "Set verbosity to maximum."++silentFlag :: IdentityT Parser (E Config)+silentFlag = IdentityT . flag id (verbosity .~ Silent)+ $ short 's' <> long "silent" <> help "Set verbosity to minimum."++verboseFlag :: IdentityT Parser (E Config)+verboseFlag = IdentityT . flag id (verbosity .~ Verbose)+ $ short 'v' <> long "verbose" <> help "Be verbose."
+ src/Data/Monoid/Endo.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- |+-- Module: $HEADER$+-- Description: Utilities for Endo data type.+-- Copyright: (c) 2013-2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: NoImplicitPrelude+--+-- Utilities for 'Endo' data type from "Data.Monoid" module.+module Data.Monoid.Endo+ (+ -- * Endo+ E+ , Endo(..)+ , runEndo+ , mapEndo+ , mapEndo2+ , liftEndo++ -- ** Lens+ , endo+ )+ where++import Data.Functor (Functor(fmap))+import Data.Monoid (Endo(..))++import Data.Function.Between ((~@~), (<~@~))+++-- | Type synonym for endomorphsm; it can be used simplify type signatures.+type E a = a -> a++-- | Transform function wrapped in 'Endo'.+mapEndo :: (E a -> E b) -> Endo a -> Endo b+mapEndo = Endo ~@~ appEndo+{-# INLINE mapEndo #-}++-- | Variation of 'mapEndo' for functions with arity two.+mapEndo2 :: (E a -> E b -> E c) -> Endo a -> Endo b -> Endo c+mapEndo2 = mapEndo ~@~ appEndo+{-# INLINE mapEndo2 #-}++-- | Apply 'fmap' to function wrapped in 'Endo'. It's a short hand for+-- @'mapEndo' 'fmap'@.+liftEndo :: Functor f => Endo a -> Endo (f a)+liftEndo (Endo f) = Endo (fmap f)+{-# INLINE liftEndo #-}++-- | Flipped version of 'appEndo'.+runEndo :: a -> Endo a -> a+runEndo x (Endo f) = f x+{-# INLINE runEndo #-}++-- | Lens for 'Endo'. In terms of /lens/ package it would have type:+--+-- > endo :: Lens (Endo a) (Endo b) (E a) (E b)+--+-- For details see <http://hackage.haskell.org/package/lens lens package>.+endo :: Functor f => (E a -> f (E b)) -> Endo a -> f (Endo b)+endo = Endo <~@~ appEndo+{-# INLINE endo #-}
+ src/Data/Monoid/Endo/Fold.hs view
@@ -0,0 +1,913 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeFamilies #-}++#ifdef KIND_POLYMORPHIC_TYPEABLE+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if MIN_VERSION_transformers(0,4,0)+-- ExceptT was introduced in transformers == 0.4.0.0 and it deprecated ErrorT.+-- That is also the reason why ErrorT instance is not provided.+#define HAVE_EXCEPTT+#endif++-- |+-- Module: $HEADER$+-- Description: Generic folding for various endomorphism representations.+-- Copyright: (c) 2014, 2015 Peter Trsko+-- License: BSD3+--+-- Maintainer: peter.trsko@gmail.com+-- Stability: experimental+-- Portability: CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances,+-- NoImplicitPrelude, TypeFamilies+--+-- Generic folding for various endomorphism representations.+module Data.Monoid.Endo.Fold+ (+ -- * Usage Examples+ -- $usageExample++ -- ** Using with optparse-applicative+ -- $optparseApplicativeExample++ -- * Generic Endomorphism Folding+ foldEndo+ , dualFoldEndo++ -- ** Type Classes+ , FoldEndoArgs(..)+ , AnEndo(..)++ -- ** Type Wrappers+ , WrappedFoldable(..)++ -- * Utility Functions+ , (&$)+ , (<&$>)+ )+ where++import Control.Applicative (Applicative(pure))+import Control.Monad (Monad(return))+import Data.Either (Either(Right))+import Data.Foldable (Foldable(foldMap))+import Data.Function ((.), id)+import Data.Functor (Functor(fmap))+import Data.Functor.Identity (Identity(Identity))+import Data.Maybe (Maybe(Just, Nothing))+import Data.Monoid (Dual(Dual), Endo(Endo), Monoid(mempty, mconcat), (<>))+import GHC.Generics (Generic)+import System.IO (IO)+import Text.Read (Read)+import Text.Show (Show)++#ifdef KIND_POLYMORPHIC_TYPEABLE+import Data.Data (Data)+import Data.Typeable (Typeable)+#endif++#if HAVE_EXCEPTT+import Control.Monad.Trans.Except (ExceptT)+#endif+import Control.Monad.Trans.Identity (IdentityT)+import Control.Monad.Trans.List (ListT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.Reader (ReaderT)+import Control.Monad.Trans.RWS (RWST)+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)+import Control.Monad.Trans.State (StateT)+import qualified Control.Monad.Trans.State.Strict as Strict (StateT)+import Control.Monad.Trans.Writer (WriterT)+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)+import Data.Functor.Compose (Compose)+import Data.Functor.Product (Product)+import Data.Functor.Reverse (Reverse)+++-- | Fold all variously represented endomorphisms in to one endomorphism.+--+-- Order in which endomorphisms are folded is preserved:+--+-- >>> foldEndo (Endo (1:)) [(2:), (3:)] `appEndo` []+-- [1,2,3]+--+-- For numbers it would look like:+--+-- >>> foldEndo (Endo (+1)) [(+2), (*3)] `appEndo` 1+-- 6+--+-- Above can be seen as:+--+-- >>> (+1) . (+2) . (*3) $ 1+-- 6+foldEndo :: FoldEndoArgs args => args+foldEndo = foldEndoArgs mempty++-- | Same as 'foldEndo', but folds endomorphisms in reverse order.+--+-- Following are the same examples as for 'foldEndo' function. Please, note the+-- differences in results.+--+-- Order in which endomorphisms are folded is reversed:+--+-- >>> dualFoldEndo (Endo (1:)) [(2:), (3:)] `appEndo` []+-- [2,3,1]+--+-- For numbers it would look like:+--+-- >>> dualFoldEndo (Endo (+1)) [(+2), (*3)] `appEndo` 1+-- 12+--+-- Above can be seen as:+--+-- >>> (*3) . (+2) . (+1) $ 1+-- 12+dualFoldEndo :: FoldEndoArgs args => args+dualFoldEndo = dualFoldEndoArgs mempty++-- {{{ FoldEndoArgs Type Class ------------------------------------------------++-- | Class of arguments for 'foldEndo' and its dual 'dualFoldEndo' functions.+--+-- Note that results are instances of this ('FoldEndoArgs') class and+-- endomorphism representations are instances of 'AnEndo' type class.+class FoldEndoArgs a where+ -- | Extracts type of a value that is modified by the result.+ type ResultOperatesOn a++ foldEndoArgs :: Endo (ResultOperatesOn a) -> a+ dualFoldEndoArgs :: Dual (Endo (ResultOperatesOn a)) -> a+#ifdef HAVE_MINIMAL_PRAGMA+ {-# MINIMAL foldEndoArgs, dualFoldEndoArgs #-}+#endif++instance+ ( AnEndo a+ , FoldEndoArgs r+ , EndoOperatesOn a ~ ResultOperatesOn r+ ) => FoldEndoArgs (a -> r)+ where+ type ResultOperatesOn (a -> r) = ResultOperatesOn r+ foldEndoArgs e e' = foldEndoArgs (e <> anEndo e')+ dualFoldEndoArgs e e' = dualFoldEndoArgs (e <> aDualEndo e')++instance FoldEndoArgs (Endo a) where+ type ResultOperatesOn (Endo a) = a+ foldEndoArgs = id+ dualFoldEndoArgs (Dual e) = e++instance FoldEndoArgs r => FoldEndoArgs (Either e r) where+ type ResultOperatesOn (Either e r) = ResultOperatesOn r+ foldEndoArgs = Right . foldEndoArgs+ dualFoldEndoArgs = Right . dualFoldEndoArgs++instance FoldEndoArgs r => FoldEndoArgs (Identity r) where+ type ResultOperatesOn (Identity r) = ResultOperatesOn r+ foldEndoArgs = Identity . foldEndoArgs+ dualFoldEndoArgs = Identity . dualFoldEndoArgs++instance FoldEndoArgs r => FoldEndoArgs (IO r) where+ type ResultOperatesOn (IO r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++instance FoldEndoArgs r => FoldEndoArgs (Maybe r) where+ type ResultOperatesOn (Maybe r) = ResultOperatesOn r+ foldEndoArgs = Just . foldEndoArgs+ dualFoldEndoArgs = Just . dualFoldEndoArgs++-- {{{ Transformers -----------------------------------------------------------++-- {{{ Functor Transformers ---------------------------------------------------++instance+ (Applicative f, Applicative g, FoldEndoArgs r)+ => FoldEndoArgs (Compose f g r)+ where+ type ResultOperatesOn (Compose f g r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++instance+ (Applicative f, Applicative g, FoldEndoArgs r)+ => FoldEndoArgs (Product f g r)+ where+ type ResultOperatesOn (Product f g r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++-- }}} Functor Transformers ---------------------------------------------------++-- {{{ Monad Transformers -----------------------------------------------------++-- | This instance can be used in cases when there is no 'FoldEndoArgs'+-- instance for a specific 'Applicative' functor. Example:+--+-- @+-- 'Control.Monad.Trans.Identity.runIdentityT' $ 'foldEndo'+-- \<*\> 'IdentityT' parseSomething+-- \<*\> 'IdentityT' parseSomethingElse+-- @+instance (Applicative f, FoldEndoArgs r) => FoldEndoArgs (IdentityT f r) where+ type ResultOperatesOn (IdentityT f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++#if HAVE_EXCEPTT+instance (Applicative f, FoldEndoArgs r) => FoldEndoArgs (ExceptT e f r) where+ type ResultOperatesOn (ExceptT e f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs+#endif++instance (Applicative f, FoldEndoArgs r) => FoldEndoArgs (ListT f r) where+ type ResultOperatesOn (ListT f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++instance+ ( Monad m+#ifndef APPLICATIVE_MONAD+ , Functor m+#endif+ , FoldEndoArgs r+ ) => FoldEndoArgs (MaybeT m r) where+ type ResultOperatesOn (MaybeT m r) = ResultOperatesOn r+ foldEndoArgs = return . foldEndoArgs+ dualFoldEndoArgs = return . dualFoldEndoArgs++instance (Applicative f, FoldEndoArgs r) => FoldEndoArgs (ReaderT r' f r) where+ type ResultOperatesOn (ReaderT r' f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++instance+ ( Monad m+#ifndef APPLICATIVE_MONAD+ , Functor m+#endif+ , Monoid w+ , FoldEndoArgs r+ ) => FoldEndoArgs (RWST r' w s m r)+ where+ type ResultOperatesOn (RWST r' w s m r) = ResultOperatesOn r+ foldEndoArgs = return . foldEndoArgs+ dualFoldEndoArgs = return . dualFoldEndoArgs++instance+ ( Monad m+#ifndef APPLICATIVE_MONAD+ , Functor m+#endif+ , Monoid w+ , FoldEndoArgs r+ ) => FoldEndoArgs (Strict.RWST r' w s m r)+ where+ type ResultOperatesOn (Strict.RWST r' w s m r) = ResultOperatesOn r+ foldEndoArgs = return . foldEndoArgs+ dualFoldEndoArgs = return . dualFoldEndoArgs++instance (Monad m, FoldEndoArgs r) => FoldEndoArgs (StateT s m r) where+ type ResultOperatesOn (StateT s m r) = ResultOperatesOn r+ foldEndoArgs = return . foldEndoArgs+ dualFoldEndoArgs = return . dualFoldEndoArgs++instance (Monad m, FoldEndoArgs r) => FoldEndoArgs (Strict.StateT s m r) where+ type ResultOperatesOn (Strict.StateT s m r) = ResultOperatesOn r+ foldEndoArgs = return . foldEndoArgs+ dualFoldEndoArgs = return . dualFoldEndoArgs++instance+ (Applicative f, FoldEndoArgs r, Monoid w) => FoldEndoArgs (WriterT w f r)+ where+ type ResultOperatesOn (WriterT w f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++instance+ (Applicative f, FoldEndoArgs r, Monoid w)+ => FoldEndoArgs (Strict.WriterT w f r)+ where+ type ResultOperatesOn (Strict.WriterT w f r) = ResultOperatesOn r+ foldEndoArgs = pure . foldEndoArgs+ dualFoldEndoArgs = pure . dualFoldEndoArgs++-- }}} Monad Transformers -----------------------------------------------------++-- }}} Transformers -----------------------------------------------------------++-- {{{ FoldEndoArgs Type Class ------------------------------------------------++-- {{{ AnEndo Type Class ------------------------------------------------------++-- | Class that represents various endomorphism representation. In other words+-- anything that encodes @a -> a@ can be instance of this class.+class AnEndo a where+ -- | Extract type on which endomorphism operates, e.g. for+ -- @'Endo' a@ it would be @a@.+ type EndoOperatesOn a++ -- | Convert value encoding @a -> a@ in to 'Endo'.+ anEndo :: a -> Endo (EndoOperatesOn a)++ -- | Dual to 'anEndo'. Default implementation:+ --+ -- @+ -- 'aDualEndo' = 'Dual' . 'anEndo'+ -- @+ aDualEndo :: a -> Dual (Endo (EndoOperatesOn a))+ aDualEndo = Dual . anEndo++#if HAVE_MINIMAL_PRAGMA+ {-# MINIMAL anEndo #-}+#endif++instance AnEndo (Endo a) where+ type EndoOperatesOn (Endo a) = a+ anEndo = id++instance AnEndo (a -> a) where+ type EndoOperatesOn (a -> a) = a+ anEndo = Endo++instance AnEndo a => AnEndo (Maybe a) where+ type EndoOperatesOn (Maybe a) = EndoOperatesOn a++ anEndo Nothing = mempty+ anEndo (Just e) = anEndo e++-- {{{ Foldable Instances -----------------------------------------------------++-- | Wrapper for 'Foldable' instances.+--+-- This allows using 'foldEndo' and 'dualFoldEndo' for any 'Foldable' instance+-- without the need for @OverlappingInstances@ language extension.+newtype WrappedFoldable f a = WrapFoldable {getFoldable :: f a}+ deriving+ ( Generic+ , Read+ , Show+#ifdef KIND_POLYMORPHIC_TYPEABLE+ , Data+ , Typeable+#endif+ )++instance (Foldable f, AnEndo a) => AnEndo (WrappedFoldable f a) where+ type EndoOperatesOn (WrappedFoldable f a) = EndoOperatesOn a+ anEndo (WrapFoldable fa) = foldMap anEndo fa+ aDualEndo (WrapFoldable fa) = foldMap aDualEndo fa++instance AnEndo a => AnEndo [a] where+ type EndoOperatesOn [a] = EndoOperatesOn a+ anEndo = anEndo . WrapFoldable+ aDualEndo = aDualEndo . WrapFoldable++-- {{{ Transformers -----------------------------------------------------------++-- | Fold in reverese order.+instance (Foldable f, AnEndo a) => AnEndo (Reverse f a) where+ type EndoOperatesOn (Reverse f a) = EndoOperatesOn a+ anEndo = anEndo . WrapFoldable+ aDualEndo = aDualEndo . WrapFoldable++-- }}} Transformers -----------------------------------------------------------++-- }}} Foldable Instances -----------------------------------------------------++-- {{{ Instances For Tuples ---------------------------------------------------++instance+ ( AnEndo a+ , AnEndo b+ , EndoOperatesOn a ~ EndoOperatesOn b+ ) => AnEndo (a, b)+ where+ type EndoOperatesOn (a, b) = EndoOperatesOn a+ anEndo (a, b) = anEndo a <> anEndo b+ aDualEndo (a, b) = aDualEndo a <> aDualEndo b++instance+ ( AnEndo a+ , AnEndo b+ , AnEndo c+ , EndoOperatesOn a ~ EndoOperatesOn b+ , EndoOperatesOn a ~ EndoOperatesOn c+ ) => AnEndo (a, b, c)+ where+ type EndoOperatesOn (a, b, c) = EndoOperatesOn a+ anEndo (a, b, c) = anEndo a <> anEndo b <> anEndo c+ aDualEndo (a, b, c) = aDualEndo a <> aDualEndo b <> aDualEndo c++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ ) => AnEndo (a1, a2, a3, a4)+ where+ type EndoOperatesOn (a1, a2, a3, a4) = EndoOperatesOn a1+ anEndo (a1, a2, a3, a4) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ ]++ aDualEndo (a1, a2, a3, a4) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ ) => AnEndo (a1, a2, a3, a4, a5)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ ]++ aDualEndo (a1, a2, a3, a4, a5) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , AnEndo a6+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a6+ ) => AnEndo (a1, a2, a3, a4, a5, a6)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5, a6) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5, a6) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ , anEndo a6+ ]++ aDualEndo (a1, a2, a3, a4, a5, a6) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ , aDualEndo a6+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , AnEndo a6+ , AnEndo a7+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a6+ , EndoOperatesOn a1 ~ EndoOperatesOn a7+ ) => AnEndo (a1, a2, a3, a4, a5, a6, a7)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5, a6, a7) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5, a6, a7) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ , anEndo a6+ , anEndo a7+ ]++ aDualEndo (a1, a2, a3, a4, a5, a6, a7) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ , aDualEndo a6+ , aDualEndo a7+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , AnEndo a6+ , AnEndo a7+ , AnEndo a8+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a6+ , EndoOperatesOn a1 ~ EndoOperatesOn a7+ , EndoOperatesOn a1 ~ EndoOperatesOn a8+ ) => AnEndo (a1, a2, a3, a4, a5, a6, a7, a8)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5, a6, a7, a8) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5, a6, a7, a8) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ , anEndo a6+ , anEndo a7+ , anEndo a8+ ]++ aDualEndo (a1, a2, a3, a4, a5, a6, a7, a8) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ , aDualEndo a6+ , aDualEndo a7+ , aDualEndo a8+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , AnEndo a6+ , AnEndo a7+ , AnEndo a8+ , AnEndo a9+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a6+ , EndoOperatesOn a1 ~ EndoOperatesOn a7+ , EndoOperatesOn a1 ~ EndoOperatesOn a8+ , EndoOperatesOn a1 ~ EndoOperatesOn a9+ ) => AnEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5, a6, a7, a8, a9) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ , anEndo a6+ , anEndo a7+ , anEndo a8+ , anEndo a9+ ]++ aDualEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ , aDualEndo a6+ , aDualEndo a7+ , aDualEndo a8+ , aDualEndo a9+ ]++instance+ ( AnEndo a1+ , AnEndo a2+ , AnEndo a3+ , AnEndo a4+ , AnEndo a5+ , AnEndo a6+ , AnEndo a7+ , AnEndo a8+ , AnEndo a9+ , AnEndo a10+ , EndoOperatesOn a1 ~ EndoOperatesOn a2+ , EndoOperatesOn a1 ~ EndoOperatesOn a3+ , EndoOperatesOn a1 ~ EndoOperatesOn a4+ , EndoOperatesOn a1 ~ EndoOperatesOn a5+ , EndoOperatesOn a1 ~ EndoOperatesOn a6+ , EndoOperatesOn a1 ~ EndoOperatesOn a7+ , EndoOperatesOn a1 ~ EndoOperatesOn a8+ , EndoOperatesOn a1 ~ EndoOperatesOn a9+ , EndoOperatesOn a1 ~ EndoOperatesOn a10+ ) => AnEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)+ where+ type EndoOperatesOn (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = EndoOperatesOn a1++ anEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = mconcat+ [ anEndo a1+ , anEndo a2+ , anEndo a3+ , anEndo a4+ , anEndo a5+ , anEndo a6+ , anEndo a7+ , anEndo a8+ , anEndo a9+ , anEndo a10+ ]++ aDualEndo (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = mconcat+ [ aDualEndo a1+ , aDualEndo a2+ , aDualEndo a3+ , aDualEndo a4+ , aDualEndo a5+ , aDualEndo a6+ , aDualEndo a7+ , aDualEndo a8+ , aDualEndo a9+ , aDualEndo a10+ ]++-- }}} Instances For Tuples ---------------------------------------------------+-- }}} AnEndo Type Class ------------------------------------------------------++-- {{{ Utility Functions ------------------------------------------------------++-- | Variant of function @('Data.Function.$') :: (a -> b) -> a -> b@ from+-- "Data.Function" module, but with fixity as @(&) :: a -> (a -> b) -> b@+-- function from <http://hackage.haskell.org/package/lens lens package>.+(&$) :: (a -> b) -> a -> b+f &$ a = f a+infixl 1 &$++-- | Variant of function+-- @('Data.Functor.<$>') :: 'Data.Functor.Functor' f => (a -> b) -> a -> b@+-- from "Data.Functor" module, but with fixity as '&$' function.+(<&$>) :: Functor f => (a -> b) -> f a -> f b+(<&$>) = fmap+infixl 1 <&$>++-- }}} Utility Functions ------------------------------------------------------++-- $usageExample+--+-- Lets define simple application @Config@ data type as:+--+-- @+-- data Verbosity = Silent | Normal | Verbose | Annoying+-- deriving (Bounded, Data, Enum, Eq, Ord, Show, Typeable)+--+-- data Config = Config+-- { _verbosity :: Verbosity+-- , _outputFile :: FilePath+-- }+-- deriving (Show)+-- @+--+-- Now lets define setters for @_verbosity@ and @_outputFile@:+--+-- @+-- setVerbosity :: Verbosity -> 'Data.Monoid.Endo.E' Config+-- setVerbosity b cfg = cfg{_verbosity = b}+--+-- setOutputFile :: FilePath -> 'Data.Monoid.Endo.E' Config+-- setOutputFile b cfg = cfg{_outputFile = b}+-- @+--+-- Note that 'Data.Monoid.Endo.E' is defined in "Data.Monoid.Endo" module and+-- it looks like:+--+-- @+-- type 'Data.Monoid.Endo.E' a = a -> a+-- @+--+-- Its purpose is to simplify type signatures.+--+-- Now lets get to our first example:+--+-- @+-- example1 :: 'Data.Monoid.Endo.E' Config+-- example1 = 'Data.Monoid.appEndo' '$' 'foldEndo'+-- '&$' setVerbosity Annoying+-- '&$' setOutputFile \"an.out.put\"+-- @+--+-- Above example shows us that it is possible to modify @Config@ as if it was a+-- monoid, but without actually having to state it as such. In practice it is+-- not always possible to define it as 'Monoid' or at least a @Semigroup@. What+-- usually works are endomorphisms, like in this example.+--+-- Now, 'System.IO.FilePath' has one pathological case, and that is \"\". There+-- is a lot of ways to handle it. Here we will concentrate only few basic+-- techniques to illustrate versatility of our approach.+--+-- @+-- -- | Trying to set output file to \"\" will result in keeping original+-- -- value.+-- setOutputFile2 :: FilePath -> 'Data.Monoid.Endo.E' Config+-- setOutputFile2 \"\" = id+-- setOutputFile2 fp = setOutputFile fp+--+-- example2 :: 'Data.Monoid.Endo.E' Config+-- example2 = 'Data.Monoid.appEndo' $ 'foldEndo'+-- '&$' setVerbosity Annoying+-- '&$' setOutputFile2 \"an.out.put\"+-- @+--+-- Same as above, but exploits @instance 'AnEndo' a => 'AnEndo' 'Maybe' a@:+--+-- @+-- setOutputFile3 :: FilePath -> Maybe ('Data.Monoid.Endo.E' Config)+-- setOutputFile3 "" = Nothing+-- setOutputFile3 fp = Just $ setOutputFile fp+--+-- example3 :: 'Data.Monoid.Endo.E' Config+-- example3 = 'Data.Monoid.appEndo' $ 'foldEndo'+-- '&$' setVerbosity Annoying+-- '&$' setOutputFile3 \"an.out.put\"+-- @+--+-- Following example uses common pattern of using 'Either' as error reporting+-- monad. This approach can be easily modified for arbitrary error reporting+-- monad.+--+-- @+-- setOutputFile4 :: FilePath -> Either String ('Data.Monoid.Endo.E' Config)+-- setOutputFile4 "" = Left \"Output file: Empty file path.\"+-- setOutputFile4 fp = Right $ setOutputFile fp+--+-- example4 :: Either String ('Data.Monoid.Endo.E' Config)+-- example4 = 'Data.Monoid.appEndo' '<&$>' 'foldEndo'+-- 'Control.Applicative.<*>' 'pure' (setVerbosity Annoying)+-- 'Control.Applicative.<*>' setOutputFile4 \"an.out.put\"+-- @+--+-- Notice, that above example uses applicative style. Normally when using this+-- style, for setting record values, one needs to keep in sync order of+-- constructor arguments and order of operations. Using 'foldEndo' (and its+-- dual 'dualFoldEndo') doesn't have this restriction.+--+-- Instead of setter functions one may want to use lenses (in terms of+-- <http://hackage.haskell.org/package/lens lens package>):+--+-- @+-- verbosity :: Lens' Config Verbosity+-- verbosity =+-- _verbosity 'Data.Function.Between.~@@^>' \\s b -> s{_verbosity = b}+--+-- outputFile :: Lens' Config FilePath+-- outputFile =+-- _outputFile 'Data.Function.Between.~@@^>' \\s b -> s{_outputFile = b}+-- @+--+-- Now setting values of @Config@ would look like:+--+-- @+-- example5 :: 'Data.Monoid.Endo.E' Config+-- example5 = 'Data.Monoid.appEndo' $ 'foldEndo'+-- '&$' verbosity .~ Annoying+-- '&$' outputFile .~ \"an.out.put\"+-- @+--+-- Probably one of the most interesting things that can be done with this+-- module is following:+--+-- @+-- instance 'AnEndo' Verbosity where+-- type 'EndoOperatesOn' Verbosity = Config+-- 'anEndo' = Endo . set verbosity+--+-- newtype OutputFile = OutputFile FilePath+--+-- instance 'AnEndo' OutputFile where+-- type 'EndoOperatesOn' OutputFile = Config+-- 'anEndo' (OutputFile fp) = 'Endo' $ outputFile .~ fp+--+-- example6 :: 'Data.Monoid.Endo.E' Config+-- example6 = 'Data.Monoid.appEndo' $ 'foldEndo'+-- '&$' Annoying+-- '&$' OutputFile \"an.out.put\"+-- @++-- $optparseApplicativeExample+--+-- This is a more complex example that defines parser for+-- <http://hackage.haskell.org/package/optparse-applicative optparse-applicative>+-- built on top of some of the above definitions:+--+-- @+-- options :: Parser Config+-- options = 'Control.Monad.Trans.Identity.runIdentityT' $ 'Control.Monad.Endo.runEndo' defaultConfig \<$\> options'+-- where+-- options' :: 'IdentityT' Parser ('Endo' Config)+-- options' = 'foldEndo'+-- \<*\> outputOption -- :: IdentityT Parser (Maybe (E Config))+-- \<*\> verbosityOption -- :: IdentityT Parser (Maybe (E Config))+-- \<*\> annoyingFlag -- :: IdentityT Parser (E Config)+-- \<*\> silentFlag -- :: IdentityT Parser (E Config)+-- \<*\> verboseFlag -- :: IdentityT Parser (E Config)+--+-- defaultConfig :: Config+-- defaultConfig = Config Normal \"\"+--+-- main :: IO ()+-- main = execParser (info options fullDesc) \>\>= print+-- @+--+-- Example of running above @main@ function:+--+-- >>> :main -o an.out.put --annoying+-- Config {_verbosity = Annoying, _outputFile = "an.out.put"}+--+-- Parsers for individual options and flags are wrapped in 'IdentityT', because+-- there is no @instance 'FoldEndoArgs' r =\> 'FoldEndoArgs' (Parser r)@, but+-- there is @instance 'FoldEndoArgs' r =\> 'FoldEndoArgs' ('IdentityT' r)@.+--+-- Functions used by the above code:+--+-- @+-- outputOption :: 'IdentityT' Parser (Maybe ('Data.Monoid.Endo.E' Config))+-- outputOption =+-- IdentityT . optional . option (set outputFile \<$\> parseFilePath)+-- $ short \'o\' \<\> long \"output\" \<\> metavar \"FILE\"+-- \<\> help \"Store output in to a FILE.\"+-- where+-- parseFilePath = eitherReader $ \\s ->+-- if null s+-- then Left \"Option argument can not be empty file path.\"+-- else Right s+--+-- verbosityOption :: 'IdentityT' Parser (Maybe ('Data.Monoid.Endo.E' Config))+-- verbosityOption =+-- 'IdentityT' . optional . option (set verbosity \<$\> parseVerbosity)+-- $ long \"verbosity\" \<\> metavar \"LEVEL\" \<\> help \"Set verbosity to LEVEL.\"+-- where+-- verbosityToStr = map toLower . Data.showConstr . Data.toConstr+-- verbosityIntValues = [(show $ fromEnum v, v) | v <- [Silent .. Annoying]]+-- verbosityStrValues =+-- ("default", Normal) : [(verbosityToStr v, v) | v <- [Silent .. Annoying]]+--+-- parseVerbosityError = unwords+-- [ "Verbosity can be only number from interval"+-- , show $ map fromEnum [minBound, maxBound :: Verbosity]+-- , "or one of the following:"+-- , concat . intersperse ", " $ map fst verbosityStrValues+-- ]+--+-- parseVerbosity = eitherReader $ \s ->+-- case lookup s $ verbosityIntValues ++ verbosityStrValues of+-- Just v -> Right v+-- Nothing -> Left parseVerbosityError+--+-- annoyingFlag :: 'IdentityT' Parser ('Data.Monoid.Endo.E' Config)+-- annoyingFlag = 'IdentityT' . flag id (verbosity .~ Annoying)+-- $ long \"annoying\" \<\> help \"Set verbosity to maximum.\"+--+-- silentFlag :: 'IdentityT' Parser ('Data.Monoid.Endo.E' Config)+-- silentFlag = 'IdentityT' . flag id (verbosity .~ Silent)+-- $ short 's' \<\> long "silent" \<\> help \"Set verbosity to minimum.\"+--+-- verboseFlag :: 'IdentityT' Parser ('Data.Monoid.Endo.E' Config)+-- verboseFlag = 'IdentityT' . flag id (verbosity .~ Verbose)+-- $ short 'v' \<\> long \"verbose\" \<\> help \"Be verbose.\"+-- @