packages feed

cassava-generic (empty) → 0.1.0.0

raw patch · 7 files changed

+228/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, cassava, data-default, text, unordered-containers, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,17 @@+# Changelog for cassava-generics++# Version 0.1.0, July 30th, 2020++* First public release to Hackage.++# Version 0.0.2, June 2020++* Added generic instances for Identity functor.++# Version 0.0.1, April 2020++* Generic instances for Either and Maybe++## Unreleased changes++
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michał J. Gajda (c) 2020++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 Michał J. Gajda 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.
+ README.md view
@@ -0,0 +1,12 @@+# cassava-generics++Cassava `ToNamedField` instances for standard functors and datatypes.+They depend on both `ToNamedField` and `DefaultHeaderOrder` instances for `a`:++* `Either String a`+* `Maybe a`++Also for convenience instances for common types:+* [Text] -- tag list+* [(Text,Text)] -- assoc list+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cassava-generic.cabal view
@@ -0,0 +1,47 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b4f6db6bae8ab8a4834c5ec3bd12d71c696a73772a59b0be938655b6856b11d7++name:           cassava-generic+version:        0.1.0.0+synopsis:       Cassave instances for functor-like datatypes like `Either String a`.+description:    Please see the README on GitHub at <https://github.com/mjgajda/cassava-generics#readme>+category:       Data+homepage:       https://github.com/mjgajda/cassava-generic#readme+bug-reports:    https://github.com/mjgajda/cassava-generic/issues+author:         Michał J. Gajda+maintainer:     mjgajda@migamake.com+copyright:      Migamake '2020+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/mjgajda/cassava-generic++library+  exposed-modules:+      Data.Csv.GenericInstances+      Data.Functor.Identity.Default+  other-modules:+      Paths_cassava_generic+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , cassava+    , data-default+    , text+    , unordered-containers+    , vector+  default-language: Haskell2010
+ src/Data/Csv/GenericInstances.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+-- | Generic instances of Csv.ToNamedRecord,+--   and Csv.DefaultOrdered.+--+--   Allow modular treatment of nested records when writing with Cassava.+module Data.Csv.GenericInstances+  ( -- Instances only+  )+where++import            GHC.Generics+import            Data.Typeable+import            Data.Aeson+import            Data.List                   (sort)+import            Data.Aeson.Types            (prependFailure)+import            Control.Applicative+import            Data.Text             as Text+import qualified  Data.ByteString.Char8 as BS+import qualified  Data.Text.Encoding    as Text+import            Data.Vector+import qualified  Data.Foldable         as F+import            Data.Functor.Identity+import qualified  Data.HashMap.Strict   as Map+import            Data.Default+import            Data.Functor.Classes+import qualified  Data.Csv              as Csv++-- * Missing instances of `Data.Csv.ToField class`+instance Csv.ToField [Text] where+  toField = Text.encodeUtf8 . Text.intercalate " "++instance Csv.ToField  Bool where+  toField True  = "yes"+  toField False = "no"++instance Csv.ToField [String] where+  toField aList = " " `BS.intercalate` (BS.pack <$> aList)++-- * Assoc list:+instance Csv.ToField [(Text, Text)] where+  toField ttList = " " `BS.intercalate` Prelude.map (+        \(a, b) ->+          Text.encodeUtf8 $ "=" `Text.intercalate` [a, b]) ttList++instance {-# OVERLAPPABLE #-} Show a => Csv.ToField a where+  toField = BS.pack . show++-- * These instances assume that we use argument for `headerOrder` like `Proxy`+--   (so do not need value at all).+-- Generic Either instance for ToNamedRecord+instance (Csv.DefaultOrdered a+         ,Csv.ToNamedRecord a)+      =>  Csv.ToNamedRecord (Either String a) where+  toNamedRecord (arg :: Either String a) = case arg of+      Left msg  -> Csv.namedRecord (F.foldMap emptyField subHeader)+                <> errorField msg+      Right  r  -> Csv.toNamedRecord r+                <> errorField (""::String)+    where+      subHeader :: Csv.Header+      subHeader = Csv.headerOrder (error "fails in ToNamedRecord (Either String a)" :: a)+      errorField errorMessage = Csv.namedRecord+        [(Data.Vector.head subHeader<>"_error") Csv..= errorMessage]++-- Generic Either instance for ToNamedRecord+instance (Csv.DefaultOrdered a+         ,Csv.ToNamedRecord a)+      =>  Csv.DefaultOrdered (Either String a) where+  headerOrder (_ :: Either String a) = Csv.header [Data.Vector.head subHeader<>"_error"]+                                      <>                              subHeader+    where+      subHeader :: Csv.Header+      subHeader = Csv.headerOrder (error "fails in DefaultOrdered (Either String a)" :: a)++-- Generic Maybe instance for ToNamedRecord+instance (Csv.DefaultOrdered a+         ,Csv.ToNamedRecord a)+      =>  Csv.ToNamedRecord (Maybe a) where+  toNamedRecord (arg :: Maybe a) = case arg of+      Nothing -> Csv.namedRecord (F.foldMap emptyField subHeader)+      Just  r -> Csv.toNamedRecord r+    where+      subHeader :: Csv.Header+      subHeader = Csv.headerOrder (error "fails in ToNamedRecord (Maybe a)" :: a)++-- | Generic Identity instance for ToNamedRecord+instance Csv.ToNamedRecord           a+      => Csv.ToNamedRecord (Identity a) where+  toNamedRecord (Identity a) = Csv.toNamedRecord a++-- | Empty field for generic instances+emptyField name = [name Csv..= ("" :: String)]++instance (Csv.DefaultOrdered a+         ,Csv.ToNamedRecord  a)+      =>  Csv.DefaultOrdered (Maybe a) where+  headerOrder (_ :: Maybe a) = subHeader+    where+      subHeader :: Csv.Header+      subHeader = Csv.headerOrder (error "fails in DefaultOrdered (Maybe a)" :: a)++-- | Generic Identity instance for DefaultOrdered+instance Csv.DefaultOrdered           a+      => Csv.DefaultOrdered (Identity a) where+  headerOrder _ = Csv.headerOrder (undefined :: a)
+ src/Data/Functor/Identity/Default.hs view
@@ -0,0 +1,11 @@+module Data.Functor.Identity.Default(+  -- instances only+  ) where++import Data.Default+import Data.Functor.Identity++-- * Missing instances of `Data.Default.Default class`+instance Default a => Default (Identity a) where+  def = Identity def+