{-# OPTIONS -fallow-overlapping-instances -fglasgow-exts #-}
{-# language IncoherentInstances #-}

module Autolib.Reader.Instances where

import Autolib.Reader.Class
import Autolib.Reader.Basic
-- import Autolib.ToDoc (Doc, text)

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token
-- import Text.ParserCombinators.Parsec.Language ( haskell )

import Data.Bimap (Bimap, fromList)
import Data.Int
import Data.Ratio
import Numeric.Natural
import qualified Data.Text as T

import GHC.Generics

instance Reader Integer where atomic_readerPrec :: Int -> Parser Integer
atomic_readerPrec Int
_ = GenTokenParser String () Identity -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
integer GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader Natural where atomic_readerPrec :: Int -> Parser Natural
atomic_readerPrec Int
_ = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Parser Integer -> Parser Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser String () Identity -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
natural GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader Int   where atomic_readerPrec :: Int -> Parser Int
atomic_readerPrec Int
_ = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Parser Integer -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser String () Identity -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
integer GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader Int32 where atomic_readerPrec :: Int -> Parser Int32
atomic_readerPrec Int
_ = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> Parser Integer -> Parser Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser String () Identity -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
integer GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader Int16 where atomic_readerPrec :: Int -> Parser Int16
atomic_readerPrec Int
_ = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Parser Integer -> Parser Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser String () Identity -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
integer GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader Char    where
  atomic_readerPrec :: Int -> Parser Char
atomic_readerPrec Int
_ = GenTokenParser String () Identity -> Parser Char
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Char
charLiteral GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
  readerList :: Parser String
readerList = GenTokenParser String () Identity -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
stringLiteral GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader String  where
  atomic_readerPrec :: Int -> Parser String
atomic_readerPrec Int
_ = GenTokenParser String () Identity -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
stringLiteral GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
instance Reader T.Text where
  atomic_readerPrec :: Int -> Parser Text
atomic_readerPrec Int
p = String -> Text
T.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser String
forall a. Reader a => Int -> Parser a
atomic_readerPrec Int
p

instance Reader Double where
  atomic_readerPrec :: Int -> Parser Double
atomic_readerPrec Int
_ = ParsecT String () Identity (Double -> Double)
forall {u}. ParsecT String u Identity (Double -> Double)
sign ParsecT String () Identity (Double -> Double)
-> Parser Double -> Parser Double
forall a b.
ParsecT String () Identity (a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
forall {u}. ParsecT String u Identity Double
flt where
    flt :: ParsecT String u Identity Double
flt = (Integer -> Double)
-> (Double -> Double) -> Either Integer Double -> Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Double -> Double
forall a. a -> a
id (Either Integer Double -> Double)
-> ParsecT String u Identity (Either Integer Double)
-> ParsecT String u Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser String u Identity
-> ParsecT String u Identity (Either Integer Double)
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m (Either Integer Double)
naturalOrFloat GenTokenParser String u Identity
forall {u}. GenTokenParser String u Identity
haskell
    -- | this should be exported from Text.Parsec.Token, but isn't
    sign :: ParsecT String u Identity (Double -> Double)
sign = (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String u Identity Char
-> ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Double -> Double) -> ParsecT String u Identity (Double -> Double)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Double -> Double
forall a. Num a => a -> a
negate)
       ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT String u Identity Char
-> ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Double -> Double) -> ParsecT String u Identity (Double -> Double)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Double -> Double
forall a. a -> a
id)
       ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
-> ParsecT String u Identity (Double -> Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Double -> Double) -> ParsecT String u Identity (Double -> Double)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Double -> Double
forall a. a -> a
id


instance (Integral a, Reader a) => Reader (Ratio a) where
    atomic_readerPrec :: Int -> Parser (Ratio a)
atomic_readerPrec Int
_ = do
        x <- Int -> Parser a
