named (empty) → 0.1.0.0

raw patch · 6 files changed

+410/−0 lines, 6 filesdep +basedep +namedsetup-changed

Dependencies added: base, named

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• named.cabal +57/−0
• src/Named.hs +255/−0
• test/Test.hs +63/−0

@@ -0,0 +1,3 @@+## 0.1.0.0
+
+* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2018, Vladislav Zavialov
+
+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 Vladislav Zavialov 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.

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

@@ -0,0 +1,57 @@+name:                named
+version:             0.1.0.0
+synopsis:            Named parameters (keyword arguments) for Haskell
+description:
+    `named` is a lightweight library for named function parameters (keyword
+    arguments) based on overloaded labels. Keyword arguments have several
+    advantages over positional arguments:
+    .
+    * they can be supplied in arbitrary order
+    * their names serve as documentation at call site
+    * it is impossible to accidentally mix them up
+    .
+    Unlike @newtype@ wrappers, keyword arguments don't pollute the global
+    namespace, don't require top-level definitions, and don't need to be
+    exported.
+    .
+    This implementation of named parameters is typesafe, provides good type
+    inference, descriptive type errors, and has no runtime overhead.
+    .
+    Example usage:
+    .
+    > import Named
+    >
+    > createSymLink :: FilePath `Named` "from" -> FilePath `Named` "to" -> IO ()
+    > createSymLink (Named from) (Named to) = ...
+    >
+    > main = createSymLink ! #from "/path/to/source"
+    >                      ! #to "/target/path"
+
+
+license:             BSD3
+license-file:        LICENSE
+author:              Vladislav Zavialov
+maintainer:          Vladislav Zavialov <vlad.z.4096@gmail.com>
+category:            Control
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+tested-with:         GHC ==8.0.2, GHC ==8.2.2, GHC ==8.4.1
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Named
+  build-depends:       base >=4.9 && <4.12
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -fno-warn-unticked-promoted-constructors
+
+test-suite regression
+  type:                exitcode-stdio-1.0
+  main-is:             Test.hs
+  build-depends:       base >=4.9 && <4.12,
+                       named
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -fno-warn-missing-signatures

