composite-base (empty) → 0.1.0.0

raw patch · 4 files changed

+106/−0 lines, 4 filesdep +Framesdep +basedep +basic-preludesetup-changed

Dependencies added: Frames, base, basic-prelude, lens, template-haskell, text, vinyl

Files

• Setup.hs +2/−0
• composite-base.cabal +34/−0
• src/Composite/Base.hs +26/−0
• src/Composite/TH.hs +44/−0

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

@@ -0,0 +1,34 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           composite-base+version:        0.1.0.0+synopsis:       Shared utilities for composite-* packages.+description:    Shared helpers for the various composite packages.+category:       Records+homepage:       https://github.com/ConferHealth/composite#readme+author:         Confer Health, Inc+maintainer:     oss@confer.care+copyright:      2017 Confer Health, Inc.+license:        BSD3+build-type:     Simple+cabal-version:  >= 1.10++library+  hs-source-dirs:+      src+  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NoImplicitPrelude OverloadedStrings PolyKinds ScopedTypeVariables StrictData TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  ghc-options: -Wall -O2+  build-depends:+      base >= 4.7 && < 5+    , Frames+    , basic-prelude+    , template-haskell+    , lens+    , text+    , vinyl+  exposed-modules:+      Composite.Base+      Composite.TH+  default-language: Haskell2010

@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Composite.Base (NamedField(..), fieldAsPair) where++import BasicPrelude+import Control.Lens (Wrapped(type Unwrapped, _Wrapped'), Rewrapped, _Wrapped, iso, view)+import Data.Proxy (Proxy(Proxy))+import Data.Text (pack)+import Frames ((:->)(Col, getCol))+import GHC.TypeLits (KnownSymbol, symbolVal)++-- |Class of types which represent fields which can be named statically (i.e. via their type only) and contain some value.+class (Wrapped f, Rewrapped f f) => NamedField f where+  -- |Reflect the name of the field as @Text@ given some proxy representing the type.+  fieldName :: proxy f -> Text++-- |Extract the value and reflect the name of some named field.+fieldAsPair :: forall f. NamedField f => f -> (Text, Unwrapped f)+fieldAsPair = (fieldName (Proxy :: Proxy f),) . view _Wrapped++instance Wrapped (s :-> a) where+  type Unwrapped (s :-> a) = a+  _Wrapped' = iso getCol Col++instance (t ~ (s :-> b)) => Rewrapped (s :-> a) t+instance KnownSymbol s => NamedField (s :-> a) where+  fieldName _ = pack $ symbolVal (Proxy :: Proxy s)

@@ -0,0 +1,44 @@+module Composite.TH where++import BasicPrelude+import Control.Lens (_1, _head, each, over, toListOf)+import Data.Char (toLower)+import Data.Proxy (Proxy(Proxy))+import Language.Haskell.TH (Q, Body(NormalB), Dec(SigD, ValD), Pat(VarP), Type(ConT), mkName, nameBase)+import Language.Haskell.TH.Lens (_TySynD)++-- |Make 'Proxy' definitions for each of the @type@ synonyms in the given block of declarations. The proxies have the same names as the synonyms but with+-- the first letter lowercased.+--+-- For example:+--+-- @+--   withProxies [d|+--     type FFoo = "foo" :-> Int+--     |]+-- @+--+-- Is equivalent to:+--+-- @+--   type FFoo = "foo" :-> Int+--   fFoo :: Proxy FFoo+--   fFoo = Proxy+-- @+--+-- __Note:__ the trailing @|]@ of the quasi quote bracket has to be indented or a parse error will occur.+withProxies :: Q [Dec] -> Q [Dec]+withProxies qDecs = do+  decs <- qDecs+  proxyDecs <- traverse proxyDecForName (toListOf (each . _TySynD . _1) decs)+  pure $ decs <> concat proxyDecs+  where+    proxyDecForName tySynName = do+      let tySynType = pure $ ConT tySynName+          proxyName = mkName . over _head toLower . nameBase $ tySynName+      proxyType <- [t|Proxy $tySynType|]+      proxyVal <- [|Proxy|]+      pure+        [ SigD proxyName proxyType+        , ValD (VarP proxyName) (NormalB proxyVal) []+        ]