labels 0.1.0 → 0.1.1

raw patch · 7 files changed

+125/−191 lines, 7 filesdep −bytestringdep −cassavadep −unordered-containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: bytestring, cassava, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• README.md +0/−85
• Setup.hs +1/−0
• labels.cabal +5/−11
• src/Labels.hs +49/−9
• src/Labels/Cassava.hs +0/−68
• src/Labels/Internal.hs +67/−18

@@ -1,3 +1,6 @@+0.1.1:+	* Add "project" function.+ 0.1.0: 	* Drop the convenience accessor #foo. Must use get #foo 

@@ -52,88 +52,3 @@ (#bar := "hi",#mu := 246) </pre></td></tr> </table>--## Reading CSV files with Cassava--Import the instances for `FromNamedRecord`:--``` haskell-import Labels.Cassava-```--Then just specify the type you want to load:--``` haskell-> let Right (_,rows :: Vector ("salary" := Int, "name" := Text)) = decodeByName "name,salary\r\nJohn,27\r\n"-> rows-[(#salary := 27,#name := "John")]-```--Non-existent fields or invalid types result in a parse error:--``` haskell-> decodeByName "name,salary\r\nJohn,27\r\n" :: Either String (Header, Vector ("name" := Text, "age" := Int))-Left "parse error (Failed reading: conversion error: Missing field age) at \"\\r\\n\""-> decodeByName "name,salary\r\nJohn,27\r\n" :: Either String (Header, Vector ("name" := Text, "salary" := Char))-Left "parse error (Failed reading: conversion error: expected Char, got \"27\") at \"\\r\\n\""-```--Example with Yahoo!'s market data for AAPL:--``` haskell-> Right (headers,rows :: Vector ("date" := String, "high" := Double, "low" := Double)) <- fmap decodeByName (LB.readFile "AAPL.csv")-> headers-["date","open","high","low","close","volume","adj close"]-```--We can print the rows as-is:--``` haskell-> mapM_ print (V.take 2 rows)-(#date := "2016-08-10",#high := 108.900002,#low := 107.760002)-(#date := "2016-08-09",#high := 108.940002,#low := 108.010002)-```--Accessing fields is natural as anything:--``` haskell-> V.sum (V.map (get #low) rows)-2331.789993-```--We can just make up new fields on the fly:--``` haskell-> let diffed = V.map (\row -> cons (#diff := (get #high row - get #low row)) row) rows-> mapM_ print (V.take 2 diffed)-(#diff := 1.1400000000000006,#date := "2016-08-10",#high := 108.900002,#low := 107.760002)-(#diff := 0.9300000000000068,#date := "2016-08-09",#high := 108.940002,#low := 108.010002)-```--Sometimes a CSV file will have non-valid Haskell identifiers or-spaces, e.g. `adj close` here:--``` haskell-> Right (headers,rows :: Vector ("date" := String, "adj close" := Double)) <- fmap decodeByName (LB.readFile "AAPL.csv")-> mapM_ print (V.take 2 rows)-(#date := "2016-08-10",#adj close := 108.0)-(#date := "2016-08-09",#adj close := 108.809998)-```--Just use the `$("adj close")` syntax:--``` haskell-> mapM_ print (V.take 2 (V.map (get $("adj close")) rows))-108.0-108.809998-```--It still checks the name and type:--``` haskell-> mapM_ print (V.take 2 (V.map (get $("adj closer")) rows))-<interactive>:133:31: error:-    • No instance for (Has-                         "adj closer" a0 ("date" := String, "adj close" := Double))-        arising from a use of ‘get’-````

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

@@ -1,8 +1,7 @@ name:                labels-version:             0.1.0-synopsis:            Declare and access tuple fields with labels-description:         Declare and access tuple fields with labels.-                     An approach to anonymous records.+version:             0.1.1+synopsis:            Anonymous records via named tuples+description:         Declare and access tuple fields with labels. An approach to anonymous records. homepage:            https://github.com/chrisdone/labels#readme license:             BSD3 license-file:        LICENSE@@ -19,14 +18,9 @@   hs-source-dirs:      src   ghc-options:         -Wall -O2   exposed-modules:     Labels,-                       Labels.Internal,-                       Labels.Cassava+                       Labels.Internal   build-depends:       base >= 4.7 && < 5,-                       template-haskell,-                       -- Integrations-                       cassava,-                       bytestring,-                       unordered-containers+                       template-haskell   default-language:    Haskell2010  source-repository head

@@ -1,3 +1,8 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Rank2Types #-} -- | Labels for fields in a tuple. -- -- Enable these extensions:@@ -44,18 +49,53 @@ -- >>> let double field record = set field (get field record * 2) record -- >>> double #mu (#bar := "hi", #mu := 123) -- (#bar := "hi",#mu := 246)+--+-- Lenses:+--+-- >>> over (lens #sub . lens #foo) (*2) (#bar := "hello", #sub := (#foo := 123))+-- (#bar := "hello",#sub := #foo := 246)+--+-- Projection:+--+-- >>> project (#bar := "hello", #foo := 3, #mu := "hi") :: ("bar" := String, "foo" := Int)+-- (#bar := "hello",#foo := 3)+--+-- Field order projection:+--+-- >>> project (#bar := "hello", #foo := 3) :: ("foo" := Int, "bar" := String)+-- (#foo := 3,#bar := "hello")  module Labels-  (-- Field access-   get-  ,set-  ,modify-  ,cons+-- Field access+  ( get+  , set+  , modify+  , lens+  , cons+  , project    -- Construction-  ,(:=)(..)-  ,Has-  ,Cons-  )+  , (:=)(..)+  , Has+  , Cons+  , Project)   where +import Data.Proxy+import GHC.TypeLits import Labels.Internal++type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)++-- | Make a lens out of the label. Example: @over (lens #salary) (* 1.1) employee@+lens+  :: Has label value record+  => Proxy (label :: Symbol) -> Lens record record value value+lens label f record =+  fmap (\value -> set label value record) (f (get label record))+{-# INLINE lens #-}++-- | Strictly modify a field by doing: @modify #salary (* 1.1) employee@+modify :: Has label value record => Proxy label -> (value -> value) -> record -> record+modify f g r = set f (g v) r+  where !v = get f r+{-# INLINE modify #-}

@@ -1,68 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- | Provide instances of FromNamedRecord for named tuples up to 24 fields.------ Import like: @import Labels.Cassava ()@-----module Labels.Cassava where--import qualified Data.ByteString.Char8 as S8-import           Data.Csv-import qualified Data.HashMap.Strict as M-import           Data.Proxy-import           GHC.TypeLits-import           Labels-import           Language.Haskell.TH--$(let makeInstance :: Int -> Q Dec-      makeInstance size =-          instanceD-              context-              (appT (conT ''FromNamedRecord) instHead)-              [ funD-                    'parseNamedRecord-                    [clause [varP hash_var] (normalB (tuplize (map getter [1::Int .. size]))) []]]-        where-          l_tyvar j = mkName ("l" ++ show j)-          v_tyvar j = mkName ("v" ++ show j)-          hash_var = mkName "hash"-          context =-              return-                  (concat-                       (map-                            (\i ->-                                  [AppT (ConT ''KnownSymbol) (VarT (l_tyvar i))-                                  ,AppT (ConT ''FromField) (VarT (v_tyvar i))])-                            [1 .. size]))-          instHead =-              foldl-                  appT-                  (tupleT size)-                  (map-                       (\j ->-                             appT-                                 (appT (conT ''(:=)) (varT (l_tyvar j)))-                                 (varT (v_tyvar j)))-                       [1 .. size])-          tuplize [] = fail "Need at least one field."-          tuplize [j] = j-          tuplize js = foldl (\acc (i,g) -> infixApp acc (varE (if i == 1-                                                                   then '(<$>)-                                                                   else '(<*>))) g)-                             tupSectionE-                             (zip [1::Int ..] js)-          tupSectionE  =-            lamE (map (varP.var) [1..size])-                 (tupE (map (varE.var) [1..size]))-            where var i = mkName ("t" ++ show i)-          getter (j::Int) =-              [|let proxy = Proxy :: Proxy $(varT (l_tyvar j))-                in case M.lookup (S8.pack (symbolVal proxy)) hash of-                       Nothing -> fail ("Missing field " ++ symbolVal proxy)-                       Just v -> fmap (proxy :=) (parseField v)|]-  in mapM makeInstance [1..24])

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-}@@ -30,6 +31,8 @@  #if __GLASGOW_HASKELL__ >= 800 import GHC.OverloadedLabels+#else+import Data.Proxy #endif  --------------------------------------------------------------------------------@@ -50,26 +53,38 @@   compare (_ := x) (_ := y) = x `compare` y   {-# INLINE compare #-} -instance (Show t) => Show (l := t) where-  show (l := t) = "#" ++ (symbolVal l) ++ " := " ++ show t+instance (Show t) =>+         Show (l := t) where+  showsPrec p (l := t) =+    showParen (p > 10) (showString ("#" ++ (symbolVal l) ++ " := " ++ show t))  --------------------------------------------------------------------------------+-- Labels++#if __GLASGOW_HASKELL__ >= 800+instance l ~ l' =>+         IsLabel (l :: Symbol) (Proxy l') where+    fromLabel _ = Proxy+    {-# INLINE fromLabel #-}+#endif++instance IsString (Q Exp) where+  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]++-------------------------------------------------------------------------------- -- Basic accessors +-- | A record has a certain field which can be set and get. class Has (label :: Symbol) value record | label record -> value where   -- | Get a field by doing: @get #salary employee@   get :: Proxy label -> record -> value   -- | Set a field by doing: @set #salary 54.00 employee@   set :: Proxy label -> value -> record -> record --- | Modify a field by doing: @modify #salary (* 1.1) employee@-modify :: Has label value record => Proxy label -> (value -> value) -> record -> record-modify f g r = set f (g (get f r)) r-{-# INLINE modify #-}- ----------------------------------------------------------------------------------- Cons two records together+-- Cons a field onto a record +-- | A field can be consed onto the beginning of a record. class Cons label value record where   type Consed label value record   -- | Cons a field onto a record by doing: @cons (#foo := 123) record@@@ -86,21 +101,17 @@   {-# INLINE cons #-}  ----------------------------------------------------------------------------------- Labels--#if __GLASGOW_HASKELL__ >= 800-instance l ~ l' =>-         IsLabel (l :: Symbol) (Proxy l') where-    fromLabel _ = Proxy-    {-# INLINE fromLabel #-}-#endif+-- Projection -instance IsString (Q Exp) where-  fromString str = [|Proxy :: Proxy $(litT (return (StrTyLit str)))|]+-- | A record can be narrowed or have its order changed by projecting+-- into record type.+class Project from to where+  project :: from -> to  -------------------------------------------------------------------------------- -- TH-derived instances +-- Generate Cons instances. $(let makeInstance size =         [d|instance Cons $(varT label_tyvar) $(varT value_tyvar) $tupTy where              type Consed $(varT label_tyvar) $(varT value_tyvar) $tupTy = $newTupTy@@ -130,6 +141,7 @@                          [1 .. size])   in fmap concat (mapM makeInstance [2 .. 24])) +-- Generate Has instances. $(let makeInstance size slot =           [d|instance Has $(varT l_tyvar) $(varT a_tyvar) $instHead                where get _ = $getImpl@@ -188,3 +200,40 @@          (mapM (\size -> mapM (\slot -> makeInstance size slot)                               [1 .. size])                 [1 .. 24]))++-- Generate Project instances.+$(let labelt i = varT (mkName ("l" ++ show i))+      labelv i = varE (mkName ("l" ++ show i))+      labelp i = varP (mkName ("l" ++ show i))+      typ i = varT (mkName ("t" ++ show i))+      r = varT (mkName "r")+      rp = varP (mkName "r")+      rv = varE (mkName "r")+  in sequence+       [ instanceD+         (sequence+            ([[t|KnownSymbol $(labelt i)|] | i <- [1 :: Int .. n]] +++             [ [t|Has ($(labelt i) :: Symbol) $(typ i) $(r)|]+             | i <- [1 :: Int .. n]+             ]))+         [t|Project $(r) $(foldl+                             appT+                             (tupleT n)+                             [[t|$(labelt i) := $(typ i)|] | i <- [1 .. n]])|]+         [ funD+             'project+             [ clause+                 [rp]+                 (normalB+                    (tupE+                       [ [|$(labelv i) := get $(labelv i) $(rv)|]+                       | i <- [1 .. n]+                       ]))+                 [ valD (labelp i) (normalB [|Proxy :: Proxy $(labelt i)|]) []+                 | i <- [1 .. n]+                 ]+             ]+         , return (PragmaD (InlineP 'project Inline FunLike AllPhases))+         ]+       | n <- [1 .. 24]+       ])