forall a. Reader a => Int -> Parser a
atomic_readerPrec Int
0
        y <- option 1 $ do
            oneOf "%/"
            y <- reader
            if y == 0
              then unexpected "denominator cannot be zero"
              else return y
        return $ x % y

-- FIXME: replace instances for tuples by a generic rule
instance Reader () where 
    atomic_readerPrec :: Int -> Parser ()
atomic_readerPrec Int
_ = Parser () -> Parser ()
forall a. Parser a -> Parser a
my_parens ( () -> Parser ()
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return () )

instance (Reader a, Reader b) => Reader (a, b) where
    atomic_readerPrec :: Int -> Parser (a, b)
atomic_readerPrec Int
_ = Parser (a, b) -> Parser (a, b)
forall a. Parser a -> Parser a
my_parens (Parser (a, b) -> Parser (a, b)) -> Parser (a, b) -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ do 
             x <- Parser a
forall a. Reader a => Parser a
reader ; my_comma
             y <- reader
             return (x, y)

instance (Reader a, Reader b, Reader c) => Reader (a, b, c) where
    atomic_readerPrec :: Int -> Parser (a, b, c)
atomic_readerPrec Int
_ = Parser (a, b, c) -> Parser (a, b, c)
forall a. Parser a -> Parser a
my_parens (Parser (a, b, c) -> Parser (a, b, c))
-> Parser (a, b, c) -> Parser (a, b, c)
forall a b. (a -> b) -> a -> b
$ do 
             x <- Parser a
forall a. Reader a => Parser a
reader ; my_comma
             y <- reader ; my_comma
             z <- reader
             return (x, y, z)


instance (Reader a, Reader b, Reader c, Reader d ) => Reader (a, b, c, d) where
    atomic_readerPrec :: Int -> Parser (a, b, c, d)
atomic_readerPrec Int
_ = Parser (a, b, c, d) -> Parser (a, b, c, d)
forall a. Parser a -> Parser a
my_parens (Parser (a, b, c, d) -> Parser (a, b, c, d))
-> Parser (a, b, c, d) -> Parser (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ do 
             x <- Parser a
forall a. Reader a => Parser a
reader ; my_comma
             y <- reader ; my_comma
             z <- reader ; my_comma
             p <- reader 
             return (x, y, z, p)


instance (Reader a, Reader b, Reader c, Reader d, Reader e ) => Reader (a, b, c, d, e) where
    atomic_readerPrec :: Int -> Parser (a, b, c, d, e)
atomic_readerPrec Int
_ = Parser (a, b, c, d, e) -> Parser (a, b, c, d, e)
forall a. Parser a -> Parser a
my_parens (Parser (a, b, c, d, e) -> Parser (a, b, c, d, e))
-> Parser (a, b, c, d, e) -> Parser (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ do 
             x <- Parser a
forall a. Reader a => Parser a
reader ; my_comma
             y <- reader ; my_comma
             z <- reader ; my_comma
             p <- reader ; my_comma
             q <- reader
             return (x, y, z, p, q)

instance Reader a => Reader [a] where
    atomic_readerPrec :: Int -> Parser [a]
atomic_readerPrec Int
_ = Parser [a]
forall a. Reader a => Parser [a]
readerList

-- instance Reader Doc where
--    atomic_readerPrec _ = do cs <- reader ; return $ text cs

instance (Ord key1, Ord key2, Reader key1, Reader key2)
  => Reader (Bimap key1 key2) where
  atomic_readerPrec :: Int -> Parser (Bimap key1 key2)
atomic_readerPrec Int
p = do
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ( Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9 )
    String -> Parser ()
my_reserved String
"listToFM"
    [(key1, key2)] -> Bimap key1 key2
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
fromList ([(key1, key2)] -> Bimap key1 key2)
-> ParsecT String () Identity [(key1, key2)]
-> Parser (Bimap key1 key2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [(key1, key2)]
forall a. Reader a => Parser a
reader