{-# OPTIONS -fallow-overlapping-instances -fallow-undecidable-instances -fglasgow-exts #-}
{-# LANGUAGE TypeApplications #-}

module Autolib.Reader.Link where

import Autolib.Reader.Class
import Autolib.Reader.Basic

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

import Control.Monad
import Data.Coerce (coerce)

-- | drop-in replacement for @read@
reading :: Reader a => String -> a
reading :: forall a. Reader a => String -> a
reading String
input = case Parsec String () a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec String () a
forall a. Reader a => Parser a
reader Parsec String () a
-> ParsecT String () Identity () -> Parsec String () a
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"input" String
input 
    of Right a
x -> a
x
       Left  ParseError
err -> String -> a
forall a. HasCallStack => String -> a
error (String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
input String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)

newtype FromReader a = FromReader a

instance Reader a => Read (FromReader a) where
  readsPrec :: Int -> ReadS (FromReader a)
readsPrec = ReadS a -> ReadS (FromReader a)
forall a b. Coercible a b => a -> b
coerce (ReadS a -> ReadS (FromReader a))
-> (Int -> ReadS a) -> Int -> ReadS (FromReader a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reader a => Int -> ReadS a
parsec_readsPrec @a

-- | note: cannot raise an exception here
-- since we might be called from a classical Read parser
-- that wants to parse a list element. this breaks for parsing the empty list
-- curiously, it worked for non-empty lists
parsec_readsPrec :: Reader a => Int -> ReadS a
parsec_readsPrec :: forall a. Reader a => Int -> ReadS a
parsec_readsPrec Int
p String
input = 
    case Parsec String () (a, String)
-> String -> String -> Either ParseError (a, String)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse ( Int -> Parsec String () (a, String)
forall a. Reader a => Int -> Parser (a, String)
parsec_wrapper Int
p ) String
"input" String
input 
    of Right (a
x, String
rest) -> (a, String) -> [(a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, String
rest)
       Left  ParseError
err       -> -- error ("\n" ++ input ++ "\n" ++ show err)
                          [(a, String)]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parsec_wrapper :: Reader a => Int -> Parser (a, String)
parsec_wrapper :: forall a. Reader a => Int -> Parser (a, String)
parsec_wrapper Int
p = do 
    GenTokenParser String () Identity -> ParsecT String () Identity ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
whiteSpace GenTokenParser String () Identity
forall {u}. GenTokenParser String u Identity
haskell
    x <- Int -> Parser a
forall a. Reader a => Int -> Parser a
readerPrec Int
p
    rest <- getInput
    return (x , rest)