-- |
-- Stability   :  Ultra-Violence
-- Portability :  I'm too young to die
-- Instances for dealing with the usual data.

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverloadedStrings, ViewPatterns #-}

module Network.NineP.File.Instances
	( Convertible
	, ReadRef
	, WriteRef
	) where

import Control.Concurrent.Chan
import Control.Monad
import Control.Exception
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Convertible.Base
import Data.Convertible.Instances
import Data.StateRef
import Data.Typeable
import Network.NineP.File

-- How do I avoid writing that?
trim :: [Char] -> [Char]
trim [Char]
xs = [Char] -> [Char] -> [Char]
dropSpaceTail [Char]
"" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
xs

dropSpaceTail :: [Char] -> [Char] -> [Char]
dropSpaceTail [Char]
maybeStuff [Char]
"" = [Char]
""
dropSpaceTail [Char]
maybeStuff (Char
x:[Char]
xs)
        | Char -> Bool
isSpace Char
x = [Char] -> [Char] -> [Char]
dropSpaceTail (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
maybeStuff) [Char]
xs
        | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
maybeStuff = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
dropSpaceTail [Char]
"" [Char]
xs
        | Bool
otherwise       = [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
maybeStuff [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Char]
dropSpaceTail [Char]
"" [Char]
xs

-- | @'read'@ in @'Maybe'@.
safeRead :: (Read a) => String -> Maybe a
safeRead :: [Char] -> Maybe a
safeRead (ReadS a
forall a. Read a => ReadS a
reads -> [(a
v,[Char]
"")]) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
safeRead [Char]
_ = Maybe a
forall a. Maybe a
Nothing

instance Convertible ByteString ByteString where
	safeConvert :: ByteString -> ConvertResult ByteString
safeConvert = ByteString -> ConvertResult ByteString
forall a b. b -> Either a b
Right (ByteString -> ConvertResult ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> ConvertResult ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. a -> a
id

instance Convertible () ByteString where
	safeConvert :: () -> ConvertResult ByteString
safeConvert ()
x = [Char] -> () -> ConvertResult ByteString
forall a b.
(Show a, Typeable a, Typeable b) =>
[Char] -> a -> ConvertResult b
convError [Char]
"impossible to read that" ()
x
instance Convertible ByteString () where
	safeConvert :: ByteString -> ConvertResult ()
safeConvert ByteString
_ = () -> ConvertResult ()
forall a b. b -> Either a b
Right ()

instance Convertible ByteString Bool where
	safeConvert :: ByteString -> ConvertResult Bool
safeConvert ByteString
s
		| [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"1" = Bool -> ConvertResult Bool
forall a b. b -> Either a b
Right Bool
True
		| [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"true" = Bool -> ConvertResult Bool
forall a b. b -> Either a b
Right Bool
True
		| [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"0" = Bool -> ConvertResult Bool
forall a b. b -> Either a b
Right Bool
False
		| [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"false" = Bool -> ConvertResult Bool
forall a b. b -> Either a b
Right Bool
False
		| Bool
otherwise = [Char] -> [Char] -> ConvertResult Bool
forall a b.
(Show a, Typeable a, Typeable b) =>
[Char] -> a -> ConvertResult b
convError [Char]
"doesn't look like a boolean value" [Char]
l
			where l :: [Char]
l = [Char] -> [Char]
trim ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B.unpack ByteString
s
instance Convertible Bool ByteString where
	safeConvert :: Bool -> ConvertResult ByteString
safeConvert Bool
True = ByteString -> ConvertResult ByteString
forall a b. b -> Either a b
Right ByteString
"true"
	safeConvert Bool
False = ByteString -> ConvertResult ByteString
forall a b. b -> Either a b
Right ByteString
"false"

instance (Show a, Num a) => Convertible a ByteString where
	safeConvert :: a -> ConvertResult ByteString
safeConvert = ByteString -> ConvertResult ByteString
forall a b. b -> Either a b
Right (ByteString -> ConvertResult ByteString)
-> (a -> ByteString) -> a -> ConvertResult ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
B.pack ([Char] -> ByteString) -> (a -> [Char]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show 
instance (Read a, Num a, Typeable a) => Convertible ByteString a where
	safeConvert :: ByteString -> ConvertResult a
safeConvert ByteString
s = ConvertResult a
-> (ConvertResult a -> ConvertResult a)
-> Maybe (ConvertResult a)
-> ConvertResult a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> [Char] -> ConvertResult a
forall a b.
(Show a, Typeable a, Typeable b) =>
[Char] -> a -> ConvertResult b
convError [Char]
"doesn't look like an integral value" [Char]
l) ConvertResult a -> ConvertResult a
forall a. a -> a
id (Maybe (ConvertResult a) -> ConvertResult a)
-> Maybe (ConvertResult a) -> ConvertResult a
forall a b. (a -> b) -> a -> b
$ (a -> ConvertResult a) -> Maybe a -> Maybe (ConvertResult a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> ConvertResult a
forall a b. b -> Either a b
Right (Maybe a -> Maybe (ConvertResult a))
-> Maybe (Maybe a) -> Maybe (ConvertResult a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> Maybe (Maybe a)
forall a. Read a => [Char] -> Maybe a
safeRead [Char]
l
			where l :: [Char]
l = [Char] -> [Char]
trim ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B.unpack ByteString
s

-- TODO sane error
instance ReadRef () m ByteString where
    readReference :: () -> m ByteString
readReference = ArithException -> () -> m ByteString
forall a e. Exception e => e -> a
throw (ArithException -> () -> m ByteString)
-> ArithException -> () -> m ByteString
forall a b. (a -> b) -> a -> b
$ ArithException
Underflow
instance Monad m => WriteRef () m ByteString where
    writeReference :: () -> ByteString -> m ()
writeReference ()
_ = m () -> ByteString -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return (m () -> ByteString -> m ()) -> m () -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance MonadIO m => ReadRef (Chan a) m a where
    readReference :: Chan a -> m a
readReference = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Chan a -> IO a) -> Chan a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chan a -> IO a
forall a. Chan a -> IO a
readChan
instance MonadIO m => WriteRef (Chan a) m a where
    writeReference :: Chan a -> a -> m ()
writeReference Chan a
r = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chan a -> a -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan a
r