8668722 · typeable/aeson

git.iko.soy/typeable/aeson

Adding functions to TH to make CamelCase to under_score easier.

I have noticed in multiple places around hackage that people add these kinds of functions to get their JSON formatted keys (often underscore_formatted_strings) out of Haskell's CamelCase data properties (often withLongStringsOfCAPITALS). I have also added to the .gitignore those files generated by the new cabal 1.18 'sandbox' feature. I have a few outstanding questions: 1) Should these functions live in another module with an isomorphic inverse function, like `underscoreToCamel`? Like Aeson.Properties? 2) I am at something of a loss as to how to integrate testing into the suite. I've tested the out at the REPL, but what steps should be taken to integrate these into QuickCheck?

commit86687225bdda55069daa1945b8ff568ef5734c44 authorGabe McArthur <gabemc@crowdflower.com> dateSun 13 Oct 2013, 11:30 (13 years ago) parent9f9c04d

2 files changed+48−2

compare with master

unifiedsplit

.gitignore+2 Data/Aeson/TH.hs+46−2

.gitignore+2

@@ -1,4 +1,6 @@

11dist

2+.cabal-sandbox/

3+cabal.sandbox.config

35*.o

46*.hi

Data/Aeson/TH.hs+46−2

@@ -70,6 +70,11 @@ module Data.Aeson.TH

7070

7171 , mkToJSON

7272 , mkParseJSON

73+

74+ -- * For the oft-conversion of CamelCase to underscore_case in JSON

75+ , camelToUnderscore

76+ , camelToUnderscoreDrop

77+ , camelToUnderscoreDropChecked

7378 ) where

7479

7580--------------------------------------------------------------------------------

@@ -90,6 +95,7 @@ import Data.Aeson.Types ( Value(..), Parser

9095-- from base:

9196import Control.Applicative ( pure, (<$>), (<*>) )

9297import Control.Monad ( return, mapM, liftM2, fail )

98+import Data.Char ( isUpper, toLower)

9399import Data.Bool ( Bool(False, True), otherwise, (&&) )

94100import Data.Eq ( (==) )

95101import Data.Function ( ($), (.) )

@@ -97,10 +103,10 @@ import Data.Functor ( fmap )

97103import Data.Int ( Int )

98104import Data.Either ( Either(Left, Right) )

99105import Data.List ( (++), foldl, foldl', intercalate

100− , length, map, zip, genericLength, all, partition

106+ , length, map, zip, genericLength, all, partition, drop

101107 )

102108import Data.Maybe ( Maybe(Nothing, Just), catMaybes )

103−import Prelude ( String, (-), Integer, fromIntegral, error )

109+import Prelude ( String, (-), Integer, fromIntegral, error, const )

104110import Text.Printf ( printf )

105111import Text.Show ( show )

106112#if __GLASGOW_HASKELL__ < 700

@@ -872,3 +878,41 @@ valueConName (String _) = "String"

872878valueConName (Number _) = "Number"

873879valueConName (Bool _) = "Boolean"

874880valueConName Null = "Null"

881+

882+-- | Removes the first Int characters of string, then converts from

883+-- CamelCase to underscore_case.

884+--

885+-- For use by Aeson template haskell calls.

886+camelToUnderscore :: String -> String

887+camelToUnderscore = camelToUnderscoreDrop 0

888+

889+-- | Removes the first Int characters of string, then converts from

890+-- CamelCase to underscore_case. Drops the first few characters from

891+-- the input.

892+--

893+-- For use by Aeson template haskell calls.

894+camelToUnderscoreDrop :: Int -> String -> String

895+camelToUnderscoreDrop i = camelToUnderscoreDropChecked (const i)

896+

897+-- | Removes the first Int characters of string, then converts from

898+-- CamelCase to underscore_case. Investigates the input string to

899+-- see how many characters to drop.

900+--

901+-- For use by Aeson template haskell calls.

902+camelToUnderscoreDropChecked :: (String -> Int) -> String -> String

903+camelToUnderscoreDropChecked chk property =

904+ underscore True input

905+ where

906+ input :: String

907+ input = drop (chk property) property

908+

909+ underscore :: Bool -- ^ Previous was a capital letter

910+ -> String -- ^ The remaining string

911+ -> String

912+ underscore _ [] = []

913+ underscore prev (x : xs) = if isUpper x

914+ then if prev

915+ then toLower x : underscore True xs

916+ else '_' : toLower x : underscore True xs

917+ else x : underscore False xs

918+