{-# LANGUAGE OverloadedStrings #-}

{-|

The Read type class is very useful for building data types from String
representations.  But String has high overhead, so sometimes it isn't suitable
for applications where space usage and performance are important.  This
library provides a simpler version of Read's functionality for Text and
ByteStrings.

-}

module Data.Readable
  ( Readable(..)
  ) where

------------------------------------------------------------------------------
import           Control.Monad
import           Data.ByteString.Char8 (ByteString)
import           Data.Int
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding
import           Data.Text.Read
import           Data.Word


------------------------------------------------------------------------------
-- | ByteString and Text reading using MonadPlus to handle parse failure.  On
-- error, fromText and fromBS will return mzero.  You can use mplus to provide
-- fallback defaults.
class Readable a where
    -- | Reads data from a Text representation.
    fromText :: MonadPlus m => Text -> m a
    -- | Reads data from a UTF8 encoded ByteString.  The default
    -- implementation of this function simply decodes with UTF-8 and then
    -- calls the fromText function.  If decoding fails, mzero will be
    -- returned.  You can provide your own implementation if you need
    -- different behavior such as not decoding to UTF8.
    fromBS   :: MonadPlus m => ByteString -> m a
    fromBS = forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a b. MonadPlus m => Either a b -> m b
hushPlus forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8'


hushPlus :: MonadPlus m => Either a b -> m b
hushPlus :: forall (m :: * -> *) a b. MonadPlus m => Either a b -> m b
hushPlus (Left a
_) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
hushPlus (Right b
b) = forall (m :: * -> *) a. Monad m => a -> m a
return b
b


------------------------------------------------------------------------------
-- | Fails if the input wasn't parsed completely.
checkComplete :: MonadPlus m => (t, Text) -> m t
checkComplete :: forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete (t
a,Text
rest)
  | Text -> Bool
T.null Text
rest = forall (m :: * -> *) a. Monad m => a -> m a
return t
a
  | Bool
otherwise   = forall (m :: * -> *) a. MonadPlus m => m a
mzero


-- Leaving out these instances breaks users who depend on having a unified
-- constraint for parsing, so we need to keep them around.
instance Readable ByteString where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m ByteString
fromText = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
    fromBS :: forall (m :: * -> *). MonadPlus m => ByteString -> m ByteString
fromBS = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Readable Text where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Text
fromText = forall (m :: * -> *) a. Monad m => a -> m a
return

instance Readable Int where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Int
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal
instance Readable Integer where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Integer
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal
instance Readable Float where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Float
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Reader a
rational
instance Readable Double where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Double
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader Double
double
instance Readable Bool where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Bool
fromText Text
t = case Text -> Text
T.toLower Text
t of
                   Text
"1" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   Text
"0" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Text
"t" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   Text
"f" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Text
"true" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   Text
"false" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Text
"y" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   Text
"n" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Text
"yes" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                   Text
"no" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Text
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance Readable Int8 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Int8
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal
instance Readable Int16 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Int16
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal
instance Readable Int32 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Int32
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal
instance Readable Int64 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Int64
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal

instance Readable Word8 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Word8
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal
instance Readable Word16 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Word16
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal
instance Readable Word32 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Word32
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal
instance Readable Word64 where
    fromText :: forall (m :: * -> *). MonadPlus m => Text -> m Word64
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) forall (m :: * -> *) t. MonadPlus m => (t, Text) -> m t
checkComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal