vinyl-named-sugar (empty) → 0.1.0.0

raw patch · 7 files changed

+205/−0 lines, 7 filesdep +basedep +vinylsetup-changed

Dependencies added: base, vinyl

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
README.md +2/−0
Setup.hs +2/−0
examples/Example.hs +17/−0
lib/Data/Vinyl/Sugar.hs +127/−0
vinyl-named-sugar.cabal +32/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for record-sugar
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2019 Solonarv
+
+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,2 @@+# record-sugar
+Syntax sugar for vinyl records using overloaded labels.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ examples/Example.hs view

@@ -0,0 +1,17 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedLabels #-}
+module Example where
+
+import Data.Vinyl.Core
+import Data.Vinyl.Functor
+import Data.Vinyl.Sugar
+
+john :: Rec ElField ['("name", String), '("age", Int)]
+john = rec_
+  #age 30
+  #name "John Doe"
+
+john' :: Rec ElField ['("bornAt", String), '("name", String), '("age", Int)]
+john' = extend_ john
+  #bornAt "Zurich, Switzerland"

+ lib/Data/Vinyl/Sugar.hs view

@@ -0,0 +1,127 @@+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-|
+Provides "syntax sugar" for constructing @vinyl@ records with
+named fields, using GHC's OverloadedLabels extension.
+
+This lets you create records using the following syntax,
+clearly associating each field's name with its value:
+
+@
+john :: 'V.Rec' 'V.ElField' ['("name", String), '("age", Int)]
+john = 'rec_'
+  #age 30
+  #name "John Doe"
+@
+
+You can also extend an existing record using 'extend_':
+
+@
+john' :: 'V.Rec' 'V.ElField' ['("bornAt", String), '("name", String), '("age", Int)]
+john' = 'extend_' john
+  #bornAt "Zurich, Switzerland"
+@
+-}
+module Data.Vinyl.Sugar
+  (
+  -- * Record-construction sugar
+    rec_
+  , extend_
+  -- * Extending the syntax sugar
+  , NamedField(..)
+  , RecSugarTy(..)
+  -- * Auxiliary types
+  , FieldLabel(..)
+  ) where
+
+import Data.Kind
+import Foreign.Storable (Storable)
+import GHC.OverloadedLabels
+import GHC.TypeLits
+
+import qualified Data.Vinyl.ARec as V
+import qualified Data.Vinyl.Core as V
+import qualified Data.Vinyl.Functor as V
+import qualified Data.Vinyl.SRec as V
+import qualified Data.Vinyl.TypeLevel as V
+
+-- | A simple proxy for type-level strings.
+data FieldLabel (s :: Symbol) = FieldLabel
+  deriving (Eq, Ord, Enum)
+
+instance s ~ s' => IsLabel s (FieldLabel s') where
+  fromLabel = FieldLabel
+
+{- |
+Specifies how to convert a labeled value into an element of a
+vinyl record. The only default instance is for @'Vinyl.ElField'@,
+but you can define additional instances for your own interpretation
+functors.
+-}
+class NamedField (s :: Symbol) (r :: k) (f :: k -> Type) (a :: Type)
+  | r -> s
+  , r f -> a
+  where
+  {- |
+  Convert a value into a vinyl record element. You can imagine that
+  this has the following type:
+
+@
+toNamedField :: KnownSymbol s => a -> ElField '(s, a)
+@
+  -}
+  toNamedField :: a -> f r
+
+instance (KnownSymbol s, s ~ s') => NamedField s' '(s, a) V.ElField a where
+  toNamedField = V.Field
+
+{- |
+The workhorse class of this package. Implements a polyvariadic
+function that builds up a @'V.Rec'@ and converts it into
+the desired output type.
+
+You can enable @rec_@ syntax for your own types by writing additional
+@RecSugarTy@ instances, adding a base case to @'rec''@. Example:
+
+@
+data MyFunctor r -- elided
+
+newtype MyRec rs = MyRec { unMyRec :: 'V.Rec' MyFunctor rs }
+
+instance 'RecSugarTy' ('V.Rec' MyFunctor rs) (MyRec rs) where
+  rec' = MyRec
+@
+-}
+class RecSugarTy e o | o -> e where
+  rec' :: e -> o
+
+instance RecSugarTy (V.Rec f rs) (V.Rec f rs) where
+  rec' = id
+
+instance (NamedField s r f a, RecSugarTy (V.Rec f (r:rs)) o, lbl ~ FieldLabel s) => RecSugarTy (V.Rec f rs) (lbl -> a -> o) where
+  rec' rs _lbl a = rec' (toNamedField a V.:& rs)
+
+instance V.NatToInt (V.RLength rs) => RecSugarTy (V.Rec f rs) (V.ARec f rs) where
+  rec' = V.toARec
+
+instance Storable (V.Rec f rs) => RecSugarTy (V.Rec f rs) (V.SRec f rs) where
+  rec' = V.toSRec
+
+{- |
+Create a record by adding fields to the empty record. This is the
+function you will use most of the time.
+-}
+rec_ :: RecSugarTy (V.Rec f '[]) o => o
+rec_ = rec' V.RNil
+
+{- |
+Create a record by extending an existing record.
+-}
+extend_ :: RecSugarTy (V.Rec f rs) o => V.Rec f rs -> o
+extend_ = rec'

+ vinyl-named-sugar.cabal view

@@ -0,0 +1,32 @@+cabal-version:       2.2
+-- Initial package description 'record-sugar.cabal' generated by 'cabal
+-- init'.  For further documentation, see
+-- http://haskell.org/cabal/users-guide/
+
+name:                vinyl-named-sugar
+version:             0.1.0.0
+synopsis:            Syntax sugar for vinyl records using overloaded labels.
+description:         Provides @rec_ \#foo fooVal \#bar barVal@ syntax for constructing @vinyl@ records.
+homepage:            https://github.com/Solonarv/record-sugar#readme
+bug-reports:         https://github.com/Solonarv/record-sugar/issues
+license:             MIT
+license-file:        LICENSE
+author:              Solonarv
+maintainer:          nstamm@gmx.de
+copyright:           2019 Solonarv
+category:            Data
+extra-source-files:  CHANGELOG.md, README.md, examples/*.hs
+
+source-repository head
+  type:                git
+  location:            https://github.com/Solonarv/record-sugar
+
+library
+  exposed-modules:     Data.Vinyl.Sugar
+  -- other-modules:
+  other-extensions:    DataKinds FlexibleContexts FlexibleInstances FunctionalDependencies
+                       PolyKinds TypeFamilies TypeOperators
+  build-depends:       base >= 4.10 && < 4.13
+                     , vinyl >= 0.9 && < 0.11
+  hs-source-dirs:      lib
+  default-language:    Haskell2010