Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

More complete set of Text/BS/String instances

  • Loading branch information...
commit 37e6c1c70ef4fb0f3a98219c031f8f0c068cb288 1 parent 7df552d
Michael Snoyman authored
132  Data/Convertible/Instances/Text.hs
... ...
@@ -0,0 +1,132 @@
  1
+{-# LANGUAGE MultiParamTypeClasses #-}
  2
+{-# LANGUAGE FlexibleInstances #-}
  3
+{-# LANGUAGE FlexibleContexts #-}
  4
+{-# OPTIONS_GHC -fno-warn-orphans #-}
  5
+---------------------------------------------------------
  6
+--
  7
+-- Module        : Data.Convertible.Instances.Text
  8
+-- Copyright     : Michael Snoyman
  9
+-- License       : BSD3
  10
+--
  11
+-- Maintainer    : Michael Snoyman <michael@snoyman.com>
  12
+-- Stability     : Stable
  13
+-- Portability   : portable
  14
+--
  15
+---------------------------------------------------------
  16
+
  17
+module Data.Convertible.Instances.Text () where
  18
+
  19
+import Data.Convertible
  20
+import qualified Data.ByteString as BS
  21
+import qualified Data.ByteString.Lazy as BL
  22
+import qualified Data.Text as ST
  23
+import qualified Data.Text.Lazy as LT
  24
+import qualified Data.Text.Encoding as STE
  25
+import qualified Data.Text.Lazy.Encoding as LTE
  26
+
  27
+toST :: ConvertSuccess a ST.Text => a -> ST.Text
  28
+toST = convertSuccess
  29
+
  30
+toLT :: ConvertSuccess a LT.Text => a -> LT.Text
  31
+toLT = convertSuccess
  32
+
  33
+instance ConvertSuccess [Char] [Char] where
  34
+    convertSuccess = id
  35
+instance ConvertSuccess [Char] BS.ByteString where
  36
+    convertSuccess = convertSuccess . toST
  37
+instance ConvertSuccess [Char] BL.ByteString where
  38
+    convertSuccess = convertSuccess . toLT
  39
+instance ConvertSuccess [Char] ST.Text where
  40
+    convertSuccess = ST.pack
  41
+instance ConvertSuccess [Char] LT.Text where
  42
+    convertSuccess = LT.pack
  43
+instance ConvertSuccess BS.ByteString [Char] where
  44
+    convertSuccess = convertSuccess . toST
  45
+instance ConvertSuccess BS.ByteString BS.ByteString where
  46
+    convertSuccess = id
  47
+instance ConvertSuccess BS.ByteString BL.ByteString where
  48
+    convertSuccess = BL.fromChunks . return
  49
+instance ConvertSuccess BS.ByteString ST.Text where
  50
+    convertSuccess = STE.decodeUtf8
  51
+instance ConvertSuccess BS.ByteString LT.Text where
  52
+    convertSuccess = convertSuccess . toST
  53
+instance ConvertSuccess BL.ByteString [Char] where
  54
+    convertSuccess = convertSuccess . toLT
  55
+instance ConvertSuccess BL.ByteString BS.ByteString where
  56
+    convertSuccess = BS.concat . BL.toChunks
  57
+instance ConvertSuccess BL.ByteString BL.ByteString where
  58
+    convertSuccess = id
  59
+instance ConvertSuccess BL.ByteString ST.Text where
  60
+    convertSuccess = convertSuccess . BS.concat . BL.toChunks
  61
+instance ConvertSuccess BL.ByteString LT.Text where
  62
+    convertSuccess = LTE.decodeUtf8
  63
+instance ConvertSuccess ST.Text [Char] where
  64
+    convertSuccess = ST.unpack
  65
+instance ConvertSuccess ST.Text BS.ByteString where
  66
+    convertSuccess = STE.encodeUtf8
  67
+instance ConvertSuccess ST.Text BL.ByteString where
  68
+    convertSuccess = convertSuccess . STE.encodeUtf8
  69
+instance ConvertSuccess ST.Text ST.Text where
  70
+    convertSuccess = id
  71
+instance ConvertSuccess ST.Text LT.Text where
  72
+    convertSuccess = LT.fromChunks . return
  73
+instance ConvertSuccess LT.Text [Char] where
  74
+    convertSuccess = LT.unpack
  75
+instance ConvertSuccess LT.Text BS.ByteString where
  76
+    convertSuccess = convertSuccess . toST
  77
+instance ConvertSuccess LT.Text BL.ByteString where
  78
+    convertSuccess = LTE.encodeUtf8
  79
+instance ConvertSuccess LT.Text ST.Text where
  80
+    convertSuccess = ST.concat . LT.toChunks
  81
+instance ConvertSuccess LT.Text LT.Text where
  82
+    convertSuccess = id
  83
+instance ConvertAttempt [Char] [Char] where
  84
+    convertAttempt = return . convertSuccess
  85
+instance ConvertAttempt [Char] BS.ByteString where
  86
+    convertAttempt = return . convertSuccess
  87
+instance ConvertAttempt [Char] BL.ByteString where
  88
+    convertAttempt = return . convertSuccess
  89
+instance ConvertAttempt [Char] ST.Text where
  90
+    convertAttempt = return . convertSuccess
  91
+instance ConvertAttempt [Char] LT.Text where
  92
+    convertAttempt = return . convertSuccess
  93
+instance ConvertAttempt BS.ByteString [Char] where
  94
+    convertAttempt = return . convertSuccess
  95
+instance ConvertAttempt BS.ByteString BS.ByteString where
  96
+    convertAttempt = return . convertSuccess
  97
+instance ConvertAttempt BS.ByteString BL.ByteString where
  98
+    convertAttempt = return . convertSuccess
  99
+instance ConvertAttempt BS.ByteString ST.Text where
  100
+    convertAttempt = return . convertSuccess
  101
+instance ConvertAttempt BS.ByteString LT.Text where
  102
+    convertAttempt = return . convertSuccess
  103
+instance ConvertAttempt BL.ByteString [Char] where
  104
+    convertAttempt = return . convertSuccess
  105
+instance ConvertAttempt BL.ByteString BS.ByteString where
  106
+    convertAttempt = return . convertSuccess
  107
+instance ConvertAttempt BL.ByteString BL.ByteString where
  108
+    convertAttempt = return . convertSuccess
  109
+instance ConvertAttempt BL.ByteString ST.Text where
  110
+    convertAttempt = return . convertSuccess
  111
+instance ConvertAttempt BL.ByteString LT.Text where
  112
+    convertAttempt = return . convertSuccess
  113
+instance ConvertAttempt ST.Text [Char] where
  114
+    convertAttempt = return . convertSuccess
  115
+instance ConvertAttempt ST.Text BS.ByteString where
  116
+    convertAttempt = return . convertSuccess
  117
+instance ConvertAttempt ST.Text BL.ByteString where
  118
+    convertAttempt = return . convertSuccess
  119
+instance ConvertAttempt ST.Text ST.Text where
  120
+    convertAttempt = return . convertSuccess
  121
+instance ConvertAttempt ST.Text LT.Text where
  122
+    convertAttempt = return . convertSuccess
  123
+instance ConvertAttempt LT.Text [Char] where
  124
+    convertAttempt = return . convertSuccess
  125
+instance ConvertAttempt LT.Text BS.ByteString where
  126
+    convertAttempt = return . convertSuccess
  127
+instance ConvertAttempt LT.Text BL.ByteString where
  128
+    convertAttempt = return . convertSuccess
  129
+instance ConvertAttempt LT.Text ST.Text where
  130
+    convertAttempt = return . convertSuccess
  131
+instance ConvertAttempt LT.Text LT.Text where
  132
+    convertAttempt = return . convertSuccess
13  Data/Convertible/Instances/TextSkel.hs
... ...
@@ -0,0 +1,13 @@
  1
+types = ["[Char]", "BS.ByteString", "BL.ByteString", "TS.Text", "TL.Text"]
  2
+
  3
+pairs = do
  4
+    from <- types
  5
+    to <- types
  6
+    return (from, to)
  7
+
  8
+main = do
  9
+    mapM_ cs pairs
  10
+    mapM_ ca pairs
  11
+
  12
+cs (f, t) = putStrLn $ "instance ConvertSuccess " ++ f ++ " " ++ t ++ " where\n    convertSuccess = "
  13
+ca (f, t) = putStrLn $ "instance ConvertAttempt " ++ f ++ " " ++ t ++ " where\n    convertAttempt = return . convertSuccess"
15  Data/Object.hs
@@ -52,6 +52,8 @@ module Data.Object
52 52
       -- $scalarToFromObject
53 53
     , scalarToObject
54 54
     , scalarFromObject
  55
+      -- Instances
  56
+    , module Data.Convertible.Instances.Text
55 57
     ) where
56 58
 
57 59
 import Control.Arrow
@@ -70,6 +72,7 @@ import qualified Control.Exception as E
70 72
 import Data.Attempt
71 73
 
72 74
 import Data.Convertible
  75
+import Data.Convertible.Instances.Text
73 76
 
74 77
 -- | Can represent nested values as scalars, sequences and mappings.  A
75 78
 -- sequence is synonymous with a list, while a mapping is synonymous with a
@@ -228,7 +231,8 @@ class ToObject a k v where
228 231
     listToObject :: [a] -> Object k v
229 232
     listToObject = Sequence . map toObject
230 233
 
231  
-    -- FIXME is this actually necesary?
  234
+    -- | This isn't useful for any of the instances we define here, but
  235
+    -- other users may find uses for it.
232 236
     mapToObject :: ConvertSuccess k' k => [(k', a)] -> Object k v
233 237
     mapToObject = Mapping . map (convertSuccess *** toObject)
234 238
 
@@ -297,11 +301,18 @@ class FromObject a k v where
297 301
         mapM (runKleisli (Kleisli convertAttempt *** Kleisli fromObject))
298 302
          <=< fromMapping
299 303
 
  304
+-- Object identity conversions
  305
+instance ToObject (Object k v) k v where
  306
+    toObject = id
  307
+instance FromObject (Object k v) k v where
  308
+    fromObject = return
  309
+
300 310
 -- The following code seems too generic and will probably lead to overlapping
301 311
 -- instances. It has thus been commented out.
302 312
 {-
303 313
 -- Converting between different types of Objects
304  
-instance (ConvertSuccess k k', ConvertSuccess v v') => ToObject (Object k v) k' v' where
  314
+instance (ConvertSuccess k k', ConvertSuccess v v')
  315
+  => ToObject (Object k v) k' v' where
305 316
     toObject = mapKeysValues convertSuccess convertSuccess
306 317
 
307 318
 instance (ConvertAttempt k' k, ConvertAttempt v' v)
66  Data/Object/Text.hs
@@ -2,7 +2,6 @@
2 2
 {-# LANGUAGE FlexibleInstances #-}
3 3
 {-# LANGUAGE FlexibleContexts #-}
4 4
 {-# LANGUAGE DeriveDataTypeable #-}
5  
-{-# OPTIONS_GHC -fno-warn-orphans #-}
6 5
 ---------------------------------------------------------
7 6
 --
8 7
 -- Module        : Data.Object.Text
@@ -28,9 +27,7 @@ import qualified Data.Text.Lazy as LT
28 27
 import qualified Data.Text.Lazy.Encoding as LTE
29 28
 import qualified Data.ByteString.Lazy as BL
30 29
 import qualified Data.ByteString as BS
31  
-import Data.ByteString.Class
32 30
 import Data.Time.Calendar
33  
-import Safe (readMay)
34 31
 import Control.Monad ((<=<))
35 32
 import Data.Ratio (Ratio)
36 33
 import Data.Attempt
@@ -42,56 +39,16 @@ import qualified Safe.Failure as SF
42 39
 -- | 'Object's with keys and values of type 'LT.Text'.
43 40
 type TextObject = Object LT.Text LT.Text
44 41
 
45  
--- lazy bytestrings
46  
-instance ConvertSuccess BL.ByteString LT.Text where
47  
-    convertSuccess = LTE.decodeUtf8
48  
-instance ConvertAttempt BL.ByteString LT.Text where
49  
-    convertAttempt = return . convertSuccess
50  
-
51  
-instance ConvertSuccess LT.Text BL.ByteString where
52  
-    convertSuccess = LTE.encodeUtf8
53  
-instance ConvertAttempt LT.Text BL.ByteString where
54  
-    convertAttempt = return . convertSuccess
55  
-
56 42
 instance ToObject BL.ByteString a LT.Text where
57 43
     toObject = scalarToObject
58 44
 instance FromObject BL.ByteString a LT.Text where
59 45
     fromObject = scalarFromObject
60 46
 
61  
--- strict bytestrings
62  
-instance ConvertSuccess BS.ByteString LT.Text where
63  
-    convertSuccess = LTE.decodeUtf8 . toLazyByteString
64  
-instance ConvertSuccess LT.Text BS.ByteString where
65  
-    convertSuccess = fromLazyByteString . LTE.encodeUtf8
66  
-instance ConvertAttempt BS.ByteString LT.Text where
67  
-    convertAttempt = return . convertSuccess
68  
-instance ConvertAttempt LT.Text BS.ByteString where
69  
-    convertAttempt = return . convertSuccess
70 47
 instance ToObject BS.ByteString a LT.Text where
71 48
     toObject = scalarToObject
72 49
 instance FromObject BS.ByteString a LT.Text where
73 50
     fromObject = scalarFromObject
74 51
 
75  
--- Chars (and thereby strings)
76  
--- Extra complication since we're avoiding overlapping instances.
77  
-class ListToText a where
78  
-    listToText :: [a] -> LT.Text
79  
-instance ListToText a => ConvertAttempt [a] LT.Text where
80  
-    convertAttempt = return . convertSuccess
81  
-instance ListToText a => ConvertSuccess [a] LT.Text where
82  
-    convertSuccess = listToText
83  
-instance ListToText Char where
84  
-    listToText = LT.pack
85  
-
86  
-class ListFromText a where
87  
-    listFromText :: LT.Text -> [a]
88  
-instance ListFromText a => ConvertSuccess LT.Text [a] where
89  
-    convertSuccess = listFromText
90  
-instance ListFromText a => ConvertAttempt LT.Text [a] where
91  
-    convertAttempt = return . convertSuccess
92  
-instance ListFromText Char where
93  
-    listFromText = LT.unpack
94  
-
95 52
 data ExpectedSingleCharacter = ExpectedSingleCharacter String
96 53
     deriving (Show, Typeable)
97 54
 instance Exception ExpectedSingleCharacter
@@ -112,20 +69,19 @@ instance ConvertAttempt Day LT.Text where
112 69
     convertAttempt = return . convertSuccess
113 70
 instance ToObject Day k LT.Text where
114 71
     toObject = scalarToObject
  72
+
  73
+data InvalidDayException = InvalidDayException String
  74
+    deriving (Show, Typeable)
  75
+instance Exception InvalidDayException
115 76
 instance ConvertAttempt LT.Text Day where
116  
-    convertAttempt t = do -- FIXME
  77
+    convertAttempt t = do
117 78
         let s = LT.unpack t
118  
-        if length s /= 10
119  
-            then failureString ("Invalid day: " ++ s)
120  
-            else do
121  
-                let x = do
122  
-                    y' <- readMay $ take 4 s
123  
-                    m' <- readMay $ take 2 $ drop 5 s
124  
-                    d' <- readMay $ take 2 $ drop 8 s
125  
-                    return (y', m', d')
126  
-                case x of
127  
-                    Just (y, m, d) -> return $ fromGregorian y m d
128  
-                    Nothing -> failureString $ "Invalid day: " ++ s
  79
+        SF.assert (length s == 10) () $ InvalidDayException s
  80
+        wrapFailure (const $ InvalidDayException s) $ do
  81
+            y <- SF.read $ take 4 s
  82
+            m <- SF.read $ take 2 $ drop 5 s
  83
+            d <- SF.read $ take 2 $ drop 8 s
  84
+            return $ fromGregorian y m d
129 85
 instance FromObject Day k LT.Text where
130 86
     fromObject = scalarFromObject
131 87
 
3  data-object.cabal
@@ -17,12 +17,10 @@ homepage:        http://github.com/snoyberg/data-object/tree/master
17 17
 
18 18
 library
19 19
     build-depends:   base >= 4 && < 5,
20  
-                     bytestring-class,
21 20
                      bytestring >= 0.9.1.4 && < 1,
22 21
                      text >= 0.5,
23 22
                      time >= 1,
24 23
                      safe-failure,
25  
-                     safe,
26 24
                      old-locale >= 1,
27 25
                      syb,
28 26
                      attempt,
@@ -31,4 +29,5 @@ library
31 29
                      Data.Object.Text
32 30
                      Data.Object.Scalar
33 31
                      Data.Object.String
  32
+                     Data.Convertible.Instances.Text
34 33
     ghc-options:     -Wall

0 notes on commit 37e6c1c

Please sign in to comment.
Something went wrong with that request. Please try again.