sum-type-boilerplate (empty) → 0.1.0

raw patch · 8 files changed

+455/−0 lines, 8 filesdep +HUnitdep +basedep +hlint

Dependencies added: HUnit, base, hlint, hspec, template-haskell

Files

CHANGELOG.md +6/−0
LICENSE.md +19/−0
README.md +68/−0
library/SumTypes/TH.hs +232/−0
sum-type-boilerplate.cabal +70/−0
tests/HLint.hs +18/−0
tests/Spec.hs +1/−0
tests/SumTypes/THSpec.hs +41/−0

+ CHANGELOG.md view

@@ -0,0 +1,6 @@+# sum-type-boilerplate Changelog++## 0.1.0++* Initial release. Includes a TH function to create a sum type and two TH+  functions to convert between sum types.

+ LICENSE.md view

@@ -0,0 +1,19 @@+Copyright (c) 2017 David Reaver++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,68 @@+# sum-type-boilerplate: A Haskell sum type library++[![CircleCI](https://circleci.com/gh/jdreaver/sum-type-boilerplate.svg?style=svg)](https://circleci.com/gh/jdreaver/sum-type-boilerplate)++This library allows users to use Template Haskell to easily construct and+manipulate sum types. It was born out of the author's desire to reduce the+boilerplate associated with sum types while keeping the type safety they+provide.++## Sum Types++A sum type (also called+a [tagged union](https://en.wikipedia.org/wiki/Tagged_union)) looks like this+in Haskell:++```haskell+data MySum+  = MySumTypeA TypeA+  | MySumTypeB TypeB+  | MySumTypeC TypeC+```++Constructing this when you have a large number of types can be error-prone if+you intend to have a uniform naming scheme, and if you intend to only have each+type present once.++If you have many sum types with overlapping sets of types, then functions to+convert between them can be full of boilerplate.++```haskell+data OtherSum+  = OtherSumTypeA TypeA+  | OtherSumTypeB TypeB++otherSumToMySum :: OtherSum -> MySum+otherSumToMySum (OtherSumTypeA typeA) = MySumTypeA typeA+otherSumToMySum (OtherSumTypeB typeB) = MySumTypeB typeB++mySumToOtherSum :: MySum -> Maybe OtherSum+mySumToOtherSum (MySumTypeA typeA) = Just $ OtherSumTypeA typeA+mySumToOtherSum (MySumTypeB typeB) = Just $ OtherSumTypeB typeB+mySumToOtherSum other = Nothing+```++The boilerplate in examples isn't too bad, but consider writing this when your+sum type has dozens of types in it!++## Where does this library come in?++Using `sum-type-boilerplate`, you can reduce all of the previous code into the+following:++```haskell+constructSumType "MySum" defaultSumTypeOptions [''TypeA, ''TypeB, ''TypeC]+constructSumType "OtherSum" defaultSumTypeOptions [''TypeA, ''TypeB]+sumTypeConverter "otherSumToMySum" ''OtherSum ''MySum+partialSumTypeConverter "mySumToOtherSum" ''MySum ''OtherSum+```++## More features++* This library has an extremely simple implementation. (In fact, it is useful+  as an example if you are learning `template-haskell` for the first time.)+* The only dependency is on `template-haskell`. That means adding it as a+  dependency probably doesn't introduce transitive dependencies.+* The template haskell used here just produces vanilla Haskell data types. No+  crazy type-level magic is going on. That means if you want to ditch this+  library later on, just copy the generated code into your project.

+ library/SumTypes/TH.hs view

