{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}

module Data.SGF.Parse.Encodings
    ( guessEncoding
    , decodeWordStringExplicit
    ) where

import Control.Applicative (Applicative(..))
import Control.Exception.Extensible
import Control.Monad (ap, liftM)
import Control.Monad.State
import Control.Throws
import Data.Encoding
import Data.Word

type MyIHateGHC = MyEither DecodingException (String, [Word8])

newtype MyEither a b =
    MyEither (Either a b)
    deriving (Throws a)

instance Functor (MyEither a) where
    fmap :: forall a b. (a -> b) -> MyEither a a -> MyEither a b
fmap = (a -> b) -> MyEither a a -> MyEither a b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (MyEither a) where
    pure :: a2 -> MyEither a1 a2
    pure :: forall a2 a1. a2 -> MyEither a1 a2
pure a2
x = a2 -> MyEither a1 a2
forall a. a -> MyEither a1 a
forall (m :: * -> *) a. Monad m => a -> m a
return a2
x -- note that an eta reduced version of this trips the type checker for non-canonical "pure = return"
    (<*>) :: MyEither a1 (a2 -> b) -> MyEither a1 a2 -> MyEither a1 b
    <*> :: forall a a b. MyEither a (a -> b) -> MyEither a a -> MyEither a b
(<*>) = MyEither a1 (a2 -> b) -> MyEither a1 a2 -> MyEither a1 b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (MyEither a) where
    (MyEither (Right a
x)) >>= :: forall a b. MyEither a a -> (a -> MyEither a b) -> MyEither a b
>>= a -> MyEither a b
f = a -> MyEither a b
f a
x
    (MyEither (Left a
x)) >>= a -> MyEither a b
f = Either a b -> MyEither a b
forall a b. Either a b -> MyEither a b
MyEither (a -> Either a b
forall a b. a -> Either a b
Left a
x)

instance ByteSource (StateT [Word8] (MyEither DecodingException)) where
    sourceEmpty :: StateT [Word8] (MyEither DecodingException) Bool
sourceEmpty = ([Word8] -> Bool)
-> StateT [Word8] (MyEither DecodingException) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets [Word8] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    fetchWord8 :: StateT [Word8] (MyEither DecodingException) Word8
fetchWord8 = do
        [Word8]
s <- StateT [Word8] (MyEither DecodingException) [Word8]
forall s (m :: * -> *). MonadState s m => m s
get
        case [Word8]
s of
            [] -> DecodingException
-> StateT [Word8] (MyEither DecodingException) Word8
forall a.
DecodingException -> StateT [Word8] (MyEither DecodingException) a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException DecodingException
UnexpectedEnd
            Word8
c:[Word8]
cs -> [Word8] -> StateT [Word8] (MyEither DecodingException) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Word8]
cs StateT [Word8] (MyEither DecodingException) ()
-> StateT [Word8] (MyEither DecodingException) Word8
-> StateT [Word8] (MyEither DecodingException) Word8
forall a b.
StateT [Word8] (MyEither DecodingException) a
-> StateT [Word8] (MyEither DecodingException) b
-> StateT [Word8] (MyEither DecodingException) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> StateT [Word8] (MyEither DecodingException) Word8
forall a. a -> StateT [Word8] (MyEither DecodingException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
c
    fetchAhead :: forall a.
StateT [Word8] (MyEither DecodingException) (Maybe a)
-> StateT [Word8] (MyEither DecodingException) (Maybe a)
fetchAhead StateT [Word8] (MyEither DecodingException) (Maybe a)
m = do
        [Word8]
s <- StateT [Word8] (MyEither DecodingException) [Word8]
forall s (m :: * -> *). MonadState s m => m s
get
        Maybe a
v <- StateT [Word8] (MyEither DecodingException) (Maybe a)
m
        [Word8] -> StateT [Word8] (MyEither DecodingException) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Word8]
s
        Maybe a -> StateT [Word8] (MyEither DecodingException) (Maybe a)
forall a. a -> StateT [Word8] (MyEither DecodingException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v

-- some ones that we know satisfy our invariant (see SGF.Parse.Raw)
encodings :: [DynEncoding]
encodings = (String -> DynEncoding) -> [String] -> [DynEncoding]
forall a b. (a -> b) -> [a] -> [b]
map String -> DynEncoding
encodingFromString [String
"latin1", String
"utf-8", String
"ascii"]

guess :: [Word8] -> DynEncoding -> Bool
guess [Word8]
ws DynEncoding
encoding =
    case StateT [Word8] (MyEither DecodingException) String
-> [Word8] -> MyEither DecodingException (String, [Word8])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DynEncoding -> StateT [Word8] (MyEither DecodingException) String
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m String
forall (m :: * -> *). ByteSource m => DynEncoding -> m String
decode DynEncoding
encoding) [Word8]
ws :: MyIHateGHC of
        (MyEither (Right (String
s, []))) ->
            String -> Maybe DynEncoding
encodingFromStringExplicit String
s Maybe DynEncoding -> Maybe DynEncoding -> Bool
forall a. Eq a => a -> a -> Bool
== DynEncoding -> Maybe DynEncoding
forall a. a -> Maybe a
Just DynEncoding
encoding
        MyEither DecodingException (String, [Word8])
_ -> Bool
False

-- |
-- Try decoding the given word string with each of the known-good encodings to
-- see if the decoded name names the encoding used to decode.  It should be
-- impossible for this to return a list with more than one guess.
guessEncoding :: [Word8] -> [DynEncoding]
guessEncoding :: [Word8] -> [DynEncoding]
guessEncoding [Word8]
ws = (DynEncoding -> Bool) -> [DynEncoding] -> [DynEncoding]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Word8] -> DynEncoding -> Bool
guess [Word8]
ws) [DynEncoding]
encodings

-- |
-- A simple wrapper around the encoding package's 'decode' function.
decodeWordStringExplicit ::
       Encoding e => e -> [Word8] -> Either DecodingException String
decodeWordStringExplicit :: forall e.
Encoding e =>
e -> [Word8] -> Either DecodingException String
decodeWordStringExplicit e
e [Word8]
ws =
    case StateT [Word8] (MyEither DecodingException) String
-> [Word8] -> MyEither DecodingException (String, [Word8])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (e -> StateT [Word8] (MyEither DecodingException) String
forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m String
forall (m :: * -> *). ByteSource m => e -> m String
decode e
e) [Word8]
ws :: MyIHateGHC of
        (MyEither (Right (String
s, [Word8]
_))) -> String -> Either DecodingException String
forall a b. b -> Either a b
Right String
s
        (MyEither (Left DecodingException
ex)) -> DecodingException -> Either DecodingException String
forall a b. a -> Either a b
Left DecodingException
ex