diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021 Matthew Parsons + +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 Felipe Lessa 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,71 @@ +# `some-dict-of` + +Have you ever needed an existential wrapper that just guaranteed class +membership, but you didn't need to know the specifics of the type in question? + +Well, you probably *don't* - it's not idiomatic Haskell for the most part. But +sometimes this comes up, and I wanted a nice packaging of the technique. I wrote +this mostly to support the `discover-instances` library. + +## `SomeDictOf` + +Let's consider a type that wraps anything that can be shown, along with a value +of that type. We can make one by hand like this: + +```haskell +data SomeShowable where + SomeShowable :: forall a. Show a => a -> SomeShowable + +showList :: [SomeShowable] -> [String] +showList = map (\(SomeShowable a) -> show a) +``` + +With `SomeDictOf`, we can generalize this pattern to other classes and even +other containers. + +```haskell +someShowable :: SomeDictOf Identity Show +someShowable = + SomeDictOf (Identity (3 :: Int)) +``` + +We're carrying an `Int`, but the type does not reveal this. We can create a list +of values like this, and we can call `show` on them. + +```haskell +showValues + :: [SomeDictOf Identity Show] + -> [String] +showValues = + map (\(SomeDictOf (Identity showable)) -> show showable) +``` + +We can also carry around evidence of a type class instance, and then write +generic stuff based on it. Consider the +[`PersistEntity`](https://hackage.haskell.org/package/persistent-2.13.1.1/docs/Database-Persist-Class-PersistEntity.html#t:PersistEntity) +from the `persistent` database library. + +```haskell +tables :: [SomeDictOf Proxy PersistEntity] +tables = [ SomeDictOf (Proxy @User), SomeDictOf (Proxy @Organization) ] +``` + +Now we can iterate over these types and, say, load all the rows out of the +database and verify they parse. + +```haskell +checkRows :: SqlPersistT [[PersistValue]] +checkRows = do + forM tables $ \(SomeDictOf (Proxy :: Proxy table)) -> do + results <- selectList [] [] :: SqlPersistT m [Entity table] + pure (map toPersistValue results) +``` + +Or we can do some metaprogramming based on their `EntityDef`s, since +`PersistEntity` has a method `Proxy a -> EntityDef`. + +```haskell +getDefinitions :: [EntityDef] +getDefinitions = + map (\(SomeDictOf p) -> entityDef p) tables +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +- Initial Release diff --git a/some-dict-of.cabal b/some-dict-of.cabal new file mode 100644 --- /dev/null +++ b/some-dict-of.cabal @@ -0,0 +1,52 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: some-dict-of +version: 0.1.0.0 +synopsis: Carry evidence of constraints around +description: Please see the README on GitHub at +category: Constraints +homepage: https://github.com/parsonsmatt/some-dict-of#readme +bug-reports: https://github.com/parsonsmatt/some-dict-of/issues +author: Matt Parsons +maintainer: parsonsmatt@gmail.com +copyright: Matt Parsons +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + changelog.md + +source-repository head + type: git + location: https://github.com/parsonsmatt/some-dict-of + +library + exposed-modules: + SomeDictOf + other-modules: + Paths_some_dict_of + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , constraints + default-language: Haskell2010 + +test-suite discover-instances-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_some_dict_of + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , constraints + , some-dict-of + default-language: Haskell2010 diff --git a/src/SomeDictOf.hs b/src/SomeDictOf.hs new file mode 100644 --- /dev/null +++ b/src/SomeDictOf.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module SomeDictOf + ( module SomeDictOf + -- * Re-exports + , module Data.Functor.Identity + , module Data.Proxy + , module Data.Constraint + ) where + +import Data.Constraint +import Data.Functor.Identity +import Data.Kind +import Data.Proxy + +-- | A datatype that carries evidence of type class membership for some +-- type, along with a datatype indexed by that type. This is confusing, so +-- let's look at some examples. +-- +-- The alias @'SomeDict' clazz@ uses 'Proxy' for the datatype index. This means +-- that the wrapper is a @'Proxy' :: 'Proxy' a@, and you know that the type +-- @a@ has an instance of @clazz a@. We can construct a value +-- +-- @ +-- showSomeDict :: SomeDictOf Identity Show +-- showSomeDict = +-- SomeDict (Identity 3 :: Identity Int) +-- @ +-- +-- A value of @'SomeDict' 'Show'@ contains 'Proxy' value. When you pattern +-- match on the 'SomeDict', you know that the given @'Proxy' :: 'Proxy' a@ +-- has an instance of 'Show'. +-- +-- For the most part, this isn't useful, +-- +-- @since 0.1.0.0 +data SomeDictOf (f :: k -> Type) (c :: k -> Constraint) where + SomeDictOf :: c a => f a -> SomeDictOf f c + +-- | In the case where you only need evidence that the dictionary exists, +-- then you can use this type. By carrying a 'Proxy' instead of a real +-- value, we can summon these up whenever we have an instance of the type in +-- question. +-- +-- @since 0.1.0.0 +type SomeDict = SomeDictOf Proxy + +-- | Construct a 'SomeDict' with the type in question. Use with +-- @TypeApplications@. +-- +-- Example: +-- +-- @ +-- showDict :: SomeDict Show +-- showDict = someDict @Int +-- +-- entityDict :: SomeDict PersistEntity +-- entityDict = someDict @User +-- @ +-- +-- @since 0.1.0.0 +someDict :: forall a c. c a => SomeDict c +someDict = SomeDictOf (Proxy :: Proxy a) + +-- | Construct a 'SomeDict' based on a 'Dict' from the "Data.Constraint" module. +-- +-- @since 0.1.0.0 +fromDict :: forall a c. Dict (c a) -> SomeDict c +fromDict Dict = SomeDictOf (Proxy @a) + +-- | Unpack a 'SomeDictOf' and attain access to the evidence that the +-- underlying type satisfies the instance in question. +-- +-- @since 0.1.0.0 +withSomeDictOf + :: SomeDictOf f c + -> (forall a. c a => f a -> r) + -> r +withSomeDictOf (SomeDictOf p) k = + k p + +-- | Transform the type index used in the 'SomeDictOf'. The provided function is +-- unable to inspect the type, but you will have the class operations available +-- to it. +-- +-- Example: +-- +-- @ +-- provideMempty ;: SomeDictOf Proxy Monoid -> SomeDictOf Identity Monoid +-- provideMempty = mapSomeDictOf (\proxy -> Identity mempty) +-- @ +-- +-- @since 0.1.0.0 +mapSomeDictOf + :: (forall a. c a => f a -> g a) + -> SomeDictOf f c + -> SomeDictOf g c +mapSomeDictOf f (SomeDictOf fa) = + SomeDictOf (f fa) + +-- | Not really sure what this might be useful for. +-- +-- Examples: +-- +-- @ +-- shows :: SomeDictOf [] Show +-- shows = SomeDictOf [True, False, True] +-- +-- forgotten :: [SomeDictOf Proxy Show] +-- forgotten = forgetContents show +-- +-- main = do +-- forM forgotten $ \(SomeDictOf Proxy) -> do +-- print 10 +-- @ +-- +-- The above program should output 10 three times. +-- +-- @since 0.1.0.0 +forgetContents + :: forall f c. Functor f + => SomeDictOf f c + -> f (SomeDictOf Proxy c) +forgetContents (SomeDictOf (xs :: f a)) = + fmap (\(_ :: a) -> SomeDictOf (Proxy @a)) xs diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,16 @@ +module Main where + +import SomeDictOf + +main :: IO () +main = putStrLn "it compiles at least" + +-- note: if this changes, update the README +showValues + :: [SomeDictOf Identity Show] + -> [String] +showValues = + map (\(SomeDictOf (Identity showable)) -> show showable) + +slamMempty :: SomeDictOf Proxy Monoid -> SomeDictOf Identity Monoid +slamMempty = mapSomeDictOf (\pa -> Identity mempty)