@@ -0,0 +1,232 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module SumTypes.TH+  ( -- * Constructing sum types+    constructSumType+  , SumTypeOptions+  , defaultSumTypeOptions+  , sumTypeOptionsTagOptions+  , SumTypeTagOptions (..)+  , sumTypeOptionsConstructorStrictness+  , SumTypeConstructorStrictness (..)+    -- * Converting between sum types+  , sumTypeConverter+  , partialSumTypeConverter+  ) where++import Language.Haskell.TH++-- | This is a template haskell function that creates a sum type from a list of+-- types. Here is an example:+--+-- > data TypeA = TypeA+-- > data TypeB = TypeB+-- > data TypeC = TypeC+-- >+-- > constructSumType "MySum" defaultSumTypeOptions [''TypeA, ''TypeB, ''TypeC]+--+-- This will produce the following sum type:+--+-- > data MySum+-- >   = MySumTypeA TypeA+-- >   | MySumTypeB TypeB+-- >   | MySumTypeC TypeC+--+-- Note that you can use standalone deriving to derive any instances you want:+--+-- > deriving instance Show MySum+-- > deriving instance Eq MySum+constructSumType :: String -> SumTypeOptions -> [Name] -> Q [Dec]+constructSumType typeName SumTypeOptions{..} types = do+  let+    strictness = constructorStrictness sumTypeOptionsConstructorStrictness+    mkConstructor name =+      NormalC+      (constructorName sumTypeOptionsTagOptions typeName name)+      [(Bang NoSourceUnpackedness strictness, ConT name)]+    constructors = map mkConstructor types+  return [DataD [] (mkName typeName) [] Nothing constructors []]++-- | Options for 'constructSumType'. Note that the constructor for this type is+-- not exported, please use 'defaultSumTypeOptions'. (This is done for+-- the sake of backwards compatibility in case we add options.)+data SumTypeOptions+  = SumTypeOptions+  { sumTypeOptionsTagOptions :: SumTypeTagOptions+  , sumTypeOptionsConstructorStrictness :: SumTypeConstructorStrictness+  }++-- | Default options for 'SumTypeOptions'+--+-- @+-- 'SumTypeOptions'+-- { 'sumTypeOptionsTagOptions' = 'PrefixTagsWithTypeName'+-- , 'sumTypeOptionsConstructorStrictness' = 'LazySumTypeConstructors'+-- }+-- @+defaultSumTypeOptions :: SumTypeOptions+defaultSumTypeOptions =+  SumTypeOptions+  { sumTypeOptionsTagOptions = PrefixTagsWithTypeName+  , sumTypeOptionsConstructorStrictness = LazySumTypeConstructors+  }++-- | This type specifies how 'constructSumType' will generate the tags for each+-- type.+data SumTypeTagOptions+  = PrefixTagsWithTypeName+    -- ^ This option generates tags with the sum type name prefixed to each+    -- tag.+  | AppendTypeNameToTags+    -- ^ This option generates tags with the sum type name appended to each+    -- tag.+  | ConstructTagName (String -> String)+    -- ^ Uses the given function to construct an arbitrary tag name. The+    -- argument to this function is the name of the tagged type.++constructorName :: SumTypeTagOptions -> String -> Name -> Name+constructorName PrefixTagsWithTypeName typeName = mkName . (typeName ++) . nameBase+constructorName AppendTypeNameToTags typeName = mkName . (++ typeName) . nameBase+constructorName (ConstructTagName mkConstructor) _ = mkName . mkConstructor . nameBase++-- | Defines if the constructors for the sum type should be lazy or strict.+data SumTypeConstructorStrictness+  = LazySumTypeConstructors+    -- ^ Constructors will be lazy+  | StrictSumTypeConstructors+    -- ^ Constructors will be strict+  deriving (Show, Eq)++constructorStrictness :: SumTypeConstructorStrictness -> SourceStrictness+constructorStrictness LazySumTypeConstructors = NoSourceStrictness+constructorStrictness StrictSumTypeConstructors = SourceStrict++-- | This template haskell function creates a conversion function between two+-- sum types. It works by matching up constructors that share the same inner+-- type. Note that all types in the source sum type must be present in the+-- target sum type, or you will get an error.+--+-- > data MySum+-- >   = MySumTypeA TypeA+-- >   | MySumTypeB TypeB+-- >   | MySumTypeC TypeC+-- >+-- > data OtherSum+-- >   = OtherSumTypeA TypeA+-- >   | OtherSumTypeB TypeB+-- >+-- > sumTypeConverter "otherSumToMySum" ''OtherSum ''MySum+--+-- This will producing the following code:+--+-- > otherSumToMySum :: OtherSum -> MySum+-- > otherSumToMySum (OtherSumTypeA typeA) = MySumTypeA typeA+-- > otherSumToMySum (OtherSumTypeB typeB) = MySumTypeB typeB+sumTypeConverter :: String -> Name -> Name -> Q [Dec]+sumTypeConverter functionName sourceType targetType = do+  bothConstructors <- matchTypeConstructors sourceType targetType+  let+    funcName = mkName functionName+  funcClauses <- mapM mkSerializeFunc bothConstructors+  typeDecl <- [t| $(conT sourceType) -> $(conT targetType) |]+  return+    [ SigD funcName typeDecl+    , FunD funcName funcClauses+    ]++-- | Similar to 'sumTypeConverter', except not all types in the source sum type+-- need to be present in the target sum type.+--+-- Note that this doesn't produce a partial function in the Haskell sense; you+-- won't get an 'error' with the generated function on any arguments. The word+-- partial is used mathematically to denote that not all types from the source+-- sum type are present in the target sum type.+--+-- > data MySum+-- >   = MySumTypeA TypeA+-- >   | MySumTypeB TypeB+-- >   | MySumTypeC TypeC+-- >+-- > data OtherSum+-- >   = OtherSumTypeA TypeA+-- >   | OtherSumTypeB TypeB+-- >+-- > partialSumTypeConverter "mySumToOtherSum" ''MySum ''OtherSum+--+-- This will producing the following code:+--+-- > mySumToOtherSum :: MySum -> Maybe OtherSum+-- > mySumToOtherSum (MySumTypeA typeA) = Just $ OtherSumTypeA typeA+-- > mySumToOtherSum (MySumTypeB typeB) = Just $ OtherSumTypeB typeB+-- > mySumToOtherSum other = Nothing+partialSumTypeConverter :: String -> Name -> Name -> Q [Dec]+partialSumTypeConverter functionName sourceType targetType = do+  bothConstructors <- matchTypeConstructors targetType sourceType+  let+    funcName = mkName functionName+    wildcardClause = Clause [WildP] (NormalB (ConE 'Nothing)) []+  funcClauses <- mapM mkDeserializeFunc bothConstructors+  typeDecl <- [t| $(conT sourceType) -> Maybe $(conT targetType) |]++  return+    [ SigD funcName typeDecl+    , FunD funcName (funcClauses ++ [wildcardClause])+    ]++matchTypeConstructors :: Name -> Name -> Q [BothConstructors]+matchTypeConstructors sourceType targetType = do+  sourceConstructors <- typeConstructors sourceType+  targetConstructors <- typeConstructors targetType+  mapM (matchConstructor targetConstructors) sourceConstructors++-- | Extract the constructors and types for the given sum type.+typeConstructors :: Name -> Q [(Type, Name)]+typeConstructors typeName = do+  info <- reify typeName+  case info of+    (TyConI (DataD _ _ _ _ constructors _)) -> mapM go constructors+      where+        go (NormalC name []) = fail $ "Constructor " ++ nameBase name ++ " doesn't have any arguments"+        go (NormalC name [(_, type')]) = return (type', name)+        go (NormalC name _) = fail $ "Constructor " ++ nameBase name ++ " has more than one argument"+        go _ = fail $ "Invalid constructor in " ++ nameBase typeName+    _ -> fail $ nameBase typeName ++ " must be a sum type"++-- | Find the corresponding target constructor for a given source constructor.+matchConstructor :: [(Type, Name)] -> (Type, Name) -> Q BothConstructors+matchConstructor targetConstructors (type', sourceConstructor) = do+  targetConstructor <-+    maybe+    (fail $ "Can't find constructor in target type corresponding to " ++ nameBase sourceConstructor)+    return+    (lookup type' targetConstructors)+  return $ BothConstructors type' sourceConstructor targetConstructor++-- | Utility type to hold the source and target constructors for a given type.+data BothConstructors =+  BothConstructors+  { innerType :: Type+  , sourceConstructor :: Name+  , targetConstructor :: Name+  }++-- | Construct the TH function 'Clause' for the serialization function for a+-- given type.+mkSerializeFunc :: BothConstructors -> Q Clause+mkSerializeFunc BothConstructors{..} = do+  varName <- newName "value"+  let+    patternMatch = ConP sourceConstructor [VarP varName]+    constructor = AppE (ConE targetConstructor) (VarE varName)+  return $ Clause [patternMatch] (NormalB constructor) []++-- | Construct the TH function 'Clause' for the deserialization function for a+-- given type.+mkDeserializeFunc :: BothConstructors -> Q Clause+mkDeserializeFunc BothConstructors{..} = do+  varName <- newName "value"+  let+    patternMatch = ConP targetConstructor [VarP varName]+    constructor = AppE (ConE 'Just) (AppE (ConE sourceConstructor) (VarE varName))+  return $ Clause [patternMatch] (NormalB constructor) []

