generic-accessors 0.6.0.1 → 0.6.1.0

raw patch · 4 files changed

+99/−30 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• .gitignore +1/−0
• .travis.yml +15/−27
• generic-accessors.cabal +1/−1
• src/Accessors/Dynamic.hs +82/−2

@@ -1,1 +1,2 @@+.stack-work dist

@@ -1,34 +1,22 @@-# from https://github.com/hvr/multi-ghc-travis+sudo: false -env:- - GHCVER=7.6.3- - GHCVER=7.8.4 # see note about Alex/Happy- - GHCVER=7.10.3 # see note about Alex/Happy+addons:+  apt:+    packages:+    - libgsl0-dev+    - liblapack-dev  before_install:- - travis_retry sudo add-apt-repository -y ppa:hvr/ghc- - travis_retry sudo apt-get update- - travis_retry sudo apt-get install cabal-install-1.24 ghc-$GHCVER libgsl0-dev liblapack-dev- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.24/bin:$PATH+ # Download and unpack the stack executable+ - mkdir -p ~/.local/bin+ - export PATH=$HOME/.local/bin:$PATH+ - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'+ - chmod a+x ~/.local/bin/stack  install:- - cabal update- - cabal install --only-dependencies --enable-tests --enable-benchmarks+  - stack setup --no-terminal+  - stack build --no-terminal --only-snapshot -# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail. script:- - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging- - cabal build   # this builds all libraries and executables (including tests/benchmarks)- - cabal test --show-details=always-# - cabal check- - cabal sdist   # tests that a source-distribution can be generated--# The following scriptlet checks that the resulting source distribution can be built & installed- - export SRC_TGZ=$(cabal-1.24 info . | awk '{print $2 ".tar.gz";exit}') ;-   cd dist/;-   if [ -f "$SRC_TGZ" ]; then-      cabal install "$SRC_TGZ";-   else-      echo "expected '$SRC_TGZ' not found";-      exit 1;-   fi+  - stack build --no-terminal --test+  - stack sdist

@@ -1,5 +1,5 @@ name:                generic-accessors-version:             0.6.0.1+version:             0.6.1.0 synopsis:            stringly-named getters for generic data license:             BSD3 license-file:        LICENSE

@@ -6,6 +6,7 @@ module Accessors.Dynamic        ( DTree, DData(..), DConstructor(..), DSimpleEnum(..), DField(..)        , toDData, updateLookupable, describeDField, sameDFieldType+       , diffDTrees          -- * some utility functions for working with DSimpleEnums        , denumToString, denumToStringOrMsg, denumSetString, denumSetIndex        ) where@@ -15,6 +16,7 @@ import Data.Binary ( Binary ) import Data.Serialize ( Serialize ) import Data.Data ( Data )+import Data.Either ( partitionEithers ) import Data.List ( intercalate ) import Data.Typeable ( Typeable ) import Control.Lens@@ -120,7 +122,7 @@     toDConstructor :: GAConstructor a -> DConstructor     toDConstructor (GASum e) =       DSum (DSimpleEnum (eConstructors e) (eToIndex e x))-      +     toDConstructor (GAConstructor cname fields) =       DConstructor cname $ map (\(n, f) -> (n, toDData' f)) fields @@ -182,7 +184,7 @@         "dynamic fields have different length than accessor fields\n" ++         "dynamic fields: " ++ show (map fst dfields) ++ "\n" ++         "accessor fields: " ++ show (map fst afields)-        +       f :: a            -> [(Maybe String, Either (GAField a) (GAData a))]            -> [(Maybe String, DTree)]@@ -219,3 +221,81 @@ fieldMismatch f d =   "accessor GAField " ++ describeGAField f ++   " got incompatible dynamic DField " ++ describeDField d+++diffDTrees :: DTree -> DTree -> [String]+diffDTrees = diffDTrees' []++showName :: [String] -> String+showName = intercalate "." . reverse++diffDTrees' :: [String] -> DTree -> DTree -> [String]+diffDTrees' name (Left x) (Left y) = case diffDFields name x y of+  Nothing -> []+  Just r -> [r]+diffDTrees' name (Right x) (Right y) = diffDData name x y+diffDTrees' name _ _ = [showName name ++ " have different types"]++diffDFields :: [String] -> DField -> DField -> Maybe String+diffDFields name (DDouble x) (DDouble y) = diffEq name x y+diffDFields name (DFloat  x) (DFloat  y) = diffEq name x y+diffDFields name (DInt    x) (DInt    y) = diffEq name x y+diffDFields name (DString x) (DString y) = diffEq name x y+diffDFields name DSorry DSorry = Just (showName name ++ ": can't diff this type")+diffDFields name x y+  | sameDFieldType x y = Just $ showName name ++ ": ERROR! unhandled type " ++ show (x, y)+  | otherwise = Just $ showName name ++ ": has different types"++diffEq :: (Eq a, Show a) => [String] -> a -> a -> Maybe String+diffEq name x y+  | x == y = Nothing+  | otherwise = Just (showName name ++ ": " ++ show x ++ " /= " ++ show y)+++data MaybeRecords+  = Record [(String, DTree)]+  | NoRecord [DTree]+  | Mixed+  | EmptyCon++toMaybeRecords :: [(Maybe String, DTree)] -> MaybeRecords+toMaybeRecords xs = case partitionEithers (map f xs) of+  ([], []) -> EmptyCon+  ([], r) -> Record r+  (r, []) -> NoRecord r+  _ -> Mixed+  where+    f (Just x, t) = Right (x, t)+    f (Nothing, t) = Left t++diffDData :: [String] -> DData -> DData -> [String]+diffDData name (DData dx (DSum sx@(DSimpleEnum csx kx))) (DData dy (DSum sy@(DSimpleEnum csy ky)))+  | (dx /= dy) || (csx /= csy) = [showName name ++ " have different types"]+  | kx /= ky = case (denumToString sx, denumToString sy) of+      (Right nx, Right ny) -> [showName name ++ ": " ++ nx ++ " /= " ++ ny]+      (nx, ny) -> [showName name ++ ": ERROR converting to enum! " ++ intercalate ", " (lefts [nx, ny])]+  | otherwise = []+diffDData name (DData dx (DConstructor cx xs)) (DData dy (DConstructor cy ys))+  | (dx, cx) /= (dy, cy) = [showName name ++ " has different types " ++ show ((dx, cx), (dy, cy))]+  | otherwise = case (toMaybeRecords xs, toMaybeRecords ys) of+      (Mixed, Mixed) -> [showName name ++ " has mixed types WTF"]+      (EmptyCon, EmptyCon) -> []+      (NoRecord x, NoRecord y)+        | length x == length y ->+            let diffChild k = diffDTrees' (arrayName k:name)+            in concat $ zipWith3 diffChild [0..] x y+        | otherwise -> [showName name ++ " has different types"]+      (Record x, Record y)+        | map fst x /= map fst y -> [showName name ++ " has different types"]+      _ -> [showName name ++ " has different types"]+diffDData name _ _ = [showName name ++ " has different types"]++--  | otherwise = zipWith diffDData+arrayName :: Int -> String+arrayName k = '[':(show k ++ "]")+++lefts :: [Either a b] -> [a]+lefts ((Left x):xs) = x:lefts xs+lefts ((Right _):xs) = lefts xs+lefts [] = []