generic-accessors 0.3.0 → 0.4.0

raw patch · 4 files changed

+51/−31 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• generic-accessors.cabal +1/−1
• src/Accessors.hs +21/−14
• tests/Tests.hs +24/−16

@@ -10,3 +10,8 @@ 0.3 --- * Fix setters++0.4+---+* Revive convenience show functions+* Ints and Bools are no longer shown as floats

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

@@ -306,35 +306,42 @@   toAccessorTree x get set = toAccessorTree (unV x) (unV . get) (set . V3T) instance Lookup a => Lookup (Euler a) -showAccTrees :: (Getter a -> String) -> [(String, AccessorTree a)] -> String -> [String]-showAccTrees show' trees spaces = concat cs ++ [spaces ++ "}"]+showAccTrees :: (Double -> String) -> a -> [(String, AccessorTree a)] -> String -> [String]+showAccTrees show' x trees spaces = concat cs ++ [spaces ++ "}"]   where-    cs = zipWith (showRecordField show' spaces) trees ("{ " : repeat ", ")+    cs = zipWith (showRecordField show' x spaces) trees ("{ " : repeat ", ") -showRecordField :: (Getter a -> String) -> String -> (String, AccessorTree a) -> String -> [String]-showRecordField show' spaces (getterName, ATGetter (get, _)) prefix =-  [spaces ++ prefix ++ getterName ++ " = " ++ show' get]-showRecordField show' spaces (getterName, Data (_,cons) trees) prefix =-  (spaces ++ prefixNameEq ++ cons) : showAccTrees show' trees newSpaces+showVal :: Getter a -> (Double -> String) -> a -> String+showVal (GetBool get) _ x = show (get x)+showVal (GetInt get) _ x = show (get x)+showVal (GetDouble get) show' x = show' (get x)+showVal (GetFloat get) show' x = show' (realToFrac (get x))+showVal GetSorry _ _ = ""++showRecordField :: (Double -> String) -> a -> String -> (String, AccessorTree a) -> String -> [String]+showRecordField show' x spaces (getterName, ATGetter (get, _)) prefix =+  [spaces ++ prefix ++ getterName ++ " = " ++ showVal get show' x]+showRecordField show' x spaces (getterName, Data (_,cons) trees) prefix =+  (spaces ++ prefixNameEq ++ cons) : showAccTrees show' x trees newSpaces   where     prefixNameEq = prefix ++ getterName ++ " = "     newSpaces = spaces ++ (replicate (length prefixNameEq) ' ')  -- | Show a tree of values-showTree :: AccessorTree a -> (Getter a -> String) -> String-showTree (Data (_,cons) trees) show' = init $ unlines $ cons : showAccTrees show' trees ""-showTree (ATGetter (get,_)) show' = show' get+showTree :: AccessorTree a -> (Double -> String) -> a -> String+showTree (Data (_,cons) trees) show' x = init $ unlines $ cons : showAccTrees show' x trees ""+showTree (ATGetter (get,_)) show' x = showVal get show' x  -- | Show a list of values -- . -- True --> align the colums, False --> total mayhem-showFlat :: forall a . AccessorTree a -> Bool -> (Getter a -> String) -> String-showFlat at align show' = init $ unlines $ map f fl+showFlat :: forall a . AccessorTree a -> Bool -> (Double -> String) -> a -> String+showFlat at align show' x = init $ unlines $ map f fl   where     fst3 (z,_,_) = z     n = maximum (map (length . fst3) fl) -    f (name, get, _) = name ++ spaces ++ " = " ++ show' get+    f (name, get, _) = name ++ spaces ++ " = " ++ showVal get show' x       where         spaces           | align = replicate (n - length name) ' '

@@ -39,6 +39,8 @@ data One = MkOne { one :: Double } deriving (Generic) data Foo = MkFoo { aaa :: Int                  , bbb :: Xyz Int+                 , lol :: Bool+                 , notlol :: Bool                  , yoyo :: Xyz (Xyz Double)                  , ccc :: One                  } deriving (Generic)@@ -50,7 +52,7 @@ yo = Xyz 42 45 2000 (Xyz 2 3 4 5)  foo :: Foo-foo = MkFoo 2 (Xyz 6 7 8 9) yo (MkOne 17)+foo = MkFoo 2 (Xyz 6 7 8 9) True False yo (MkOne 17)  yup :: AccessorTree Foo yup = accessors foo@@ -78,19 +80,21 @@   where     x = init $ unlines         [ "MkFoo"-        , "{ aaa = 2.00e0"+        , "{ aaa = 2"         , ", bbb = Xyz"-        , "        { xx = 6.00e0"+        , "        { xx = 6"         , "        , yy = 7.00e0"         , "        , zz = 8.00e0"-        , "        , ww = 9.00e0"+        , "        , ww = 9"         , "        }"+        , ", lol = True"+        , ", notlol = False"         , ", yoyo = Xyz"-        , "         { xx = 4.20e1"+        , "         { xx = 42"         , "         , yy = 4.50e1"         , "         , zz = 2.00e3"         , "         , ww = Xyz"-        , "                { xx = 2.00e0"+        , "                { xx = 2"         , "                , yy = 3.00e0"         , "                , zz = 4.00e0"         , "                , ww = 5.00e0"@@ -107,15 +111,17 @@ flatTest = assertEqualString x y   where     x = init $ unlines-        [ "aaa = 2.00e0"-        , "bbb.xx = 6.00e0"+        [ "aaa = 2"+        , "bbb.xx = 6"         , "bbb.yy = 7.00e0"         , "bbb.zz = 8.00e0"-        , "bbb.ww = 9.00e0"-        , "yoyo.xx = 4.20e1"+        , "bbb.ww = 9"+        , "lol = True"+        , "notlol = False"+        , "yoyo.xx = 42"         , "yoyo.yy = 4.50e1"         , "yoyo.zz = 2.00e3"-        , "yoyo.ww.xx = 2.00e0"+        , "yoyo.ww.xx = 2"         , "yoyo.ww.yy = 3.00e0"         , "yoyo.ww.zz = 4.00e0"         , "yoyo.ww.ww = 5.00e0"@@ -127,15 +133,17 @@ flatTestAligned = assertEqualString x y   where     x = init $ unlines-        [ "aaa        = 2.00e0"-        , "bbb.xx     = 6.00e0"+        [ "aaa        = 2"+        , "bbb.xx     = 6"         , "bbb.yy     = 7.00e0"         , "bbb.zz     = 8.00e0"-        , "bbb.ww     = 9.00e0"-        , "yoyo.xx    = 4.20e1"+        , "bbb.ww     = 9"+        , "lol        = True"+        , "notlol     = False"+        , "yoyo.xx    = 42"         , "yoyo.yy    = 4.50e1"         , "yoyo.zz    = 2.00e3"-        , "yoyo.ww.xx = 2.00e0"+        , "yoyo.ww.xx = 2"         , "yoyo.ww.yy = 3.00e0"         , "yoyo.ww.zz = 4.00e0"         , "yoyo.ww.ww = 5.00e0"