+ sum-type-boilerplate.cabal view

@@ -0,0 +1,70 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           sum-type-boilerplate+version:        0.1.0+synopsis:       Library for reducing the boilerplate involved with sum types+description:    Library for reducing the boilerplate involved in creating and manipulating sum types+category:       Types,TH+stability:      experimental+homepage:       https://github.com/jdreaver/sum-type-boilerplate#readme+bug-reports:    https://github.com/jdreaver/sum-type-boilerplate/issues+author:         David Reaver+maintainer:     David Reaver+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/jdreaver/sum-type-boilerplate++library+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 5+    , template-haskell+  exposed-modules:+      SumTypes.TH+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      tests+      library+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 5+    , template-haskell+    , hspec+    , HUnit+  other-modules:+      HLint+      SumTypes.THSpec+      SumTypes.TH+  default-language: Haskell2010++test-suite style+  type: exitcode-stdio-1.0+  main-is: HLint.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 5+    , template-haskell+    , hlint+  other-modules:+      Spec+      SumTypes.THSpec+  default-language: Haskell2010

+ tests/HLint.hs view

@@ -0,0 +1,18 @@+module Main (main) where++import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++import Prelude (String, IO, null)++arguments :: [String]+arguments =+  [ "library"+  , "tests"+  , "-i=Redundant do"+  ]++main :: IO ()+main = do+  hints <- hlint arguments+  if null hints then exitSuccess else exitFailure

