packages feed

bookkeeper (empty) → 0.1.0.0

raw patch · 10 files changed

+513/−0 lines, 10 filesdep +Globdep +QuickCheckdep +basesetup-changed

Dependencies added: Glob, QuickCheck, base, bookkeeper, doctest, hspec, markdown-unlit, type-level-sets, yaml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Julian K. Arni (c) 2015++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 Julian K. Arni 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bookkeeper.cabal view
@@ -0,0 +1,89 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           bookkeeper+version:        0.1.0.0+description:    Please see README.md+homepage:       http://github.com/turingjump/bookkeeper#readme+bug-reports:    https://github.com/turingjump/bookkeeper/issues+author:         Julian K. Arni+maintainer:     jkarni@gmail.com+copyright:      (c) Julian K. Arni+license:        BSD3+license-file:   LICENSE+tested-with:    GHC == 8.0.1+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/turingjump/bookkeeper++library+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs MultiParamTypeClasses KindSignatures TypeInType OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators OverloadedLabels MagicHash+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 4.10+    , type-level-sets+  exposed-modules:+      Bookkeeper+      Bookkeeper.Errors+      Bookkeeper.Internal+  default-language: Haskell2010++executable readme+  main-is: Readme.lhs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs MultiParamTypeClasses KindSignatures TypeInType OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators OverloadedLabels MagicHash+  ghc-options: -Wall -pgmL markdown-unlit+  build-depends:+      base >= 4.9 && < 4.10+    , type-level-sets+    , base >=4.9 && < 4.10 , bookkeeper , markdown-unlit+  other-modules:+      BookkeeperSpec+      Doctest+      Spec+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: Doctest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs MultiParamTypeClasses KindSignatures TypeInType OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators OverloadedLabels MagicHash+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 4.10+    , type-level-sets+    , doctest >= 0.9 && < 0.12+    , Glob >= 0.7 && < 0.8+    , yaml == 0.8.*+  other-modules:+      BookkeeperSpec+      Readme+      Spec+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs MultiParamTypeClasses KindSignatures TypeInType OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators OverloadedLabels MagicHash+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 4.10+    , type-level-sets+    , bookkeeper+    , hspec > 2 && < 3+    , QuickCheck >= 2.8 && < 2.9+  other-modules:+      BookkeeperSpec+      Doctest+      Readme+  default-language: Haskell2010
+ src/Bookkeeper.hs view
@@ -0,0 +1,39 @@+module Bookkeeper+  (+  -- * Preamble+-- | The examples here presume the following setup:+--+-- >>> import Data.Char (toUpper)+-- >>> type Person = Book '[ "name" :=> String , "age" :=> Int ]+-- >>> let julian :: Person = emptyBook & #age =: 28 & #name =: "Julian K. Arni"+--+-- The OverloadedLabels and TypeOperators extensions are also required.++  -- * Initialization+   emptyBook+  -- * Getters+  , (?:)+  , get+  -- * Setters+  , set+  , (=:)++  -- * Modifying+  , modify+  , (%:)++  -- * Types+  , Book+  , (:=>)+  , Key+  -- * Re-exports+  , (&)++  -- * For coercion+  -- | These types should not be used, but need to be in scope for coercion,+  -- which is used when setting or modifying a value.+  , ChooseFirst(..)+  ) where++import Bookkeeper.Internal+import Data.Function
+ src/Bookkeeper/Errors.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+module Bookkeeper.Errors where++import qualified Data.Type.Map as Map+import GHC.TypeLits (TypeError, ErrorMessage(..))+import GHC.Exts++type Contains book field exp = Contains' book field book exp++type family Contains' book field orig exp :: Constraint where+   Contains' '[] field '[] exp = TypeError (Text "The provided Book is empty!")+   Contains' '[] field orig exp+      = TypeError (Text "The provided Book does not contain the field "+              :<>: ShowType field+              :$$: Text "Book type:"+              :$$: ShowType orig+              )+   Contains' ((k Map.:-> v) ': m) k orig exp = (v ~ exp)+   Contains' (any ': m) k     orig exp = Contains' m k orig exp
+ src/Bookkeeper/Internal.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+module Bookkeeper.Internal where++import GHC.OverloadedLabels+import GHC.Generics (Generic)+import qualified Data.Type.Map as Map+import GHC.TypeLits (Symbol)+import Data.Kind (Type)+import Data.Type.Map (Map, Mapping((:->)))+import Data.Coerce+import Data.Proxy++import Bookkeeper.Errors++-- Using a type synonym allows the user to write the fields in any order, and+-- yet have the underlying value always have sorted fields.+type Book a = Book' (Map.AsMap a)++-- | The internal representation of a Book.+newtype Book' (a :: [Mapping Symbol Type]) = Book { getBook :: Map a }++-- | A book with no records. You'll usually want to use this to construct+-- books.+emptyBook :: Book '[]+emptyBook = Book Map.Empty++-- | An alias for ':->' because otherwise you'll have to tick your+-- constructors.+type a :=> b = a ':-> b++instance Monoid (Book' '[]) where+  mempty = emptyBook+  _ `mappend` _ = emptyBook++instance (s ~ s') => IsLabel s (Key s') where+  fromLabel _ = Key++-- | 'Key' is simply a proxy. You will usually not need to generate it+-- directly, as it is generated by the OverlodadedLabels magic.+data Key (a :: Symbol) = Key+  deriving (Eq, Show, Read, Generic)++-- | Get a value by key, if it exists.+--+-- >>> get #age julian+-- 28+--+-- If the key does not exist, throws a type error+-- >>> get #moneyFrom julian+-- ...+-- ...  • The provided Book does not contain the field "moneyFrom"+-- ...    Book type:+-- ...    '["age" ':-> Int, "name" ':-> String]+-- ...  • In the expression: get #moneyFrom julian+-- ...+get :: forall field book val. (Map.Submap '[field :=> val] book, Contains book field val)+  => Key field -> Book' book -> val+get _ (Book bk) = case (Map.submap bk :: Map '[field :=> val]) of+        Map.Ext _ v Map.Empty -> v++-- | Flipped and infix version of 'get'.+--+-- >>> julian ?: #name+-- "Julian K. Arni"+(?:) :: forall field book val. (Map.Submap '[field :=> val] book, Contains book field val )+  => Book' book -> Key field -> val+(?:) = flip get++-- | Sets or updates a field to a value.+--+-- >>> let julian' = set #likesDoctest True julian+-- >>> get #likesDoctest julian'+-- True+set :: forall field val old mid1 mid2 new .+  ( Map.Unionable '[field :=> ChooseFirst val] mid1+  , Mappable ChooseFirst old mid1+  , Mappable ChooseFirst new mid2+  , mid1 ~ (MapThere ChooseFirst old)+  , mid2 ~ (Map.Union '[field :=> ChooseFirst val] mid1)+  , new ~ MapBack ChooseFirst mid2+  )+  => Key field -> val -> Book' old -> Book' new+set _ v (Book bk)+    = Book $ mapBack p+           $ Map.union new+           $ mapThere p bk+  where+    new = Map.Ext (Map.Var :: Map.Var field) (ChooseFirst v) Map.Empty+    p = Proxy :: Proxy ChooseFirst++-- | Infix version of 'set'+--+-- >>> let julian' = julian & #age =: 29+-- >>> get #age julian'+-- 29+(=:) :: forall field val old mid1 mid2 new .+  ( Map.Unionable '[field :=> ChooseFirst val] mid1+  , Mappable ChooseFirst old mid1+  , Mappable ChooseFirst new mid2+  , mid1 ~ (MapThere ChooseFirst old)+  , mid2 ~ (Map.Union '[field :=> ChooseFirst val] mid1)+  , new ~ MapBack ChooseFirst mid2+  )+  => Key field -> val -> Book' old -> Book' new+(=:) = set+++-- | Apply a function to a field.+--+-- >>> let julian' = julian & modify #name (fmap toUpper)+-- >>> get #name julian'+-- "JULIAN K. ARNI"+--+-- If the key does not exist, throws a type error+-- >>> modify #height (\_ -> 132) julian+-- ...+-- ...  • The provided Book does not contain the field "height"+-- ...    Book type:+-- ...    '["age" ':-> Int, "name" ':-> String]+-- ...  • In the expression: modify #height (\ _ -> 132) julian+-- ...+modify :: forall field val val' old mid1 mid2 new .+  ( Map.Unionable '[field :=> ChooseFirst val'] mid1+  , Mappable ChooseFirst old mid1+  , Mappable ChooseFirst new mid2+  , (Map.Submap '[field :=> val] old+  , Contains old field val )+  , mid1 ~ (MapThere ChooseFirst old)+  , mid2 ~ (Map.Union '[field :=> ChooseFirst val'] mid1)+  , new ~ MapBack ChooseFirst mid2+  , Map.AsMap new ~ new+  ) =>  Key field -> (val -> val') -> Book' old -> Book new+modify p f b = set p v b+  where v = f $ get p b++-- | Infix version of 'modify'.+--+-- >>> let julian' = julian & #name %: fmap toUpper+-- >>> get #name julian'+-- "JULIAN K. ARNI"+(%:) :: forall field val val' old mid1 mid2 new .+  ( Map.Unionable '[field :=> ChooseFirst val'] mid1+  , Mappable ChooseFirst old mid1+  , Mappable ChooseFirst new mid2+  , (Map.Submap '[field :=> val] old+  , Contains old field val )+  , mid1 ~ (MapThere ChooseFirst old)+  , mid2 ~ (Map.Union '[field :=> ChooseFirst val'] mid1)+  , new ~ MapBack ChooseFirst mid2+  , Map.AsMap new ~ new+  ) =>  Key field -> (val -> val') -> Book' old -> Book new+(%:) = modify+++-- * Mapping+--+-- | In order to be able to establish how maps are to combined, we need to a+-- little song and dance.++type family MapThere (f :: Type -> Type) (map :: [Mapping Symbol Type])  where+  MapThere f '[] = '[]+  MapThere f ((k :=> a) ': as) = (k :=> f a) ': MapThere f as++type family MapBack f (map :: [Mapping Symbol Type]) where+  MapBack f '[] = '[]+  MapBack f ((k :=> f a) ': as) =  k :=> a ': MapBack f as++class (MapThere f a ~ b, MapBack f b ~ a ) => Mappable f a b | f a -> b, f b -> a where+  mapThere :: proxy f -> Map a -> Map b+  mapBack :: proxy f -> Map b -> Map a++instance Mappable f '[] '[] where+  mapThere _ x = x+  mapBack _  x = x++instance (Coercible a (f a), Coercible (f a) a, Mappable f as fas )+  => Mappable f ((k :=> a) ': as) ((k :=> f a) ': fas) where+  mapThere p (Map.Ext v k r) = Map.Ext v (coerce k) $ mapThere p r+  mapBack p (Map.Ext v k r) = Map.Ext v (coerce k) $ mapBack p r+++class MapMap f map where+  type MapMapT f map :: [Mapping Symbol Type]+  mapMap :: f -> Map map -> Map (MapMapT f map)+++instance MapMap f '[] where+  type MapMapT f '[] = '[]+  mapMap _ m = m++{-#  WARNING ChooseFirst "This should not be used" #-}+newtype ChooseFirst a = ChooseFirst { getChooseFirst :: a }+ deriving (Eq, Show, Read, Generic)++instance Map.Combinable (ChooseFirst a) (ChooseFirst b) where+  combine a _ = a++type instance Map.Combine (ChooseFirst a) (ChooseFirst b) = ChooseFirst a+++-- $setup+-- >>> import Data.Function ((&))+-- >>> import Data.Char (toUpper)+-- >>> type Person = Book '[ "name" :=> String , "age" :=> Int ]+-- >>> let julian :: Person = emptyBook & #age =: 28 & #name =: "Julian K. Arni"
+ test/BookkeeperSpec.hs view
@@ -0,0 +1,51 @@+module BookkeeperSpec (spec) where++import Data.Char (toUpper)+import Test.Hspec++import Bookkeeper++spec :: Spec+spec = describe "books" $ do++    it "allows creation" $ do+      let _p :: Person+             = emptyBook+             & #name =: "Julian K. Arni"+             & #age  =:  28+      typeLevelTest++    it "allows creation out of order" $ do+      let _p :: Person+             = emptyBook+             & #age  =:  28+             & #name =: "Julian K. Arni"+      typeLevelTest++    it "allows access" $ do+      let p :: Person+             = emptyBook+             & #name =: "Julian K. Arni"+             & #age  =:  28+      get #name p  `shouldBe` "Julian K. Arni"++    it "allows update" $ do+      let p :: Person+             = emptyBook+             & #name =: "Julian K. Arni"+             & #age =: 28+             & #name %: fmap toUpper+      get #name p `shouldBe` "JULIAN K. ARNI"++    it "allows extension" $ do+      let p :: Person+             = emptyBook+             & #name =: "Julian K. Arni"+             & #age =: 28+      let p' = #email =: "jkarni<at>turingjump<dot>com" $ p+      get #email p' `shouldBe` ("jkarni<at>turingjump<dot>com" :: String)++type Person = Book '[ "name" :=> String , "age" :=> Int]++typeLevelTest :: Expectation+typeLevelTest = True `shouldBe` True
+ test/Doctest.hs view
@@ -0,0 +1,27 @@++module Main (main) where++-- Runs doctest on all files in "src" dir. Assumes:+--   (a) You are using hpack+--   (b) The top-level "default-extensions" are the only extensions besides the+--   ones in the files.++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+import Data.Yaml++newtype Exts = Exts { getExts :: [String] }+  deriving (Eq, Show, Read)++instance FromJSON Exts where+  parseJSON (Object v) = Exts <$> v .: "default-extensions"+  parseJSON _ = fail "expecting object"++main :: IO ()+main = do+  hpack' <- decodeFile "package.yaml"+  hpack <- case hpack' of+    Nothing -> return $ Exts []+    Just v  -> return v+  files <- glob "src/**/*.hs"+  doctest $ files ++ fmap ("-X" ++) (getExts hpack)
+ test/Readme.lhs view
@@ -0,0 +1,48 @@+# Bookkeeper++Bookkeeper is a new Haskell library that uses the new OverlodaedLabels feature+of GHC 8 to provide a new take on datatypes and records:++~~~ {.haskell}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedLabels #-}+import Bookkeeper+++jane :: Book '[ "name" :=> String, "age" :=> Int ]+jane = emptyBook+     & #name =: "Jane"+     & #age =: 30++-- >>> jane ?: #name+-- "Jane"+~~~++Accesing a field that does not exist is a type error, made nicer with GHCs new+custom type errors:++~~~ {.haskell}+ -- >>> jane ?: #address+--   • The provided Book does not contain the field "address"+--     Book type:+--     '["age" ':-> Int, "name" ':-> String]+~~~+++The order in which fields are inserted or appear in types does not matter. That+is, in:++~~ {.haskell ignore}+-- type A = Book '[ "field1" :=> Int, "field2" :=> Bool]+-- type B = Book '[ "field2" :=> Bool "field1" :=> Int ]+~~++Types `A` and `B` are the same.++You can set, modify, or get fields. See the haddocks for more information.+++~~~ {.haskell}+main :: IO ()+main = return ()+~~~
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}