Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Split convertible instances into their own modules.

In particular, we now have conversions for all five string types.

Also, the convertible instances in Data.Object.Text have been separated
out and provide instances for all five string types as well.
  • Loading branch information...
commit d066561f3a9967bd21393e3952f2ea502ee4381f 1 parent 37e6c1c
@snoyberg authored
View
220 Data/Convertible/Instances/String.hs
@@ -0,0 +1,220 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+---------------------------------------------------------
+--
+-- Module : Data.Convertible.Instances.String
+-- Copyright : Michael Snoyman
+-- License : BSD3
+--
+-- Maintainer : Michael Snoyman <michael@snoyman.com>
+-- Stability : Stable
+-- Portability : portable
+--
+---------------------------------------------------------
+
+-- | Instances of 'ConvertSuccess' and 'ConvertAttempt' for 'String', along
+-- with instances for bytestrings and text (lazy and strict).
+module Data.Convertible.Instances.String
+ ( InvalidDayException (..)
+ , InvalidBoolException (..)
+ ) where
+
+import Data.Convertible
+import Data.Typeable (Typeable)
+import Control.Exception (Exception)
+import qualified Safe.Failure as SF
+import Data.Convertible.Instances.Text ()
+import Data.Attempt
+import Control.Monad ((<=<))
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as ST
+import qualified Data.Text.Lazy as LT
+
+import Data.Time.Calendar
+import Data.Ratio (Ratio)
+
+{- Not needed yet
+fromString :: ConvertSuccess String a => String -> a
+fromString = convertSuccess
+-}
+
+fromStringA :: ConvertAttempt String a => String -> Attempt a
+fromStringA = convertAttempt
+
+toString :: ConvertSuccess a String => a -> String
+toString = convertSuccess
+
+-- Day
+data InvalidDayException = InvalidDayException String
+ deriving (Show, Typeable)
+instance Exception InvalidDayException
+
+instance ConvertSuccess Day [Char] where
+ convertSuccess = show
+instance ConvertAttempt Day [Char] where
+ convertAttempt = return . convertSuccess
+instance ConvertAttempt [Char] Day where
+ convertAttempt s = wrapFailure (const $ InvalidDayException s) $ do
+ SF.assert (length s == 10) () $ InvalidDayException s
+ y <- SF.read $ take 4 s
+ m <- SF.read $ take 2 $ drop 5 s
+ d <- SF.read $ take 2 $ drop 8 s
+ return $ fromGregorian y m d
+
+-- Bool
+data InvalidBoolException = InvalidBoolException String
+ deriving (Show, Typeable)
+instance Exception InvalidBoolException
+
+instance ConvertAttempt Bool [Char] where
+ convertAttempt = return . convertSuccess
+instance ConvertSuccess Bool [Char] where
+ convertSuccess b = if b then "true" else "false"
+instance ConvertAttempt [Char] Bool where
+ convertAttempt s =
+ case s of
+ -- list comes from http://yaml.org/type/bool.html
+ "y" -> return True
+ "Y" -> return True
+ "yes" -> return True
+ "Yes" -> return True
+ "YES" -> return True
+ "true" -> return True
+ "True" -> return True
+ "TRUE" -> return True
+ "on" -> return True
+ "On" -> return True
+ "ON" -> return True
+
+ "n" -> return False
+ "N" -> return False
+ "no" -> return False
+ "No" -> return False
+ "NO" -> return False
+ "false" -> return False
+ "False" -> return False
+ "FALSE" -> return False
+ "off" -> return False
+ "Off" -> return False
+ "OFF" -> return False
+
+ _ -> failure $ InvalidBoolException s
+
+-- Int
+instance ConvertSuccess Int [Char] where
+ convertSuccess = show
+instance ConvertAttempt Int [Char] where
+ convertAttempt = return . convertSuccess
+instance ConvertAttempt [Char] Int where
+ convertAttempt = SF.read
+
+-- Rational
+instance ConvertSuccess (Ratio Integer) [Char] where
+ convertSuccess = show
+instance ConvertAttempt (Ratio Integer) [Char] where
+ convertAttempt = return . convertSuccess
+instance ConvertAttempt [Char] (Ratio Integer) where
+ convertAttempt = SF.read
+
+-- Instances for bytestrings and text
+instance ConvertAttempt BS.ByteString Day where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BL.ByteString Day where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt ST.Text Day where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt LT.Text Day where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BS.ByteString Bool where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BL.ByteString Bool where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt ST.Text Bool where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt LT.Text Bool where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BS.ByteString Int where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BL.ByteString Int where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt ST.Text Int where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt LT.Text Int where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BS.ByteString (Ratio Integer) where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt BL.ByteString (Ratio Integer) where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt ST.Text (Ratio Integer) where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt LT.Text (Ratio Integer) where
+ convertAttempt = fromStringA <=< convertAttempt
+instance ConvertAttempt Day BS.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Day BL.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Day ST.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Day LT.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Bool BS.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Bool BL.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Bool ST.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Bool LT.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Int BS.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Int BL.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Int ST.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt Int LT.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt (Ratio Integer) BS.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt (Ratio Integer) BL.ByteString where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt (Ratio Integer) ST.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertAttempt (Ratio Integer) LT.Text where
+ convertAttempt = convertAttempt . toString
+instance ConvertSuccess Day BS.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Day BL.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Day ST.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Day LT.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Bool BS.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Bool BL.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Bool ST.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Bool LT.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Int BS.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Int BL.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Int ST.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess Int LT.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess (Ratio Integer) BS.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess (Ratio Integer) BL.ByteString where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess (Ratio Integer) ST.Text where
+ convertSuccess = convertSuccess . toString
+instance ConvertSuccess (Ratio Integer) LT.Text where
+ convertSuccess = convertSuccess . toString
View
24 Data/Convertible/Instances/StringHelper.hs
@@ -0,0 +1,24 @@
+types = ["BS.ByteString", "BL.ByteString", "ST.Text", "LT.Text"]
+fromStringAttempts = ["Day", "Bool", "Int", "(Ratio Integer)"]
+fromStringSuccesses = []
+toStringAttempts = []
+toStringSuccesses = ["Day", "Bool", "Int", "(Ratio Integer)"]
+
+main = do
+ mapM_ fsa $ fromStringAttempts ++ fromStringSuccesses
+ mapM_ fss fromStringSuccesses
+ mapM_ tsa $ toStringAttempts ++ toStringSuccesses
+ mapM_ tss toStringSuccesses
+
+fsa t = forM_ types (\f -> putStrLn $
+ "instance ConvertAttempt " ++ f ++ " " ++ t ++ " where\n" ++
+ " convertAttempt = fromStringA <=< convertAttempt")
+fss t = forM_ types (\f -> putStrLn $
+ "instance ConvertSuccess " ++ f ++ " " ++ t ++ " where\n" ++
+ " convertSuccess = fromString . convertSuccess")
+tsa f = forM_ types (\t -> putStrLn $
+ "instance ConvertAttempt " ++ f ++ " " ++ t ++ " where\n" ++
+ " convertAttempt = convertAttempt . toString")
+tss f = forM_ types (\t -> putStrLn $
+ "instance ConvertSuccess " ++ f ++ " " ++ t ++ " where\n" ++
+ " convertSuccess = convertSuccess . toString")
View
2  Data/Convertible/Instances/Text.hs
@@ -14,6 +14,8 @@
--
---------------------------------------------------------
+-- | Instances to convert amongst 'String's, strict bytestrings, lazy
+-- bytestrings, strict text and lazy text.
module Data.Convertible.Instances.Text () where
import Data.Convertible
View
9 Data/Object/String.hs
@@ -27,8 +27,7 @@ module Data.Object.String
import Data.Object
import Data.Attempt
-import Data.Object.Text (fromTextObject)
-import qualified Data.Text.Lazy as LT
+import Data.Convertible.Instances.String ()
type StringObject = Object String String
@@ -41,9 +40,3 @@ fromStringObject :: FromObject a String String
=> StringObject
-> Attempt a
fromStringObject = fromObject
-
-instance ToObject a LT.Text LT.Text => ToObject a String String where
- toObject = mapKeysValues LT.unpack LT.unpack . toObject
-
-instance FromObject a LT.Text LT.Text => FromObject a String String where
- fromObject = fromTextObject . mapKeysValues LT.pack LT.pack
View
134 Data/Object/Text.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
---------------------------------------------------------
--
-- Module : Data.Object.Text
@@ -13,9 +14,7 @@
-- Portability : portable
---------------------------------------------------------
--- FIXME should the convertible instances be moved to convertible?
-
--- | Keys and values are lazy 'LT.Text's.
+-- | Keys and values are lazy 'Text's.
module Data.Object.Text
( TextObject
, toTextObject
@@ -23,135 +22,18 @@ module Data.Object.Text
) where
import Data.Object
-import qualified Data.Text.Lazy as LT
-import qualified Data.Text.Lazy.Encoding as LTE
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString as BS
-import Data.Time.Calendar
-import Control.Monad ((<=<))
-import Data.Ratio (Ratio)
+import Data.Text.Lazy (Text)
import Data.Attempt
-import Data.Generics
-import Control.Exception (Exception)
-import Data.Convertible
-import qualified Safe.Failure as SF
-
--- | 'Object's with keys and values of type 'LT.Text'.
-type TextObject = Object LT.Text LT.Text
-
-instance ToObject BL.ByteString a LT.Text where
- toObject = scalarToObject
-instance FromObject BL.ByteString a LT.Text where
- fromObject = scalarFromObject
-
-instance ToObject BS.ByteString a LT.Text where
- toObject = scalarToObject
-instance FromObject BS.ByteString a LT.Text where
- fromObject = scalarFromObject
-
-data ExpectedSingleCharacter = ExpectedSingleCharacter String
- deriving (Show, Typeable)
-instance Exception ExpectedSingleCharacter
-
-instance ToObject Char LT.Text LT.Text where
- toObject c = Scalar $ LT.pack [c]
- listToObject = Scalar . LT.pack
-instance FromObject Char LT.Text LT.Text where
- fromObject = helper . LT.unpack <=< fromScalar where
- helper [x] = return x
- helper x = failure $ ExpectedSingleCharacter x
- listFromObject = fmap LT.unpack . fromScalar
--- Day
-instance ConvertSuccess Day LT.Text where
- convertSuccess = LT.pack . show
-instance ConvertAttempt Day LT.Text where
- convertAttempt = return . convertSuccess
-instance ToObject Day k LT.Text where
- toObject = scalarToObject
+import Data.Convertible.Instances.String ()
-data InvalidDayException = InvalidDayException String
- deriving (Show, Typeable)
-instance Exception InvalidDayException
-instance ConvertAttempt LT.Text Day where
- convertAttempt t = do
- let s = LT.unpack t
- SF.assert (length s == 10) () $ InvalidDayException s
- wrapFailure (const $ InvalidDayException s) $ do
- y <- SF.read $ take 4 s
- m <- SF.read $ take 2 $ drop 5 s
- d <- SF.read $ take 2 $ drop 8 s
- return $ fromGregorian y m d
-instance FromObject Day k LT.Text where
- fromObject = scalarFromObject
-
--- Bool
-instance ConvertAttempt Bool LT.Text where
- convertAttempt = return . convertSuccess
-instance ConvertSuccess Bool LT.Text where
- convertSuccess b = LT.pack $ if b then "true" else "false"
-instance ToObject Bool k LT.Text where
- toObject = scalarToObject
-instance ConvertAttempt LT.Text Bool where
- convertAttempt t =
- case LT.unpack t of
- -- list comes from http://yaml.org/type/bool.html
- "y" -> return True
- "Y" -> return True
- "yes" -> return True
- "Yes" -> return True
- "YES" -> return True
- "true" -> return True
- "True" -> return True
- "TRUE" -> return True
- "on" -> return True
- "On" -> return True
- "ON" -> return True
-
- "n" -> return False
- "N" -> return False
- "no" -> return False
- "No" -> return False
- "NO" -> return False
- "false" -> return False
- "False" -> return False
- "FALSE" -> return False
- "off" -> return False
- "Off" -> return False
- "OFF" -> return False
-
- x -> failureString $ "Invalid bool value: " ++ x
-instance FromObject Bool k LT.Text where
- fromObject = scalarFromObject
-
--- Int
-instance ConvertSuccess Int LT.Text where
- convertSuccess = LT.pack . show
-instance ConvertAttempt Int LT.Text where
- convertAttempt = return . convertSuccess
-instance ToObject Int k LT.Text where
- toObject = scalarToObject
-instance ConvertAttempt LT.Text Int where
- convertAttempt = SF.read . LT.unpack
-instance FromObject Int k LT.Text where
- fromObject = scalarFromObject
-
--- Rational
-instance ConvertSuccess (Ratio Integer) LT.Text where
- convertSuccess = LT.pack . show
-instance ConvertAttempt (Ratio Integer) LT.Text where
- convertAttempt = return . convertSuccess
-instance ToObject (Ratio Integer) k LT.Text where
- toObject = scalarToObject
-instance ConvertAttempt LT.Text (Ratio Integer) where
- convertAttempt = SF.read . LT.unpack
-instance FromObject (Ratio Integer) k LT.Text where
- fromObject = scalarFromObject
+-- | 'Object's with keys and values of type 'LT.Text'.
+type TextObject = Object Text Text
-- | 'toObject' specialized for 'TextObject's
-toTextObject :: ToObject a LT.Text LT.Text => a -> TextObject
+toTextObject :: ToObject a Text Text => a -> TextObject
toTextObject = toObject
-- | 'fromObject' specialized for 'TextObject's
-fromTextObject :: FromObject a LT.Text LT.Text => TextObject -> Attempt a
+fromTextObject :: FromObject a Text Text => TextObject -> Attempt a
fromTextObject = fromObject
View
4 data-object.cabal
@@ -24,10 +24,12 @@ library
old-locale >= 1,
syb,
attempt,
- convertible >= 1.2.0
+ convertible >= 1.2.0,
+ control-monad-failure >= 0.4
exposed-modules: Data.Object
Data.Object.Text
Data.Object.Scalar
Data.Object.String
Data.Convertible.Instances.Text
+ Data.Convertible.Instances.String
ghc-options: -Wall
Please sign in to comment.
Something went wrong with that request. Please try again.