+ tests/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

+ tests/SumTypes/THSpec.hs view

@@ -0,0 +1,41 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module SumTypes.THSpec (spec) where++import Test.Hspec++import SumTypes.TH++data TypeA = TypeA deriving (Show, Eq)+data TypeB = TypeB deriving (Show, Eq)+data TypeC = TypeC deriving (Show, Eq)++constructSumType "MySum" defaultSumTypeOptions [''TypeA, ''TypeB, ''TypeC]+constructSumType "OtherSum" defaultSumTypeOptions [''TypeA, ''TypeB]+sumTypeConverter "otherSumToMySum" ''OtherSum ''MySum+partialSumTypeConverter "mySumToOtherSum" ''MySum ''OtherSum++deriving instance Show MySum+deriving instance Eq MySum++deriving instance Show OtherSum+deriving instance Eq OtherSum++spec :: Spec+spec = do+  describe "constructSumType" $ do+    it "compiles without breaking" $ do+      -- The real utility in this test is the fact that it compiles+      length [MySumTypeA TypeA, MySumTypeB TypeB, MySumTypeC TypeC] `shouldBe` 3++  describe "sumTypeConverter" $ do+    it "properly converts between types" $ do+      otherSumToMySum (OtherSumTypeA TypeA) `shouldBe` MySumTypeA TypeA+      otherSumToMySum (OtherSumTypeB TypeB) `shouldBe` MySumTypeB TypeB++  describe "partialSumTypeConverter" $ do+    it "properly converts between types" $ do+      mySumToOtherSum (MySumTypeA TypeA) `shouldBe` Just (OtherSumTypeA TypeA)+      mySumToOtherSum (MySumTypeB TypeB) `shouldBe` Just (OtherSumTypeB TypeB)+      mySumToOtherSum (MySumTypeC TypeC) `shouldBe` Nothing