bookkeeper 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+44/−22 lines, 5 files

Files

• bookkeeper.cabal +2/−3
• src/Bookkeeper/Internal.hs +29/−13
• test/BookkeeperSpec.hs +3/−0
• test/Doctest.hs +7/−6
• test/Readme.lhs +3/−0

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           bookkeeper-version:        0.1.1.0+version:        0.1.2.0 description:    Please see README.md homepage:       http://github.com/turingjump/bookkeeper#readme bug-reports:    https://github.com/turingjump/bookkeeper/issues@@ -38,8 +38,7 @@   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+  ghc-options: -Wall -pgmL markdown-unlit -fno-warn-unused-top-binds   build-depends:       base >= 4.9 && < 4.10     , type-level-sets

@@ -5,11 +5,13 @@ import GHC.OverloadedLabels import GHC.Generics (Generic) import qualified Data.Type.Map as Map-import GHC.TypeLits (Symbol)+import GHC.TypeLits (Symbol, KnownSymbol) import Data.Kind (Type) import Data.Type.Map (Map, Mapping((:->))) import Data.Coerce import Data.Proxy+import Data.Monoid ((<>))+import Data.List (intercalate)  import Bookkeeper.Errors @@ -20,6 +22,24 @@ -- | The internal representation of a Book. newtype Book' (a :: [Mapping Symbol Type]) = Book { getBook :: Map a } +instance ShowHelper (Book' a) => Show (Book' a) where+  show x = "Book {" <> intercalate ", " (go <$> showHelper x) <> "}"+    where+      go (k, v) = k <> " = " <> v++class ShowHelper a where+  showHelper :: a -> [(String, String)]++instance ShowHelper (Book' '[]) where+  showHelper _ = []++instance ( ShowHelper (Book' xs)+         , KnownSymbol k+         , Show v+         ) => ShowHelper (Book' ((k :=> v) ': xs)) where+  showHelper (Book (Map.Ext k v rest)) = (show k, show v):showHelper (Book rest)++ -- | A book with no records. You'll usually want to use this to construct -- books. emptyBook :: Book '[]@@ -70,9 +90,8 @@  -- | Sets or updates a field to a value. ----- >>> let julian' = set #likesDoctest True julian--- >>> get #likesDoctest julian'--- True+-- >>> set #likesDoctest True julian+-- Book {age = 28, likesDoctest = True, name = "Julian K. Arni"} set :: forall field val old mid1 mid2 new .   ( Map.Unionable '[field :=> ChooseFirst val] mid1   , Mappable ChooseFirst old mid1@@ -92,9 +111,8 @@  -- | Infix version of 'set' ----- >>> let julian' = julian & #age =: 29--- >>> get #age julian'--- 29+-- >>> julian & #age =: 29+-- Book {age = 29, name = "Julian K. Arni"} (=:) :: forall field val old mid1 mid2 new .   ( Map.Unionable '[field :=> ChooseFirst val] mid1   , Mappable ChooseFirst old mid1@@ -110,9 +128,8 @@  -- | Apply a function to a field. ----- >>> let julian' = julian & modify #name (fmap toUpper)--- >>> get #name julian'--- "JULIAN K. ARNI"+-- >>> julian & modify #name (fmap toUpper)+-- Book {age = 28, name = "JULIAN K. ARNI"} -- -- If the key does not exist, throws a type error -- >>> modify #height (\_ -> 132) julian@@ -138,9 +155,8 @@  -- | Infix version of 'modify'. ----- >>> let julian' = julian & #name %: fmap toUpper--- >>> get #name julian'--- "JULIAN K. ARNI"+-- >>> julian & #name %: fmap toUpper+-- Book {age = 28, name = "JULIAN K. ARNI"} (%:) :: forall field val val' old mid1 mid2 new .   ( Map.Unionable '[field :=> ChooseFirst val'] mid1   , Mappable ChooseFirst old mid1

@@ -44,6 +44,9 @@       p' ?: #name `shouldBe` "Julian K. Arni"       p' ?: #child ?: #name `shouldBe` "JULIAN K. ARNI" +    it "has a decent show instance" $ do+      show p `shouldBe` "Book {age = 28, name = \"Julian K. Arni\"}"+ type Person = Book '[ "name" :=> String , "age" :=> Int]  

@@ -3,8 +3,7 @@  -- 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.+--   (b) The library has a 'default-extensions' section  import System.FilePath.Glob (glob) import Test.DocTest (doctest)@@ -14,14 +13,16 @@   deriving (Eq, Show, Read)  instance FromJSON Exts where-  parseJSON (Object v) = Exts <$> v .: "default-extensions"+  parseJSON (Object v) = do+    lib <- v .: "library"+    Exts <$> lib .: "default-extensions"   parseJSON _ = fail "expecting object"  main :: IO () main = do   hpack' <- decodeFile "package.yaml"-  hpack <- case hpack' of-    Nothing -> return $ Exts []+  extensions <- case hpack' of+    Nothing -> return $ Exts mempty     Just v  -> return v   files <- glob "src/**/*.hs"-  doctest $ files ++ fmap ("-X" ++) (getExts hpack)+  doctest $ files ++ fmap ("-X" ++) (getExts extensions)

@@ -4,6 +4,7 @@ of GHC 8 to provide a new take on datatypes and records:  ~~~ {.haskell}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedLabels #-} import Bookkeeper@@ -14,6 +15,8 @@      & #name =: "Jane"      & #age =: 30 +-- >>> jane+-- Book {age = 30, name = "Jane"} -- >>> jane ?: #name -- "Jane" ~~~