16c798b5ef
MetaField was already limited to alphanumerics, so it makes sense to use Text for it. Note that technically a UUID can contain invalid UTF-8, and so remoteMetaDataPrefix's use of T.pack . fromUUID could replace non-UTF8 values with '?' or whatever. In practice, a UUID is usually also text, I only kept open the possibility of it containing invalid UTF-8 to avoid breaking parsing of strange UUIDs in git-annex branch files. So, I decided to let this edge case slip by. Have not updated the rest of the code base yet for this change, as the change took 2.5 hours longer than I expected to get working properly.
104 lines
3 KiB
Haskell
104 lines
3 KiB
Haskell
{- GHC File system encoding support for Aeson.
|
|
-
|
|
- Import instead of Data.Aeson
|
|
-
|
|
- Copyright 2018-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
|
|
|
module Utility.Aeson (
|
|
module X,
|
|
ToJSON'(..),
|
|
encode,
|
|
packString,
|
|
packByteString,
|
|
) where
|
|
|
|
import Data.Aeson as X hiding (ToJSON, toJSON, encode)
|
|
import Data.Aeson hiding (encode)
|
|
import qualified Data.Aeson
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.ByteString.Lazy as L
|
|
import qualified Data.ByteString as S
|
|
import qualified Data.Set
|
|
import qualified Data.Vector
|
|
import Prelude
|
|
|
|
import Utility.FileSystemEncoding
|
|
|
|
-- | Use this instead of Data.Aeson.encode to make sure that the
|
|
-- below String instance is used.
|
|
encode :: ToJSON' a => a -> L.ByteString
|
|
encode = Data.Aeson.encode . toJSON'
|
|
|
|
-- | Aeson has an unfortunate ToJSON instance for Char and [Char]
|
|
-- which does not support Strings containing UTF8 characters
|
|
-- encoded using the filesystem encoding when run in a non-utf8 locale.
|
|
--
|
|
-- Since we can't replace that with a instance that does the right
|
|
-- thing, instead here's a new class that handles String right.
|
|
class ToJSON' a where
|
|
toJSON' :: a -> Value
|
|
|
|
instance ToJSON' T.Text where
|
|
toJSON' = toJSON
|
|
|
|
instance ToJSON' String where
|
|
toJSON' = toJSON . packString
|
|
|
|
-- | Aeson does not have a ToJSON instance for ByteString;
|
|
-- this one assumes that the ByteString contains text, and will
|
|
-- have the same effect as toJSON' . decodeBS, but with a more efficient
|
|
-- implementation.
|
|
instance ToJSON' S.ByteString where
|
|
toJSON' = toJSON . packByteString
|
|
|
|
-- | Pack a String to Text, correctly handling the filesystem encoding.
|
|
--
|
|
-- Use this instead of Data.Text.pack.
|
|
--
|
|
-- Note that if the string contains invalid UTF8 characters not using
|
|
-- the FileSystemEncoding, this is the same as Data.Text.pack.
|
|
packString :: String -> T.Text
|
|
packString s = case T.decodeUtf8' (encodeBS s) of
|
|
Right t -> t
|
|
Left _ -> T.pack s
|
|
|
|
-- | The same as packString . decodeBS, but more efficient in the usual
|
|
-- case.
|
|
packByteString :: S.ByteString -> T.Text
|
|
packByteString b = case T.decodeUtf8' b of
|
|
Right t -> t
|
|
Left _ -> T.pack (decodeBS b)
|
|
|
|
-- | An instance for lists cannot be included as it would overlap with
|
|
-- the String instance. Instead, you can use a Vector.
|
|
instance ToJSON' s => ToJSON' (Data.Vector.Vector s) where
|
|
toJSON' = toJSON . map toJSON' . Data.Vector.toList
|
|
|
|
-- Aeson generates the same JSON for a Set as for a list.
|
|
instance ToJSON' s => ToJSON' (Data.Set.Set s) where
|
|
toJSON' = toJSON . map toJSON' . Data.Set.toList
|
|
|
|
instance (ToJSON' a, ToJSON a) => ToJSON' (Maybe a) where
|
|
toJSON' (Just a) = toJSON (Just (toJSON' a))
|
|
toJSON' v@Nothing = toJSON v
|
|
|
|
instance (ToJSON' a, ToJSON a, ToJSON' b, ToJSON b) => ToJSON' (a, b) where
|
|
toJSON' (a, b) = toJSON ((toJSON' a, toJSON' b))
|
|
|
|
instance ToJSON' Bool where
|
|
toJSON' = toJSON
|
|
|
|
instance ToJSON' Integer where
|
|
toJSON' = toJSON
|
|
|
|
instance ToJSON' Object where
|
|
toJSON' = toJSON
|
|
|
|
instance ToJSON' Value where
|
|
toJSON' = toJSON
|