packages feed

derive-monoid (empty) → 0.0.0

raw patch · 15 files changed

+779/−0 lines, 15 filesdep +basedep +derive-monoiddep +semigroupssetup-changed

Dependencies added: base, derive-monoid, semigroups, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Sam Boosalis++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.
+ Main.hs view
@@ -0,0 +1,1 @@+import Derive.List.Main
+ README.md view
@@ -0,0 +1,5 @@+# derive-monoid+when your type can hold a list of itself, you can derive simple (but total/lawful) Semigroup/Monoid/IsList instances with TemplateHaskell. ++see [Derive.Monoid](https://hackage.haskell.org/package/derive-monoid/docs/Derive-Monoid.html) on hackage for examples and documentation. +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ derive-monoid.cabal view
@@ -0,0 +1,75 @@+name: derive-monoid+version: 0.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+maintainer: samboosalis@gmail.com+homepage: https://github.com/sboosali/derive-monoid#readme +category: derive-monoid +author: Spiros Boosalis+extra-source-files:+    README.md+synopsis: derive Semigroup/Monoid/IsList+description:+ when your type can hold a list of itself, you can derive simple (but total\/lawful) Semigroup\/Monoid\/IsList instances with TemplateHaskell. + . + see the <https://hackage.haskell.org/package/derive-monoid/docs/Derive-List.html Derive.List> for examples and documentation. + browse the <https://github.com/sboosali/derive-monoid/tree/master/test/Build/Derive/List test suite> for more (buildable) examples:  + .+ * <https://github.com/sboosali/derive-monoid/blob/master/test/Build/Derive/List/HigherKind.hs HigherKind>+ .+ * <https://github.com/sboosali/derive-monoid/blob/master/test/Build/Derive/List/IsList.hs IsList> + .+ * <https://github.com/sboosali/derive-monoid/blob/master/test/Build/Derive/List/Monoid.hs Monoid>+ .+ * <https://github.com/sboosali/derive-monoid/blob/master/test/Build/Derive/List/Semigroup.hs Semigroup>++source-repository head+    type: git+    location: https://github.com/sboosali/derive-monoid+++library+ hs-source-dirs: sources+ default-language: Haskell2010++ exposed-modules:+  Derive.List+  Derive.List.Internal +  Derive.List.Main+  Derive.List.Extra ++ build-depends:+    base ==4.8.* +  , semigroups ==0.18.* +  , template-haskell ==2.10.*+++executable example+ hs-source-dirs: .+ default-language: Haskell2010+ main-is: Main.hs+ build-depends:+    base ==4.8.* +  , derive-monoid +++test-suite tests+ hs-source-dirs: test + main-is: Tests.hs+ type: exitcode-stdio-1.0+ default-language: Haskell2010++ other-modules:+  Build.Derive.List +  Build.Derive.List.Monoid   +  Build.Derive.List.Semigroup+  Build.Derive.List.IsList+  Build.Derive.List.HigherKind++ build-depends:+    base ==4.8.* +  , derive-monoid +  , semigroups ==0.18.* +
+ sources/Derive/List.hs view
@@ -0,0 +1,191 @@+{-# OPTIONS_HADDOCK not-home #-}++module Derive.List + ( -- $introduction++   -- $example++   -- $conclusion++   deriveList+ , deriveMonoid+ , deriveSemigroup+ , deriveIsList+ , DeriveListConfig(..)+ , deriveListWith + , deriveMonoidWith+ , deriveSemigroupWith+ , deriveIsListWith+   -- $alternatives++ ) where +import Derive.List.Internal ++++++{- $introduction++when your type can hold a list of itself, 'deriveList' can generate instances for: ++* 'Semigroup'+* 'Monoid'+* 'IsList'++which are lawful (trivially, being based on the list instances).++usage: ++@+data T = ... | C [T] | ...+deriveList ''T 'C+@++-} ++++++-- $example+-- = Examples +-- +-- this declaration: +-- +-- @+-- +-- {-\# LANGUAGE TemplateHaskell, TypeFamilies \#-}    -- minimal extensions necessary +-- {-\# OPTIONS_GHC -ddump-splices \#-}                -- prints out the generated code +-- +-- import GHC.Exts (IsList (..))                     -- minimal imports necessary +-- import Data.Semigroup                             -- from the <https://hackage.haskell.org/package/semigroups semigroups> package +-- +-- -- a sum type +-- data Elisp+--  = ElispAtom (Either String Integer)+--  | ElispSexp [Elisp]+-- +-- 'deriveList' \'\'Elisp \'ElispSexp+-- @+-- +-- generates these instances: +-- +-- @+-- instance 'Semigroup' Elisp where+--  ('<>') x y = ElispSexp (toElispList x '<>' toElispList y)+-- +-- instance 'Monoid' Elisp where+--  'mempty' = emptyElisp+--  'mappend' = ('<>')+-- +-- instance 'IsList' Elisp where+--  type 'Item' Elisp = Elisp+--  'fromList' = ElispSexp+--  'toList' = toElispList +-- +-- emptyElisp :: ElispSexp+-- emptyElisp = ElispSexp []+-- +-- toElispList :: Elisp -> [Elisp]+-- toElispList (ElispSexp ts) = ts+-- toElispList t = [t]+-- +-- @ +-- ++++++{- $conclusion+++= Documentation ++you can document functions/variables (though not instances), by placing their signatures __after__ the macro:++@+data Elisp+ = ElispAtom (Either String Integer)+ | ElispSexp [Elisp]++'deriveList' \'\'Elisp \'ElispSexp++-- | ...+emptyElisp  :: Elisp +-- | ...+appendElisp :: Elisp -> Elisp -> Elisp+-- | ...+toElispList :: Elisp -> [Elisp]+@+++= Kind++works on type constructors of any kind. that is, a polymorphic @Elisp@ would work too:  ++@+data Elisp a + = ElispAtom a + | ElispSexp [Elisp a]++'deriveList' \'\'Elisp \'ElispSexp++@+++= Selecting Instances +if you don't want all three instances, you can use one of: ++* 'deriveMonoid'+* 'deriveSemigroup'+* 'deriveIsList'++but only one, as they would generate duplicate declarations. +++-} ++++++{- $alternatives++= Alternatives to @derive-monoid@ ++* manual instances.  +* @GeneralizeNewtypeDeriving@: works with @newtype@, but not with @data@. +* the <http://hackage.haskell.org/package/semigroups semigroups> package: derives a different semigroup (i.e. pairwise appending, when your type is a product type), which isn't valid for sum types. +* the <http://hackage.haskell.org/package/derive derive> package: derives a different monoid (i.e. pairwise appending, when your type is a product type), which isn't valid for sum types. it also doesn't work with Semigroup. ++-} ++++++{-++TODO pattern EmptyElisp = ElispSexp []++TODO Or with fewer extensions and dependencies: ++@+'deriveMonoidWith' defaultDeriveListConfig{ _usePatternSynonyms=False } \'\'Elisp \'ElispSexp+@++generates: ++@+instance 'Monoid' Elisp where+ mempty = EmptyElisp [] + mappend x y = ElispSexp (mappend (toElispList x toElispList y))+ where + toElispList :: Elisp -> [Elisp]+ toElispList (ElispSexp ts) = ts+ toElispList t = [t]+@++-}
+ sources/Derive/List/Extra.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TemplateHaskell, LambdaCase #-}+module Derive.List.Extra where ++import Language.Haskell.TH+import Control.Monad+++{-| saturates a type constructor with type variables. outputs a 'Type' of kind @*@. ++>>> :set -XTemplateHaskell  +>>> import Language.Haskell.TH+>>> $(printQ (saturateT ''Bool))+ConT GHC.Types.Bool +>>> $(printQ (saturateT ''[]))+AppT (ConT GHC.Types.[]) (VarT a)+>>> $(printQ (saturateT ''Either))+AppT (AppT (ConT Data.Either.Either) (VarT a)) (VarT b)++-- >>> $(printQ (saturateT_ 'False))+-- Exception when trying to run compile-time code:+--   the name {{GHC.Types.False}} has no arity (maybe it's been given to some macro that expects a Type?)++output is deterministic.++-}+saturateT :: Name -> Q Type +-- saturateT = conT+saturateT n = do+ arity_ <- getArityT n+ let arity = maybe (error$ messageNoArity n) id arity_+ let arguments = take arity (map mkName alphabeticalVariables) + return$ foldl AppT (ConT n) (VarT <$> arguments) + where + messageNoArity n = "the name {{" ++ show n ++ "}} has no arity (maybe it's been given to some macro that expects a Type?)"++{-| >>> take 3 alphabeticalVariables +["a","b","c"]+-}+alphabeticalVariables :: [String]+alphabeticalVariables = map (:[]) ['a'..'z'] ++ do+  x <- ['a'..'z']+  y <- ['a'..'z']+  return [x, y]++{-| get the arity of a (type) name. ++>>> :set -XTemplateHaskell  +>>> import Language.Haskell.TH+>>> $(printQ (getArityT ''Bool))+Just 0+>>> $(printQ (getArityT 'False))+Nothing+>>> $(printQ (getArityT ''Either))+Just 2++-}+getArityT :: Name -> Q (Maybe Int)+getArityT n = getArityI <$> reify n ++{-| get the arity of a type constructor or a primitive type constructor, by name. ++-}+getArityI :: Info -> Maybe Int+getArityI = \case + TyConI d -> getArityD d+ PrimTyConI _ arity _ -> Just arity+ _ -> Nothing ++{-| get the arity of a @data@ or a @newtype@. ++TODO saturate @type@ synonym0++-}+getArityD :: Dec -> Maybe Int+getArityD = \case + DataD    _ _ variables _ _ -> Just (length variables)+ NewtypeD _ _ variables _ _ -> Just (length variables)+ -- TySynD Name [TyVarBndr] Type+ _ -> Nothing ++{-| show the result of a Template Haskell action, in IO.++>>> :set -XTemplateHaskell  +>>> import Language.Haskell.TH+>>> $(printQ $ reify ''Bool)+TyConI (DataD [] GHC.Types.Bool [] [NormalC GHC.Types.False [],NormalC GHC.Types.True []] [])++works around @"Template Haskell error: Can't do `reify' in the IO monad"@, +which prevents them from being printed directly.  ++see <http://stackoverflow.com/questions/16690925/template-haskell-reify-in-ghci stackoverflow>++-}+printQ :: (Show a) => Q a -> Q Exp+printQ q = go <$> q+ where + go x = VarE 'putStrLn `AppE` (LitE . StringL . show) x++-- getVariableName :: TyVarBndr -> Name +-- getVariableName = \case +--  PlainTV name    -> name 	+--  KindedTV name _ -> name +
+ sources/Derive/List/Internal.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, RecordWildCards #-}+{-| (@.Internal@ modules may violate the PVP) -}+module Derive.List.Internal where +import Derive.List.Extra ++import Data.Semigroup ++import Language.Haskell.TH+import GHC.Exts (IsList (..))+++data DeriveListConfig = DeriveListConfig+ { _getEmptyName  :: String -> String + , _getAppendName :: String -> String + , _getToListName :: String -> String + -- , _usePatternSynonyms :: Bool+ -- , _useSemigroup :: Bool+ }++data DeriveListNames = DeriveListNames+ { theType :: Name + , theConstructor :: Name + , theEmpty :: Name + , theAppend :: Name + , theToList :: Name + } deriving (Show,Eq,Ord)++++{-| derives 'Semigroup', 'Monoid', 'IsList'.  +-}+deriveList :: Name -> Name -> DecsQ +deriveList = deriveListWith defaultDeriveListConfig+++{-| derives 'Semigroup', 'Monoid' only. +-}+deriveMonoid :: Name -> Name -> DecsQ +deriveMonoid = deriveMonoidWith defaultDeriveListConfig+++{-| derives 'Semigroup' only. +-}+deriveSemigroup :: Name -> Name -> DecsQ +deriveSemigroup = deriveSemigroupWith defaultDeriveListConfig+++{-| derives 'IsList' only.  +-}+deriveIsList :: Name -> Name -> DecsQ +deriveIsList = deriveIsListWith defaultDeriveListConfig+++{-| derives 'Semigroup', 'Monoid', 'IsList'.  +-}+deriveListWith :: DeriveListConfig -> Name -> Name -> DecsQ +deriveListWith config@DeriveListConfig{..} theType theConstructor = fmap concat . traverse id $ + [ deriveSemigroup_ names + , deriveMonoid_ names + , deriveIsList_ names + , makeEmpty names + , makeAppend names + , makeToList names + ] + where + names = makeDeriveListNames config theType theConstructor +++{-| derives 'Semigroup', 'Monoid' only. +-}+deriveMonoidWith :: DeriveListConfig -> Name -> Name -> DecsQ +deriveMonoidWith config@DeriveListConfig{..} theType theConstructor = fmap concat . traverse id $ + [ deriveMonoid_ names + , makeEmpty names + , makeAppend names + , makeToList names + ] + where + names = makeDeriveListNames config theType theConstructor +++{-| derives 'Semigroup' only. +-}+deriveSemigroupWith :: DeriveListConfig -> Name -> Name -> DecsQ +deriveSemigroupWith config@DeriveListConfig{..} theType theConstructor = fmap concat . traverse id $ + [ deriveSemigroup_ names + , makeAppend names + , makeToList names + ] + where + names = makeDeriveListNames config theType theConstructor +++{-| derives 'IsList' only.  +-}+deriveIsListWith :: DeriveListConfig -> Name -> Name -> DecsQ +deriveIsListWith config@DeriveListConfig{..} theType theConstructor = fmap concat . traverse id $ + [ deriveIsList_ names + , makeToList names + ] + where + names = makeDeriveListNames config theType theConstructor +++{-| ++needs no constraints.+ +assumes 'makeAppend'++-}+deriveSemigroup_ :: DeriveListNames -> DecsQ +deriveSemigroup_ DeriveListNames{..} = do + [d| instance Semigroup $theTypeT where+       (<>) = $theAppendE+       {-# INLINEABLE (<>) #-} |]++ where + theTypeT = saturateT theType + theAppendE = varE theAppend +++{-| ++needs no constraints.++assumes 'makeAppend', 'makeEmpty'++-}+deriveMonoid_ :: DeriveListNames -> DecsQ +deriveMonoid_ DeriveListNames{..} = do + [d| instance Monoid $theTypeT where+      mempty = $theEmptyE+      {-# INLINEABLE mempty #-}+      mappend = $theAppendE+      {-# INLINEABLE mappend #-} |]++ where + theTypeT = saturateT theType + theEmptyE = varE theEmpty + theAppendE = varE theAppend +++{-| ++needs no constraints.++assumes 'makeToList'++-}+deriveIsList_ :: DeriveListNames -> DecsQ +deriveIsList_ DeriveListNames{..} = do + [d| instance IsList $theTypeT where+      type Item $theTypeT = $theTypeT+      fromList = $theConstructorE+      {-# INLINEABLE fromList #-}+      toList = $theToListE +      {-# INLINEABLE toList #-} |]++ where + theTypeT = saturateT theType + theConstructorE = conE theConstructor + theToListE = varE theToList +++{-| `PatternSynonyms` won't work until <https://ghc.haskell.org/trac/ghc/ticket/8761> ++-}+makeEmpty :: DeriveListNames -> DecsQ+makeEmpty DeriveListNames{..} = return [definitionD, inlinableD]+ where + definitionD = FunD theEmpty [Clause [] (NormalB bodyE) []]+ bodyE = ConE theConstructor `AppE` (ListE [])+ inlinableD = PragmaD (InlineP theEmpty Inlinable ConLike AllPhases) -- TODO ConLike?++-- makeEmpty :: DeriveListNames -> DecsQ+-- makeEmpty DeriveListNames{..} = patternQD +--  where +--  patternQD = [d|pattern $theEmptyQP = $theConstructorQE []|]  +--  theEmptyQP = return$ ConP theEmpty []+--  theConstructorQE = return$ ConE theConstructor++-- [d|pattern $theEmptyQP = $theConstructorQE []|] +++{-| ++assumes 'makeToList'++-}+makeAppend :: DeriveListNames -> DecsQ+makeAppend DeriveListNames{..} = do+ definitionD <- [d| $theAppendP = \x y -> $theConstructorE ($theToListE x <> $theToListE y) |]+ return$ concat [definitionD, inlinableD]++ where + theConstructorE = conE theConstructor + theToListE = varE theToList + theAppendP = varP theAppend + inlinableD = [PragmaD (InlineP theAppend Inlinable FunLike AllPhases)]++ -- [d| $theAppendP x y = $theConstructorE ($theToListE x <> $theToListE y) |]+++makeToList :: DeriveListNames -> DecsQ+makeToList DeriveListNames{..} = traverse id [definitionD, inlinableD]+ where ++ definitionD = do+  tsN <- newName "ts"+  tN <- newName "t"+  return$ FunD theToList+   [ Clause [ConP theConstructor [VarP tsN]] (NormalB (VarE tsN))        [] +   , Clause [VarP tN]                        (NormalB (ListE [VarE tN])) [] +   ]++ inlinableD = return$ PragmaD (InlineP theToList Inlinable FunLike AllPhases)++-- [d|+--    $theListName :: $theType -> [$theType]+--    $theListName ($theConstructor ts) = ts+--    $theListName t = [t]+-- ]++++{-| can debug 'deriveList' with:  ++@+print $ makeDeriveListNames 'defaultDeriveListConfig' \'\'T \'C+@++-}+makeDeriveListNames :: DeriveListConfig -> Name -> Name -> DeriveListNames+makeDeriveListNames DeriveListConfig{..} theType theConstructor = DeriveListNames{..}+ where + theEmpty  = mkName $ _getEmptyName  (nameBase theType) + theAppend = mkName $ _getAppendName (nameBase theType) + theToList = mkName $ _getToListName (nameBase theType) +++{-| by default, the functions generated for a type @"T"@ are @"emptyT"@ and @"toTList"@. ++-}+defaultDeriveListConfig :: DeriveListConfig +defaultDeriveListConfig = DeriveListConfig{..}+ where+ _getEmptyName  = (\typename -> "empty"<>typename)+ _getAppendName = (\typename -> "append"<>typename)+ _getToListName = (\typename -> "to"<>typename<>"List")+ -- _usePatternSynonyms = True+ -- _useSemigroup = True+
+ sources/Derive/List/Main.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedLists #-} -- TODO PatternSynonyms, +-- {-# OPTIONS_GHC -ddump-splices #-}  -- for debugging +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_HADDOCK show-extensions #-}++{-| (see source) ++-}+module Derive.List.Main where +import Derive.List.Internal ++import Data.Semigroup ++import GHC.Exts (IsList (..))+import Language.Haskell.TH+++data Elisp+ = ElispAtom (Either String Integer)+ | ElispSexp [Elisp]+ deriving (Show)++deriveList ''Elisp 'ElispSexp++-- | the generated emptyElisp can be documented +emptyElisp  :: Elisp +-- | the generated appendElisp can be documented +appendElisp :: Elisp -> Elisp -> Elisp+-- | the generated toElispList can be documented +toElispList :: Elisp -> [Elisp]++{-| tests all instances and declarations ++-}+main = do+ putStrLn "" + print $ makeDeriveListNames defaultDeriveListConfig ''Elisp 'ElispSexp+ putStrLn "" + print$ emptyElisp+ print$ toElispList (ElispAtom (Right 1))+ print$ ElispSexp [ElispAtom (Left "+"), ElispAtom (Right 1), ElispAtom (Right 2)] <> mempty <> ElispAtom (Right 3)+
+ test/Build/Derive/List.hs view
@@ -0,0 +1,10 @@+{-| build-time tests (see their sources)++-}+module Build.Derive.List where ++import Build.Derive.List.Monoid   () +import Build.Derive.List.Semigroup()  +import Build.Derive.List.IsList   () +import Build.Derive.List.HigherKind() +
+ test/Build/Derive/List/HigherKind.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedLists #-}+{-# OPTIONS_GHC -ddump-splices #-} -- for debugging +module Build.Derive.List.HigherKind where +import Derive.List+import Data.Semigroup +import GHC.Exts (IsList (..))++data Elisp a + = ElispAtom a + | ElispSexp [Elisp a]+ deriving (Show)++deriveList ''Elisp 'ElispSexp++main = do+ putStrLn "" + print$ (emptyElisp :: Elisp Bool)+ print$ toElispList (ElispAtom True)+ print$ ElispSexp [ElispAtom (Left "&&"), ElispAtom (Right True), ElispAtom (Right True)] <> mempty <> ElispAtom (Right False)
+ test/Build/Derive/List/IsList.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedLists #-}+{-# OPTIONS_GHC -ddump-splices #-} -- for debugging +module Build.Derive.List.IsList where +import Derive.List+import GHC.Exts (IsList (..))++data Elisp+ = ElispAtom (Either String Integer)+ | ElispSexp [Elisp]+ deriving (Show)++deriveIsList ''Elisp 'ElispSexp++main = do+ putStrLn "" + print$ toElispList (ElispAtom (Right 1))+ print$ ([ElispAtom (Left "+"), ElispAtom (Right 1), ElispAtom (Right 2)] :: [Elisp]) +
+ test/Build/Derive/List/Monoid.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -ddump-splices #-} -- for debugging +module Build.Derive.List.Monoid where +import Derive.List+import Data.Monoid++data Elisp+ = ElispAtom (Either String Integer)+ | ElispSexp [Elisp]+ deriving (Show)++deriveMonoid ''Elisp 'ElispSexp++main = do+ putStrLn "" + print$ emptyElisp+ print$ toElispList (ElispAtom (Right 1))+ print$ ElispSexp [ElispAtom (Left "+"), ElispAtom (Right 1), ElispAtom (Right 2)] `mappend` mempty `mappend` ElispAtom (Right 3)
+ test/Build/Derive/List/Semigroup.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -ddump-splices #-} -- for debugging +module Build.Derive.List.Semigroup where +import Derive.List+import Data.Semigroup ++data Elisp+ = ElispAtom (Either String Integer)+ | ElispSexp [Elisp]+ deriving (Show)++deriveSemigroup ''Elisp 'ElispSexp++main = do+ putStrLn ""+ print$ toElispList (ElispAtom (Right 1))+ print$ ElispSexp [ElispAtom (Left "+"), ElispAtom (Right 1), ElispAtom (Right 2)] <> ElispAtom (Right 3)+
+ test/Tests.hs view
@@ -0,0 +1,4 @@+module Main where+import Build.Derive.List() ++main = return()