@@ -0,0 +1,255 @@+{-# LANGUAGE KindSignatures, DataKinds, FlexibleInstances, FlexibleContexts,
+             FunctionalDependencies, TypeFamilies, TypeOperators,
+             PatternSynonyms, UndecidableInstances, ConstraintKinds,
+             TypeApplications, ScopedTypeVariables, CPP #-}
+
+{- |
+
+Named parameters, also known as keyword arguments, have several advantages
+over positional arguments:
+
+* convenience: they can be supplied in arbitrary order
+* readability: their names serve as documentation at call site
+* safety: it is impossible to accidentally mix them up
+
+Consider a function to replace a substring with another string:
+
+@
+Text.replace path "$HOME" "\/home\/username\/"
+@
+
+We want to replace references to the @$HOME@ environment variable with a
+concrete directory. There is but one problem – we have supplied the text
+arguments in the wrong order.
+
+Compare that to a newtype-based solution:
+
+@
+Text.replace
+  (Needle "$HOME")
+  (Replacement "\/home\/username\/")
+  (Haystack path)
+@
+
+Now that the function requires each argument to be wrapped in a newtype, we
+cannot mix them up – the compiler will report an error, and newtype constructors
+serve as documentation.
+
+The problem with newtypes is that it is bothersome to create them for each
+parameter, they pollute the global namespace, and we still cannot supply wrapped
+arguments in arbitrary order.
+
+With keyword arguments, none of that is a problem:
+
+@
+Text.replace '!' #haystack path
+             '!' #needle "$HOME"
+             '!' #replacement "\/home\/username\/"
+@
+
+Functions must declare their parameter names in the type signature:
+
+@
+replace ::
+  Text \``Named`\` "needle" ->
+  Text \``Named`\` "replacement" ->
+  Text \``Named`\` "haystack" ->
+  Text
+replace (Named needle) (Named replacement) (Named haystack) =
+  ...
+@
+
+Keyword arguments have seamless interoperability with positional arguments when
+the function takes them last. Consider this function:
+
+@
+foo :: A -> B -> C \``Named`\` "x" -> IO ()
+@
+
+There are several ways to invoke it:
+
+@
+(foo a b) '!' #x c     -- parentheses for clarity
+(foo a '!' #x c) b     -- parentheses required
+(foo '!' #x c) a b     -- parentheses required
+@
+
+We can also supply keyword arguments using the 'with' combinator instead of
+the '!' operator:
+
+@
+('with' #x c foo) a b  -- parentheses for clarity
+'with' #x c (foo a b)  -- has the same effect
+@
+
+Both '!' and 'with' work in a similar manner: they traverse the spine of
+the function and supply the first keyword argument with a matching name.
+
+For example:
+
+@
+bar           :: A \``Named`\` "x" -> B \``Named`\` "y" -> IO ()
+bar '!' #y b    :: A \``Named`\` "x"                  -> IO ()
+'with' #y b bar :: A \``Named`\` "x"                  -> IO ()
+@
+
+-}
+module Named
+  (
+    -- * Core interface
+    Named(..),
+    (!),
+    Name(..),
+    with,
+
+    -- * Specialized synonyms
+    Flag,
+    pattern Flag,
+
+    -- * Internal
+    Apply,
+    apply,
+    named
+  ) where
+
+import Prelude (Bool, id)
+import Data.Kind (Type)
+import GHC.TypeLits (Symbol, TypeError, ErrorMessage(..))
+import GHC.OverloadedLabels (IsLabel(..))
+
+{- |
+
+Assign a name to a value of type @a@. This is a simple wrapper intended
+for use with @-XOverloadedLabels@:
+
+@
+#verbose True :: Named Bool "verbose"
+@
+
+-}
+newtype Named a (name :: Symbol) = Named { unnamed :: a }
+
+instance (name ~ name', a ~ a') => IsLabel name (a -> Named a' name') where
+#if MIN_VERSION_base(4,10,0)
+  fromLabel = Named
+#else
+  fromLabel _ = Named
+#endif
+  {-# INLINE fromLabel #-}
+
+-- | Snake oil to cure boolean blindness.
+type Flag = Named Bool
+
+-- | Match on a flag, a version of 'Named' specialized to 'Bool'.
+pattern Flag :: Bool -> Flag name
+pattern Flag a = Named a
+
+#if MIN_VERSION_base(4,10,0)
+{-# COMPLETE Flag #-}
+#endif
+
+{- | Supply a keyword argument to a function:
+
+@
+function ! #param_name value
+@
+-}
+
+(!) :: Apply name a fn fn' => fn -> Named a name -> fn'
+(!) = apply
+{-# INLINE (!) #-}
+
+infixl 9 !
+
+{- |
+
+A proxy for a name, intended for use with @-XOverloadedLabels@:
+
+@
+#verbose :: Name "verbose"
+@
+
+-}
+data Name (name :: Symbol) = Name
+
+instance name ~ name' => IsLabel name' (Name name) where
+#if MIN_VERSION_base(4,10,0)
+  fromLabel = Name
+#else
+  fromLabel _ = Name
+#endif
+  {-# INLINE fromLabel #-}
+
+{- | Supply a keyword argument to a function:
+
+@
+with #param_name value function
+@
+-}
+with :: Apply name a fn fn' => Name name -> a -> fn -> fn'
+with name a fn = fn ! named name a
+{-# INLINE with #-}
+
+-- | Annotate a value with a name.
+named :: Name name -> a -> Named a name
+named _ = Named
+{-# INLINE named #-}
+
+--------------------------------------------------------------------------------
+--  Do not read further to avoid emotional trauma.
+--------------------------------------------------------------------------------
+
+data Decision = Done | Skip Decision
+
+type family Decide (name :: Symbol) (fn :: Type) :: Decision where
+  Decide name (Named a name -> r) = Done
+  Decide name (x -> r) = Skip (Decide name r)
+  Decide name t =
+    TypeError (Text "Named parameter '" :<>: Text name :<>:
+               Text "' was supplied, but not expected")
+
+class
+  ( decision ~ Decide name fn
+  ) => Apply' decision name a fn fn' | name fn -> fn'
+  where
+    -- | Apply a function to a keyword argument.
+    apply :: fn -> Named a name -> fn'
+
+instance
+  ( fn ~ (Named a name -> r),
+    fn' ~ r,
+    Decide name fn ~ Done
+  ) => Apply' Done name a fn fn'
+  where
+    apply = id
+    {-# INLINE apply #-}
+
+instance
+  ( Apply' decision name a r r',
+    Decide name fn ~ Skip decision,
+    fn ~ (x -> r),
+    fn' ~ (x -> r')
+  ) => Apply' (Skip decision) name a fn fn'
+  where
+    apply fn a = \x -> apply (fn x) a
+    {-# INLINE apply #-}
+
+{- |
+
+Supply a parameter of type @a@ named @name@ to a function @fn@, resulting in
+@fn'@.
+
+For example:
+
+@
+Apply "x" Char
+  (Named Bool "b" -> Named Char "x" -> r)
+  (Named Bool "b" -> r)
+@
+
+In case the parameter cannot be supplied, this constraint will become a type
+error.
+
+-}
+type Apply (name :: Symbol) (a :: Type) (fn :: Type) (fn' :: Type) =
+  Apply' (Decide name fn) name a fn fn'

@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedLabels, DataKinds, TypeOperators #-}
+
+module Main where
+
+import Data.Function ((&))
+import Named
+
+test1 ::
+  String ->
+  Flag "a" ->
+  Bool `Named` "b" ->
+  IO ()
+test1 "str" (Flag True) (Flag False) = return ()
+test1 _ _ _ = error "unexpected flags or str"
+
+test1_1 =
+  test1 "str"
+    ! #a True
+    ! #b False
+
+test1_2 =
+  test1 "str"
+    ! #b False
+    ! #a True
+
+test1_3 =
+  test1 "str"
+    & with #b False
+    & with #a True
+
+test1_4 =
+  with #a True $
+  with #b False $
+    test1 "str"
+
+test1_5 =
+  with #a True $
+  test1 "str"! #b False
+
+test1_6 =
+  test1 "str"! #a True
+    & with #b False
+
+test2 :: Named Int "x" -> Int
+test2 x = unnamed x * 2
+
+test2_1 :: Int
+test2_1 = test2 ! #x 5 + test2 ! #x 3
+
+main :: IO ()
+main = do
+  test1_1
+  test1_2
+  test1_3
+  test1_4
+  test1_5
+  test1_6
+  test2_1 `mustBe` 16
+
+mustBe :: (Eq a, Show a) => a -> a -> IO ()
+mustBe a b
+  | a == b = return ()
+  | otherwise = error $ show a ++ " must be " ++ show b