packages feed

record (empty) → 0.1.0

raw patch · 8 files changed

+873/−0 lines, 8 filesdep +attoparsecdep +basedep +base-preludesetup-changed

Dependencies added: attoparsec, base, base-prelude, record, template-haskell, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ demo/Main.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE NoImplicitPrelude, QuasiQuotes, DataKinds #-}+module Main where++import BasePrelude+import Record+import Record.Lens+++main =+  return ()+++type Person = +  [record| {name :: String, birthday :: {year :: Int, month :: Int, day :: Int}} |]++type Event =+  [record| {name :: String, date :: {year :: Int, month :: Int, day :: Int}} |]++person =+  [record| {name = "Simon Peyton Jones", +            birthday = {year = 1958, month = 1, day = 18}} |]++getPersonBirthdayYear :: Person -> Int+getPersonBirthdayYear =+  view [lens|birthday.year|]++setPersonBirthdayYear :: Int -> Person -> Person+setPersonBirthdayYear =+  set [lens|birthday.year|]++personBirthdayYearLens :: Lens Person Int+personBirthdayYearLens =+  [lens|birthday.year|]++personBirthdayYearLens' :: Lens Person Int+personBirthdayYearLens' =+  [lens|birthday|] . [lens|year|]++tupleLens :: Lens (Int, Char, String) String+tupleLens =+  [lens|3|]++mapThirdElement :: (Char -> Char) -> (Int, String, Char) -> (Int, String, Char)+mapThirdElement =+  over [lens|3|]++functionOnARecord :: [record| {name :: String, age :: Int}|] -> Int+functionOnARecord =+  view [lens|age|]
+ library/Record.hs view
@@ -0,0 +1,268 @@+module Record+(+  record,+  lens,+  -- ** Shorthands+  r,+  l,+)+where++import BasePrelude+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import qualified Record.Types as Types+import qualified Record.Lens as Lens+import qualified Record.Parser as Parser+import qualified Data.Text as T+++-- | A shorthand alias to 'record'.+r :: QuasiQuoter+r = record++-- | A shorthand alias to 'lens'.+l :: QuasiQuoter+l = lens++-- |+-- A quasiquoter, which generates record expressions and types,+-- depending on the context it's used in.+-- +-- Here is how you can use it to declare types:+-- +-- >type Person = +-- >  [record| {name :: String, birthday :: {year :: Int, month :: Int, day :: Int}} |]+-- +-- To declare functions:+-- +-- >getAge :: [record| {name :: String, age :: Int} |] -> Int+-- +-- To declare values:+-- +-- >person :: Person+-- >person =+-- >  [record| {name = "Grigori Yakovlevich Perelman", +-- >            birthday = {year = 1966, month = 6, day = 13}} |]+-- +record :: QuasiQuoter+record =+  QuasiQuoter+    (exp)+    (const $ fail "Pattern context is not supported")+    (type')+    (const $ fail "Declaration context is not supported")+  where+    exp =+      join . fmap (either fail return . renderExp) .+      either (fail . showString "Parser failure: ") return .+      Parser.run (Parser.qq Parser.exp) . fromString+    type' =+      join . fmap (either fail return . renderType) .+      either (fail . showString "Parser failure: ") return .+      Parser.run (Parser.qq Parser.type') . fromString++-- |+-- A quasiquoter, which generates a 'Lens.Lens'.+-- Lens is your interface to accessing and modifying the fields of a record.+-- +-- Here is how you can use it:+-- +-- >getPersonBirthdayYear :: Person -> Int+-- >getPersonBirthdayYear =+-- >  Record.Lens.view ([lens|birthday|] . [lens|year|])+-- +-- For your convenience you can compose lenses from inside of the quotation:+-- +-- >setPersonBirthdayYear :: Int -> Person -> Person+-- >setPersonBirthdayYear =+-- >  Record.Lens.set [lens|birthday.year|]+-- +-- You can also use this function to manipulate tuples of arity up to 24:+-- +-- >mapThirdElement :: (Char -> Char) -> (Int, String, Char) -> (Int, String, Char)+-- >mapThirdElement =+-- >  Record.Lens.over [lens|3|]+lens :: QuasiQuoter+lens =+  QuasiQuoter+    (exp)+    (const $ fail "Pattern context is not supported")+    (const $ fail "Type context is not supported")+    (const $ fail "Declaration context is not supported")+  where+    exp =+      either (fail . showString "Parser failure: ") return .+      fmap renderLens .+      Parser.run (Parser.qq Parser.lens) . fromString++renderLens :: Parser.Lens -> Exp+renderLens =+  foldl1 composition .+  fmap renderSingleLens+  where+    composition a b = +      UInfixE a (VarE '(.)) b++renderSingleLens :: T.Text -> Exp+renderSingleLens =+  AppE (VarE 'Types.lens) .+  SigE (ConE 'Types.Field) .+  AppT (ConT ''Types.Field) .+  LitT . StrTyLit . T.unpack++renderRecordType :: Parser.RecordType -> Either String Type+renderRecordType l =+  checkDuplicateLabels >> getRecordTypeName >>= constructType+  where+    checkDuplicateLabels =+      maybe (return ()) (Left . showString "Duplicate labels: " . show) $+      mfilter (not . null) . Just $ +      map (fst . head) $+      filter ((> 1) . length) $+      groupWith fst l+    getRecordTypeName =+      maybe (Left (showString "Record arity " . shows arity . shows " is not supported" $ ""))+            (Right) $+      recordTypeNameByArity arity+      where+        arity = length l+    constructType n =+      foldl (\a (l, t) -> AppT <$> (AppT <$> a <*> pure (textLitT l)) <*> (renderType t))+            (pure (ConT n))+            (sortWith fst l)+      where+        textLitT =+          LitT . StrTyLit . T.unpack++recordTypeNameByArity :: Int -> Maybe Name+recordTypeNameByArity arity =+  fmap head $ mfilter (not . null) $ Just $+  drop (pred arity) $+  [+    ''Types.Record1, ''Types.Record2, ''Types.Record3, ''Types.Record4, +    ''Types.Record5, ''Types.Record6, ''Types.Record7, ''Types.Record8, +    ''Types.Record9, ''Types.Record10, ''Types.Record11, ''Types.Record12, +    ''Types.Record12, ''Types.Record13, ''Types.Record14, ''Types.Record15, +    ''Types.Record16, ''Types.Record17, ''Types.Record18, ''Types.Record19, +    ''Types.Record20, ''Types.Record21, ''Types.Record22, ''Types.Record22, +    ''Types.Record23, ''Types.Record24+  ]++recordConNameByArity :: Int -> Maybe Name+recordConNameByArity arity =+  fmap head $ mfilter (not . null) $ Just $+  drop (pred arity) $+  [+    'Types.Record1, 'Types.Record2, 'Types.Record3, 'Types.Record4, +    'Types.Record5, 'Types.Record6, 'Types.Record7, 'Types.Record8, +    'Types.Record9, 'Types.Record10, 'Types.Record11, 'Types.Record12, +    'Types.Record12, 'Types.Record13, 'Types.Record14, 'Types.Record15, +    'Types.Record16, 'Types.Record17, 'Types.Record18, 'Types.Record19, +    'Types.Record20, 'Types.Record21, 'Types.Record22, 'Types.Record22, +    'Types.Record23, 'Types.Record24+  ]++renderType :: Parser.Type -> Either String Type+renderType =+  \case+    Parser.Type_App a b  -> AppT <$> renderType a <*> renderType b+    Parser.Type_Var n    -> return $ VarT (mkName (T.unpack n))+    Parser.Type_Con n    -> return $ ConT (mkName (T.unpack n))+    Parser.Type_Tuple a  -> return $ TupleT a+    Parser.Type_Arrow    -> return $ ArrowT+    Parser.Type_List     -> return $ ListT+    Parser.Type_Record a -> renderRecordType a++renderExp :: Parser.Exp -> Either String Exp+renderExp =+  \case+    Parser.Exp_Record r   -> renderRecordExp r+    Parser.Exp_Var n      -> return $ VarE (mkName (T.unpack n))+    Parser.Exp_Con n      -> return $ ConE (mkName (T.unpack n))+    Parser.Exp_TupleCon a -> return $ ConE (tupleDataName a)+    Parser.Exp_Nil        -> return $ ConE ('[])+    Parser.Exp_Lit l      -> return $ LitE (renderLit l)+    Parser.Exp_App a b    -> AppE <$> renderExp a <*> renderExp b+    Parser.Exp_List l     -> ListE <$> traverse renderExp l+    Parser.Exp_Sig e t    -> SigE <$> renderExp e <*> renderType t++renderRecordExp :: Parser.RecordExp -> Either String Exp+renderRecordExp l =+  checkDuplicateLabels >> getConLambda >>= constructExp+  where+    checkDuplicateLabels =+      maybe (return ()) (Left . showString "Duplicate labels: " . show) $+      mfilter (not . null) . Just $ +      map (fst . head) $+      filter ((> 1) . length) $+      groupWith fst l+    getConLambda =+      maybe (Left (showString "Record arity " . shows arity . shows " is not supported" $ ""))+            (Right) $+      conLambdaExp arity+      where+        arity = length l+    constructExp lam =+      foldl (\a (n, e) -> AppE <$> (AppE <$> a <*> pure (proxy n)) <*> renderExp e)+            (pure lam)+            (sortWith fst l)+      where+        proxy n =+          SigE (ConE 'Types.Field) +               (AppT (ConT ''Types.Field) (LitT (StrTyLit (T.unpack n))))++renderLit :: Parser.Lit -> Lit+renderLit =+  \case+    Parser.Lit_Char c -> CharL c+    Parser.Lit_String t -> StringL (T.unpack t)+    Parser.Lit_Integer i -> IntegerL i+    Parser.Lit_Rational r -> RationalL r++-- |+-- Allows to specify names in types signatures,+-- leaving the value type resolution to the compiler.+-- +-- E.g.,+-- +-- >(\_ v1 _ v2 -> Record2 v1 v2) :: Types.Field n1 -> v1 -> Types.Field n2 -> v2 -> Record2 n1 v1 n2 v2+-- +-- We can set the name signatures by passing+-- proxies with explicit signatures to this lambda.+conLambdaExp :: Int -> Maybe Exp+conLambdaExp arity =+  SigE <$> exp <*> t+  where+    exp =+      LamE <$> pure pats <*> exp+      where+        pats =+          concat $ flip map [1 .. arity] $ \i -> [WildP, VarP (mkName ("v" <> show i))]+        exp =+          foldl AppE <$> (ConE <$> recordConNameByArity arity) <*> +                         pure (map (\i -> VarE (mkName ("v" <> show i))) [1 .. arity])+    t =+      fnType <$> recordTypeNameByArity arity+      where+        fnType conName =+          ForallT varBndrs [] $+          foldr1 (\l r -> AppT (AppT ArrowT l) r)+                 (argTypes <> pure (resultType conName))+        varBndrs =+          concat $ flip map [1 .. arity] $ \i ->+            PlainTV (mkName ("n" <> show i)) :+            PlainTV (mkName ("v" <> show i)) :+            []+        argTypes =+          concat $ flip map [1 .. arity] $ \i -> +            AppT (ConT ''Types.Field) (VarT (mkName ("n" <> show i))) :+            VarT (mkName ("v" <> show i)) :+            []+        resultType conName =+          foldl AppT (ConT conName) $ concat $ flip map [1 .. arity] $ \i ->+            VarT (mkName ("n" <> show i)) :+            VarT (mkName ("v" <> show i)) :+            []++
+ library/Record/Lens.hs view
@@ -0,0 +1,38 @@+-- |+-- A minimal subset of the "lens" library functionality,+-- which is completely compatible with it.+-- +-- Unless you use the "lens" library itself, +-- this module is your interface to manipulating the record fields.+module Record.Lens where++import BasePrelude+import Data.Functor.Identity+++-- |+-- A reference to from a datastructure @s@ to some part @a@,+-- which can be used to manipulate that particular part.+type Lens s a = +  forall f. Functor f => (a -> f a) -> (s -> f s)++-- |+-- Given a lens to a subpart and a datastructure,+-- produce the value of the referred subpart.+view :: Lens s a -> s -> a+view l =+  getConst . l Const++-- |+-- Given a lens to a subpart, a new value for it and a datastructure,+-- produce an updated datastructure.+set :: Lens s a -> a -> s -> s+set l a =+  runIdentity . l (Identity . const a)++-- |+-- Given a lens to a subpart, and an update function for it,+-- produce a function, which updates the datastructure.+over :: Lens s a -> (a -> a) -> s -> s+over l f =+  runIdentity . l (Identity . f)
+ library/Record/Parser.hs view
@@ -0,0 +1,219 @@+module Record.Parser where++import BasePrelude hiding (takeWhile, exp)+import Data.Text (Text)+import Data.Attoparsec.Text+import qualified Data.Text as T+++data Type =+  Type_App Type Type |+  Type_Var Text |+  Type_Con Text |+  Type_Tuple Int |+  Type_Arrow |+  Type_List |+  Type_Record RecordType++type QualifiedName =+  [Text]++type RecordType =+  [(Text, Type)]+++run :: Parser a -> Text -> Either String a+run p t =+  onResult $ parse p t+  where+    onResult =+      \case+        Fail _ contexts message -> Left $ showString message . showString ". Contexts: " .+                                          shows contexts $ "."+        Done _ a -> Right a+        Partial c -> onResult (c "")++labeled :: String -> Parser a -> Parser a+labeled =+  flip (<?>)++qq :: Parser a -> Parser a+qq p =+  skipSpace *> p <* skipSpace <* endOfInput++type' :: Parser Type+type' =+  labeled "type'" $+  appType <|> nonAppType+  where+    appType =+      fmap (foldl1 Type_App) $+      sepBy1 nonAppType (skipMany1 space)+    nonAppType =+      varType <|> conType <|> tupleConType <|> tupleType <|> listConType <|> +      arrowType <|> (Type_Record <$> recordType) <|> inBraces type'+      where+        varType =+          fmap Type_Var $ lowerCaseName+        conType =+          fmap Type_Con $ upperCaseName+        tupleConType =+          fmap Type_Tuple $ +            char '(' *> (length <$> many1 (skipSpace *> char ',')) <* skipSpace <* char ')'+        tupleType =+          fmap (\l -> foldl Type_App (Type_Tuple (length l)) l) $+            char '(' *> skipSpace *>+            sepBy1 type' (skipSpace *> char ',' <* skipSpace)+            <* skipSpace <* char ')'+        listConType =+          Type_List <$ string "[]"+        arrowType =+          Type_Arrow <$ string "->"++recordType :: Parser RecordType+recordType =+  labeled "recordType" $+    char '{' *> skipSpace *> sepBy1' field (skipSpace *> char ',' <* skipSpace) <* skipSpace <* char '}'+  where+    field =+      (,) <$> (lowerCaseName <* skipSpace <* string "::" <* skipSpace) <*> type'++qualifiedName1 :: Parser QualifiedName+qualifiedName1 =+  ((\a b -> a <> pure b) <$> many1 (upperCaseName <* char '.') <*> lowerCaseName) <|> +  (pure <$> lowerCaseName)++inBraces :: Parser a -> Parser a+inBraces p =+  char '(' *> skipSpace *> p <* skipSpace <* char ')'++lowerCaseName :: Parser Text+lowerCaseName =+  labeled "lowerCaseName" $+    T.cons <$>+      satisfy (\c -> isLower c || c == '_') <*>+      takeWhile (\c -> isAlphaNum c || c == '\'' || c == '_')++upperCaseName :: Parser Text+upperCaseName =+  labeled "upperCaseName" $+    T.cons <$>+      satisfy (\c -> isUpper c || c == '_') <*>+      takeWhile (\c -> isAlphaNum c || c == '\'' || c == '_')++symbolicIdent :: Parser Text+symbolicIdent =+  labeled "symbolicIdent" $+    (\t -> "(" <> t <> ")") <$> (char '(' *> takeWhile1 isSymbol <* char ')')+  where+    isSymbol =+      flip elem ("!#$%&*+./<=>?@\\^|-~" :: [Char])++stringLit :: Parser Text+stringLit =+  quoted '"'+  where +    quoted q = +      T.pack <$> (char q *> content <* char q)+      where+        content =+          many char'+          where+            char' = +              (char '\\' *> (char q <|> char '\\')) <|>+              (notChar q)++charLit :: Parser Char+charLit =+  char '\'' *> ((char '\\' *> (char '\'' <|> char '\\')) <|> notChar '\'') <* char '\''+++type Lens =+  [Text]++lens :: Parser Lens+lens =+  labeled "lens" $+    sepBy1 (lowerCaseName <|> takeWhile1 isDigit) (char '.')+++data Exp =+  Exp_Record RecordExp |+  Exp_Var Text |+  Exp_Con Text |+  Exp_TupleCon Int |+  Exp_Nil |+  Exp_Lit Lit |+  Exp_App Exp Exp |+  Exp_List [Exp] |+  Exp_Sig Exp Type++type RecordExp =+  [(Text, Exp)]++data Lit =+  Lit_Char Char |+  Lit_String Text |+  Lit_Integer Integer |+  Lit_Rational Rational++exp :: Parser Exp+exp =+  labeled "exp" $+    sig <|> nonSig+  where+    sig =+      Exp_Sig <$> nonSig <*> (skipSpace *> string "::" *> skipSpace *> type')+    nonSig =+      app <|> nonApp+      where+        app =+          fmap (foldl1 Exp_App) $+          sepBy1 nonApp (skipMany1 space)+        nonApp =+          record <|>+          var <|>+          con <|>+          tupleCon <|>+          nil <|>+          Exp_Lit <$> lit <|>+          tuple <|>+          list <|>+          inBraces exp+          where+            record =+              Exp_Record <$> (char '{' *> skipSpace *> fields <* skipSpace <* char '}')+              where+                fields =+                  sepBy1 field (skipSpace *> char ',' <* skipSpace)+                  where+                    field =+                      (,) <$> lowerCaseName <*> (skipSpace *> char '=' *> skipSpace *> exp)+            var =+              Exp_Var <$> (lowerCaseName <|> symbolicIdent)+            con =+              Exp_Con <$> (upperCaseName <|> symbolicIdent)+            tupleCon =+              Exp_TupleCon . length <$> +              (char '(' *> many1 (char ',') <* char ')')+            nil =+              Exp_Nil <$ string "[]"+            tuple =+              fmap (\l -> foldl Exp_App (Exp_TupleCon (length l)) l) $+                char '(' *> skipSpace *>+                sepBy1 exp (skipSpace *> char ',' <* skipSpace)+                <* skipSpace <* char ')'+            list =+              fmap Exp_List $+                char '[' *> skipSpace *> +                  sepBy1 exp (skipSpace *> char ',' <* skipSpace) <*+                  skipSpace <* char ']'++lit :: Parser Lit+lit =+  Lit_Char <$> charLit <|>+  Lit_String <$> stringLit <|>+  Lit_Rational <$> rational <|>+  Lit_Integer <$> decimal++
+ library/Record/Types.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE CPP, UndecidableInstances #-}+-- |+-- The contents of this module may seem a bit overwhelming. +-- Don't worry,+-- all it does is just cover instances and datatypes of records and tuples of+-- huge arities.+-- +-- You don't actually need to ever use this module,+-- since all the functionality you may need is presented +-- by the quasiquoters exported in the root module.+module Record.Types where++import BasePrelude hiding (Proxy)+import Data.Functor.Identity+import GHC.TypeLits+import Record.Lens (Lens)+import Language.Haskell.TH+++-- |+-- Defines a way to access some value of a type as field,+-- using the string type literal functionality.+-- +-- Instances are provided to all records and to tuples of arity of up to 24.+-- +-- Here's how you can use it with tuples:+-- +-- >trd :: FieldOwner "3" v a => a -> v+-- >trd = getField (Field :: Field "3")+-- +-- The function above will get you the third item of any tuple, which has it.+class FieldOwner (n :: Symbol) v a | n a -> v where+  setField :: Field n -> v -> a -> a+  getField :: Field n -> a -> v++-- |+-- Generate a lens using the 'FieldOwner' instance.+-- +-- >ageLens :: FieldOwner "age" v a => Lens a v+-- >ageLens = lens (Field :: Field "age") +lens :: FieldOwner n v a => Field n -> Lens a v+lens n =+  \f a -> fmap (\v -> setField n v a) (f (getField n a))++-- |+-- A specialised version of "Data.Proxy.Proxy".+-- Defined for compatibility with \"base-4.6\", +-- since @Proxy@ was only defined in \"base-4.7\".+data Field (t :: Symbol) = Field++-- * Record Types+-------------------------++-- Generate Record types+return $ flip map [1 .. 24] $ \arity ->+  let+    typeName =+      mkName $ "Record" <> show arity+    varBndrs =+      do+        i <- [1 .. arity]+        let+          n = KindedTV (mkName ("n" <> show i)) (ConT ''Symbol)+          v = PlainTV (mkName ("v" <> show i))+          in [n, v]+    conTypes =+      do+        i <- [1 .. arity]+        return $ (,) (NotStrict) (VarT (mkName ("v" <> show i)))+    derivingNames =+#if MIN_VERSION_base(4,7,0)+      [''Show, ''Eq, ''Ord, ''Typeable, ''Generic]+#else+      [''Show, ''Eq, ''Ord, ''Generic]+#endif+    in+      DataD [] typeName varBndrs [NormalC typeName conTypes] derivingNames+++-- Generate Record FieldOwner instances+return $ do+  arity <- [1 .. 24]+  nIndex <- [1 .. arity]+  return $+    let+      typeName =+        mkName $ "Record" <> show arity+      selectedNVarName =+        mkName $ "n" <> show nIndex+      selectedVVarName =+        mkName $ "v" <> show nIndex+      recordType =+        foldl (\a i -> AppT (AppT a (VarT (mkName ("n" <> show i))))+                            (VarT (mkName ("v" <> show i))))+              (ConT typeName)+              [1 .. arity]+      setFieldLambda =+        LamE [VarP vVarName, ConP typeName (fmap VarP indexedVVarNames)] exp+        where+          vVarName =+            mkName "v"+          indexedVVarNames =+            fmap (\i -> mkName ("v" <> show i)) [1..arity]+          exp =+            foldl (\a i -> AppE a (VarE (mkName (if i == nIndex then "v" else "v" <> show i))))+                  (ConE typeName)+                  [1 .. arity]+      getFieldLambda =+        LamE [ConP typeName vPatterns] (VarE (vVarName))+        where+          vVarName =+            mkName "v"+          vPatterns =+            flip map [1 .. arity] $ \i ->+              if i == nIndex+                then VarP vVarName+                else WildP+      in+        head $ unsafePerformIO $ runQ $+        [d|+          instance FieldOwner $(varT selectedNVarName)+                              $(varT selectedVVarName)+                              $(pure recordType)+                              where+            setField = const $ $(pure setFieldLambda)+            getField = const $ $(pure getFieldLambda)+        |]++        +instance FieldOwner "1" v1 (Identity v1) where+  setField _ v _ = Identity v+  getField _ = runIdentity+++-- Generate FieldOwner instances for tuples+return $ do+  arity <- [2 .. 24]+  nIndex <- [1 .. arity]+  return $+    let+      typeName =+        tupleTypeName arity+      conName =+        tupleDataName arity+      selectedVVarName =+        mkName $ "v" <> show nIndex+      tupleType =+        foldl (\a i -> AppT a (VarT (mkName ("v" <> show i))))+              (ConT typeName)+              [1 .. arity]+      setFieldLambda =+        LamE [VarP vVarName, ConP conName (fmap VarP indexedVVarNames)] exp+        where+          vVarName =+            mkName "v"+          indexedVVarNames =+            fmap (\i -> mkName ("v" <> show i)) [1..arity]+          exp =+            foldl (\a i -> AppE a (VarE (mkName (if i == nIndex then "v" else "v" <> show i))))+                  (ConE conName)+                  [1 .. arity]+      getFieldLambda =+        LamE [ConP conName vPatterns] (VarE (vVarName))+        where+          vVarName =+            mkName "v"+          vPatterns =+            flip map [1 .. arity] $ \i ->+              if i == nIndex+                then VarP vVarName+                else WildP+      in+        head $ unsafePerformIO $ runQ $+        [d|+          instance FieldOwner $(pure (LitT (StrTyLit (show nIndex))))+                              $(varT selectedVVarName)+                              $(pure tupleType)+                              where+            setField = const $ $(pure setFieldLambda)+            getField = const $ $(pure getFieldLambda)+        |]
+ record.cabal view
@@ -0,0 +1,94 @@+name:+  record+version:+  0.1.0+synopsis:+  First class records implemented with quasi-quotation+description:+  An API of just two quasi-quoters, +  providing a full-scale solution to the notorious records problem of Haskell.+  .+  Links:+  .+  * <http://nikita-volkov.github.io/record A comprehensive introduction to the library>.+  .+  * <https://github.com/nikita-volkov/record/blob/master/demo/Main.hs Demo>.+  .+category:+  Control, Data Structures+homepage:+  https://github.com/nikita-volkov/record +bug-reports:+  https://github.com/nikita-volkov/record/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/record.git+++library+  hs-source-dirs:+    library+  ghc-options:+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    Record.Parser+  exposed-modules:+    Record.Types+    Record.Lens+    Record+  build-depends:+    -- +    attoparsec >= 0.10 && < 0.13,+    -- +    text,+    --+    template-haskell,+    -- +    transformers >= 0.2 && < 0.5,+    base-prelude >= 0.1 && < 0.2,+    base >= 4.6 && < 4.9+++-- Well, it's not a benchmark actually, +-- but in Cabal there's no better way to specify an executable, +-- which is not intended for distribution.+benchmark demo+  type: +    exitcode-stdio-1.0+  hs-source-dirs:+    demo+  main-is:+    Main.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+    -funbox-strict-fields+    -ddump-splices+  default-language:+    Haskell2010+  build-depends:+    record,+    base-prelude