{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskellish where
import Language.Haskell.Exts as Exts
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Except
import Data.Either (isRight)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
type Span = ((Int,Int),(Int,Int))
data ParseError = NonFatal Span Text | Fatal Span Text
data Haskellish st a = Haskellish { Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run :: st -> Exp SrcSpanInfo -> Either ParseError (a,st) }
runHaskellish :: Haskellish st a -> st -> Exp SrcSpanInfo -> Either String (a,st)
runHaskellish :: Haskellish st a -> st -> Exp SrcSpanInfo -> Either String (a, st)
runHaskellish Haskellish st a
h st
st Exp SrcSpanInfo
e =
case Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
h st
st Exp SrcSpanInfo
e of
Right (a
a,st
s) -> (a, st) -> Either String (a, st)
forall a b. b -> Either a b
Right (a
a,st
s)
Left (NonFatal ((Int
a,Int
b),(Int, Int)
_) Text
t) -> String -> Either String (a, st)
forall a b. a -> Either a b
Left (String -> Either String (a, st))
-> String -> Either String (a, st)
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
Left (Fatal ((Int
a,Int
b),(Int, Int)
_) Text
t) -> String -> Either String (a, st)
forall a b. a -> Either a b
Left (String -> Either String (a, st))
-> String -> Either String (a, st)
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
parseAndRun :: Haskellish st a -> st -> String -> Either (Span,Text) (a,st)
parseAndRun :: Haskellish st a
-> st -> String -> Either (((Int, Int), (Int, Int)), Text) (a, st)
parseAndRun = ParseMode
-> Haskellish st a
-> st
-> String
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
forall st a.
ParseMode
-> Haskellish st a
-> st
-> String
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
parseWithModeAndRun ParseMode
Exts.defaultParseMode
parseWithModeAndRun :: Exts.ParseMode -> Haskellish st a -> st -> String -> Either (Span,Text) (a,st)
parseWithModeAndRun :: ParseMode
-> Haskellish st a
-> st
-> String
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
parseWithModeAndRun ParseMode
m Haskellish st a
h st
st String
x = do
case ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
forall ast. Parseable ast => ParseMode -> String -> ParseResult ast
Exts.parseWithMode ParseMode
m String
x of
Exts.ParseOk Exp SrcSpanInfo
e -> do
case Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
h st
st Exp SrcSpanInfo
e of
Right (a
a,st
st) -> (a, st) -> Either (((Int, Int), (Int, Int)), Text) (a, st)
forall a b. b -> Either a b
Right (a
a,st
st)
Left (NonFatal ((Int, Int), (Int, Int))
s Text
t) -> (((Int, Int), (Int, Int)), Text)
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
forall a b. a -> Either a b
Left (((Int, Int), (Int, Int))
s,Text
t)
Left (Fatal ((Int, Int), (Int, Int))
s Text
t) -> (((Int, Int), (Int, Int)), Text)
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
forall a b. a -> Either a b
Left (((Int, Int), (Int, Int))
s,Text
t)
Exts.ParseFailed SrcLoc
loc String
err -> (((Int, Int), (Int, Int)), Text)
-> Either (((Int, Int), (Int, Int)), Text) (a, st)
forall a b. a -> Either a b
Left (((Int
a,Int
b),(Int
a,Int
b)),String -> Text
T.pack String
err)
where
a :: Int
a = SrcLoc -> Int
Exts.srcLine SrcLoc
loc
b :: Int
b = SrcLoc -> Int
Exts.srcColumn SrcLoc
loc
removeComments :: String -> String
[] = []
removeComments (Char
'-':Char
'-':String
xs) = String -> String
removeCommentsSingleLine String
xs
removeComments (Char
'{':Char
'-':String
xs) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
removeCommentsMultiLine String
xs
removeComments (Char
'\"':String
xs) = Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeCommentsLiteralString String
xs
removeComments (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeComments String
xs
removeCommentsSingleLine :: String -> String
[] = []
removeCommentsSingleLine (Char
'\n':String
xs) = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeComments String
xs
removeCommentsSingleLine (Char
_:String
xs) = String -> String
removeCommentsSingleLine String
xs
removeCommentsMultiLine :: String -> String
[] = []
removeCommentsMultiLine (Char
'\n':String
xs) = Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeCommentsMultiLine String
xs
removeCommentsMultiLine (Char
'-':Char
'}':String
xs) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
removeComments String
xs
removeCommentsMultiLine (Char
_:String
xs) = Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeCommentsMultiLine String
xs
removeCommentsLiteralString :: String -> String
[] = []
removeCommentsLiteralString (Char
'\\':Char
'"':String
xs) = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
removeCommentsLiteralString String
xs
removeCommentsLiteralString (Char
'"':String
xs) = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeComments String
xs
removeCommentsLiteralString (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeCommentsLiteralString String
xs
exp :: Haskellish st (Exp SrcSpanInfo)
exp :: Haskellish st (Exp SrcSpanInfo)
exp = (st -> Exp SrcSpanInfo -> Either ParseError (Exp SrcSpanInfo, st))
-> Haskellish st (Exp SrcSpanInfo)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> (Exp SrcSpanInfo, st) -> Either ParseError (Exp SrcSpanInfo, st)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp SrcSpanInfo
e,st
st))
fatal :: Text -> Haskellish st a
fatal :: Text -> Haskellish st a
fatal Text
m = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> ParseError -> Either ParseError (a, st)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, st))
-> ParseError -> Either ParseError (a, st)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
Fatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
m)
nonFatal :: Text -> Haskellish st a
nonFatal :: Text -> Haskellish st a
nonFatal Text
m = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> ParseError -> Either ParseError (a, st)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, st))
-> ParseError -> Either ParseError (a, st)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
m)
(<?>) :: Haskellish st a -> Text -> Haskellish st a
Haskellish st a
h <?> :: Haskellish st a -> Text -> Haskellish st a
<?> Text
msg = Haskellish st a
h Haskellish st a -> Haskellish st a -> Haskellish st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Haskellish st a
forall st a. Text -> Haskellish st a
nonFatal Text
msg
(<?!>) :: Haskellish st a -> Text -> Haskellish st a
Haskellish st a
h <?!> :: Haskellish st a -> Text -> Haskellish st a
<?!> Text
msg = Haskellish st a
h Haskellish st a -> Haskellish st a -> Haskellish st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Haskellish st a
forall st a. Text -> Haskellish st a
fatal Text
msg
required :: Haskellish st a -> Haskellish st a
required :: Haskellish st a -> Haskellish st a
required Haskellish st a
h = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
case Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
h st
st Exp SrcSpanInfo
e of
Right (a
a,st
s) -> (a, st) -> Either ParseError (a, st)
forall a b. b -> Either a b
Right (a
a,st
s)
Left (NonFatal ((Int, Int), (Int, Int))
s Text
t) -> ParseError -> Either ParseError (a, st)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, st))
-> ParseError -> Either ParseError (a, st)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
Fatal ((Int, Int), (Int, Int))
s Text
t
Left (Fatal ((Int, Int), (Int, Int))
s Text
t) -> ParseError -> Either ParseError (a, st)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, st))
-> ParseError -> Either ParseError (a, st)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
Fatal ((Int, Int), (Int, Int))
s Text
t
)
(<*!>) :: Haskellish st (a -> b) -> Haskellish st a -> Haskellish st b
Haskellish st (a -> b)
f <*!> :: Haskellish st (a -> b) -> Haskellish st a -> Haskellish st b
<*!> Haskellish st a
x = Haskellish st (a -> b)
f Haskellish st (a -> b) -> Haskellish st a -> Haskellish st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Haskellish st a -> Haskellish st a
forall st a. Haskellish st a -> Haskellish st a
required Haskellish st a
x
instance Functor (Haskellish st) where
fmap :: (a -> b) -> Haskellish st a -> Haskellish st b
fmap a -> b
f Haskellish st a
x = (st -> Exp SrcSpanInfo -> Either ParseError (b, st))
-> Haskellish st b
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(a
x',st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
x st
st Exp SrcSpanInfo
e
(b, st) -> Either ParseError (b, st)
forall a b. b -> Either a b
Right (a -> b
f a
x',st
st')
)
instance Applicative (Haskellish st) where
pure :: a -> Haskellish st a
pure a
x = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
_ -> (a, st) -> Either ParseError (a, st)
forall a b. b -> Either a b
Right (a
x,st
st))
Haskellish st (a -> b)
f <*> :: Haskellish st (a -> b) -> Haskellish st a -> Haskellish st b
<*> Haskellish st a
x = (st -> Exp SrcSpanInfo -> Either ParseError (b, st))
-> Haskellish st b
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
e1,Exp SrcSpanInfo
e2) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
e
(a -> b
f',st
st') <- Haskellish st (a -> b)
-> st -> Exp SrcSpanInfo -> Either ParseError (a -> b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st (a -> b)
f st
st Exp SrcSpanInfo
e1
(a
x',st
st'') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
x st
st' Exp SrcSpanInfo
e2
(b, st) -> Either ParseError (b, st)
forall a b. b -> Either a b
Right (a -> b
f' a
x',st
st'')
)
applicationExpressions :: Exp SrcSpanInfo -> Either ParseError (Exp SrcSpanInfo,Exp SrcSpanInfo)
applicationExpressions :: Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
x
applicationExpressions (App SrcSpanInfo
_ Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
e1,Exp SrcSpanInfo
e2)
applicationExpressions (InfixApp SrcSpanInfo
_ Exp SrcSpanInfo
e1 (QVarOp SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Symbol SrcSpanInfo
_ String
"$"))) Exp SrcSpanInfo
e2) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
e1,Exp SrcSpanInfo
e2)
applicationExpressions (InfixApp SrcSpanInfo
l Exp SrcSpanInfo
e1 (QVarOp SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Symbol SrcSpanInfo
_ String
x))) Exp SrcSpanInfo
e2) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (SrcSpanInfo
-> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l
App SrcSpanInfo
l Exp SrcSpanInfo
x' Exp SrcSpanInfo
e1,Exp SrcSpanInfo
e2)
where x' :: Exp SrcSpanInfo
x' = (SrcSpanInfo -> QName SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> QName l -> Exp l
Var SrcSpanInfo
l (SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
l (SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
l String
x)))
applicationExpressions (LeftSection SrcSpanInfo
l Exp SrcSpanInfo
e1 (QVarOp SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Symbol SrcSpanInfo
_ String
x)))) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
x',Exp SrcSpanInfo
e1)
where x' :: Exp SrcSpanInfo
x' = (SrcSpanInfo -> QName SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> QName l -> Exp l
Var SrcSpanInfo
l (SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
l (SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
l String
x)))
applicationExpressions Exp SrcSpanInfo
e = ParseError -> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected application expresssion"
instance Alternative (Haskellish st) where
empty :: Haskellish st a
empty = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
_ Exp SrcSpanInfo
e -> ParseError -> Either ParseError (a, st)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, st))
-> ParseError -> Either ParseError (a, st)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"")
Haskellish st a
a <|> :: Haskellish st a -> Haskellish st a -> Haskellish st a
<|> Haskellish st a
b = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
let a' :: Either ParseError (a, st)
a' = Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
a st
st Exp SrcSpanInfo
e
case Either ParseError (a, st)
a' of
Right (a, st)
_ -> Either ParseError (a, st)
a'
Left (Fatal ((Int, Int), (Int, Int))
_ Text
_) -> Either ParseError (a, st)
a'
Left (NonFatal ((Int, Int), (Int, Int))
_ Text
_) -> Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
b st
st Exp SrcSpanInfo
e
)
instance Monad (Haskellish st) where
Haskellish st a
x >>= :: Haskellish st a -> (a -> Haskellish st b) -> Haskellish st b
>>= a -> Haskellish st b
f = (st -> Exp SrcSpanInfo -> Either ParseError (b, st))
-> Haskellish st b
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(a
x',st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
x st
st Exp SrcSpanInfo
e
Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run (a -> Haskellish st b
f a
x') st
st' Exp SrcSpanInfo
e
)
instance MonadPlus (Haskellish st) where
mzero :: Haskellish st a
mzero = Haskellish st a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Haskellish st a -> Haskellish st a -> Haskellish st a
mplus = Haskellish st a -> Haskellish st a -> Haskellish st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
instance MonadState st (Haskellish st) where
get :: Haskellish st st
get = (st -> Exp SrcSpanInfo -> Either ParseError (st, st))
-> Haskellish st st
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
_ -> (st, st) -> Either ParseError (st, st)
forall (m :: * -> *) a. Monad m => a -> m a
return (st
st,st
st))
put :: st -> Haskellish st ()
put st
st = (st -> Exp SrcSpanInfo -> Either ParseError ((), st))
-> Haskellish st ()
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
_ Exp SrcSpanInfo
_ -> ((), st) -> Either ParseError ((), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((),st
st))
instance MonadError Text (Haskellish st) where
throwError :: Text -> Haskellish st a
throwError Text
x = Text -> Haskellish st a
forall st a. Text -> Haskellish st a
fatal Text
x
catchError :: Haskellish st a -> (Text -> Haskellish st a) -> Haskellish st a
catchError Haskellish st a
x Text -> Haskellish st a
f = (st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
let x' :: Either ParseError (a, st)
x' = Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
x st
st Exp SrcSpanInfo
e
case Either ParseError (a, st)
x' of
Right (a
x'',st
st') -> (a, st) -> Either ParseError (a, st)
forall a b. b -> Either a b
Right (a
x'',st
st')
Left (Fatal ((Int, Int), (Int, Int))
s Text
err) -> Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run (Text -> Haskellish st a
f Text
err) st
st Exp SrcSpanInfo
e
Left (NonFatal ((Int, Int), (Int, Int))
s Text
err) -> Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run (Text -> Haskellish st a
f Text
err) st
st Exp SrcSpanInfo
e
)
identifier :: Haskellish st String
identifier :: Haskellish st String
identifier = (st -> Exp SrcSpanInfo -> Either ParseError (String, st))
-> Haskellish st String
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> st -> Exp SrcSpanInfo -> Either ParseError (String, st)
forall b. b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f st
st Exp SrcSpanInfo
e)
where f :: b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f b
st (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f b
st Exp SrcSpanInfo
x
f b
st (Var SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Ident SrcSpanInfo
_ String
x))) = (String, b) -> Either ParseError (String, b)
forall a b. b -> Either a b
Right (String
x,b
st)
f b
st (Var SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Symbol SrcSpanInfo
_ String
x))) = (String, b) -> Either ParseError (String, b)
forall a b. b -> Either a b
Right (String
x,b
st)
f b
_ Exp SrcSpanInfo
e = ParseError -> Either ParseError (String, b)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (String, b))
-> ParseError -> Either ParseError (String, b)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected identifier"
trueOrFalse :: Haskellish st Bool
trueOrFalse :: Haskellish st Bool
trueOrFalse = (st -> Exp SrcSpanInfo -> Either ParseError (Bool, st))
-> Haskellish st Bool
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> st -> Exp SrcSpanInfo -> Either ParseError (Bool, st)
forall b. b -> Exp SrcSpanInfo -> Either ParseError (Bool, b)
f st
st Exp SrcSpanInfo
e)
where
f :: b -> Exp SrcSpanInfo -> Either ParseError (Bool, b)
f b
st (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = b -> Exp SrcSpanInfo -> Either ParseError (Bool, b)
f b
st Exp SrcSpanInfo
x
f b
st (Con SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Ident SrcSpanInfo
_ String
"True"))) = (Bool, b) -> Either ParseError (Bool, b)
forall a b. b -> Either a b
Right (Bool
True,b
st)
f b
st (Con SrcSpanInfo
_ (UnQual SrcSpanInfo
_ (Ident SrcSpanInfo
_ String
"False"))) = (Bool, b) -> Either ParseError (Bool, b)
forall a b. b -> Either a b
Right (Bool
False,b
st)
f b
_ Exp SrcSpanInfo
e = ParseError -> Either ParseError (Bool, b)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Bool, b))
-> ParseError -> Either ParseError (Bool, b)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected bool"
reserved :: String -> Haskellish st ()
reserved :: String -> Haskellish st ()
reserved String
x = (st -> Exp SrcSpanInfo -> Either ParseError ((), st))
-> Haskellish st ()
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(String
e',st
_) <- Haskellish st String
-> st -> Exp SrcSpanInfo -> Either ParseError (String, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st String
forall st. Haskellish st String
identifier st
st Exp SrcSpanInfo
e
if String
e' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x then ((), st) -> Either ParseError ((), st)
forall a b. b -> Either a b
Right ((),st
st) else ParseError -> Either ParseError ((), st)
forall a b. a -> Either a b
Left (((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected reserved word")
)
string :: Haskellish st String
string :: Haskellish st String
string = (st -> Exp SrcSpanInfo -> Either ParseError (String, st))
-> Haskellish st String
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> st -> Exp SrcSpanInfo -> Either ParseError (String, st)
forall b. b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f st
st Exp SrcSpanInfo
e)
where f :: b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f b
st (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = b -> Exp SrcSpanInfo -> Either ParseError (String, b)
f b
st Exp SrcSpanInfo
x
f b
st (Lit SrcSpanInfo
_ (String SrcSpanInfo
_ String
x String
_)) = (String, b) -> Either ParseError (String, b)
forall a b. b -> Either a b
Right (String
x,b
st)
f b
_ Exp SrcSpanInfo
e = ParseError -> Either ParseError (String, b)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (String, b))
-> ParseError -> Either ParseError (String, b)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected literal String"
integer :: Haskellish st Integer
integer :: Haskellish st Integer
integer = (st -> Exp SrcSpanInfo -> Either ParseError (Integer, st))
-> Haskellish st Integer
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> st -> Exp SrcSpanInfo -> Either ParseError (Integer, st)
forall b. b -> Exp SrcSpanInfo -> Either ParseError (Integer, b)
f st
st Exp SrcSpanInfo
e)
where f :: b -> Exp SrcSpanInfo -> Either ParseError (Integer, b)
f b
st (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = b -> Exp SrcSpanInfo -> Either ParseError (Integer, b)
f b
st Exp SrcSpanInfo
x
f b
st (NegApp SrcSpanInfo
_ (Lit SrcSpanInfo
_ (Int SrcSpanInfo
_ Integer
x String
_))) = (Integer, b) -> Either ParseError (Integer, b)
forall a b. b -> Either a b
Right (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-Integer
1),b
st)
f b
st (Lit SrcSpanInfo
_ (Int SrcSpanInfo
_ Integer
x String
_)) = (Integer, b) -> Either ParseError (Integer, b)
forall a b. b -> Either a b
Right (Integer
x,b
st)
f b
_ Exp SrcSpanInfo
e = ParseError -> Either ParseError (Integer, b)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Integer, b))
-> ParseError -> Either ParseError (Integer, b)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected Integer"
rational :: Haskellish st Rational
rational :: Haskellish st Rational
rational = (st -> Exp SrcSpanInfo -> Either ParseError (Rational, st))
-> Haskellish st Rational
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> st -> Exp SrcSpanInfo -> Either ParseError (Rational, st)
forall b. b -> Exp SrcSpanInfo -> Either ParseError (Rational, b)
f st
st Exp SrcSpanInfo
e)
where f :: b -> Exp SrcSpanInfo -> Either ParseError (Rational, b)
f b
st (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = b -> Exp SrcSpanInfo -> Either ParseError (Rational, b)
f b
st Exp SrcSpanInfo
x
f b
st (NegApp SrcSpanInfo
_ (Lit SrcSpanInfo
_ (Frac SrcSpanInfo
_ Rational
x String
_))) = (Rational, b) -> Either ParseError (Rational, b)
forall a b. b -> Either a b
Right (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (-Rational
1),b
st)
f b
st (Lit SrcSpanInfo
_ (Frac SrcSpanInfo
_ Rational
x String
_)) = (Rational, b) -> Either ParseError (Rational, b)
forall a b. b -> Either a b
Right (Rational
x,b
st)
f b
_ Exp SrcSpanInfo
e = ParseError -> Either ParseError (Rational, b)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Rational, b))
-> ParseError -> Either ParseError (Rational, b)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected Rational"
rationalOrInteger :: Haskellish st Rational
rationalOrInteger :: Haskellish st Rational
rationalOrInteger = Haskellish st Rational
forall st. Haskellish st Rational
rational Haskellish st Rational
-> Haskellish st Rational -> Haskellish st Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Rational)
-> Haskellish st Integer -> Haskellish st Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Haskellish st Integer
forall st. Haskellish st Integer
integer) Haskellish st Rational
-> Haskellish st Rational -> Haskellish st Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Haskellish st Rational
forall st a. Text -> Haskellish st a
nonFatal Text
"expected Rational or Integer"
list :: Haskellish st a -> Haskellish st [a]
list :: Haskellish st a -> Haskellish st [a]
list Haskellish st a
p = (st -> Exp SrcSpanInfo -> Either ParseError ([a], st))
-> Haskellish st [a]
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
[Exp SrcSpanInfo]
xs <- Exp SrcSpanInfo -> Either ParseError [Exp SrcSpanInfo]
listExpressions Exp SrcSpanInfo
e
(([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st))
-> ([a], st) -> [Exp SrcSpanInfo] -> Either ParseError ([a], st)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st)
f ([],st
st) [Exp SrcSpanInfo]
xs
)
where
f :: ([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st)
f ([a]
ys,st
st) Exp SrcSpanInfo
x = do
(a
y,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
p st
st Exp SrcSpanInfo
x
([a], st) -> Either ParseError ([a], st)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
y],st
st')
listExpressions :: Exp SrcSpanInfo -> Either ParseError [Exp SrcSpanInfo]
listExpressions :: Exp SrcSpanInfo -> Either ParseError [Exp SrcSpanInfo]
listExpressions (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = Exp SrcSpanInfo -> Either ParseError [Exp SrcSpanInfo]
listExpressions Exp SrcSpanInfo
x
listExpressions (List SrcSpanInfo
_ [Exp SrcSpanInfo]
xs) = [Exp SrcSpanInfo] -> Either ParseError [Exp SrcSpanInfo]
forall a b. b -> Either a b
Right [Exp SrcSpanInfo]
xs
listExpressions Exp SrcSpanInfo
e = ParseError -> Either ParseError [Exp SrcSpanInfo]
forall a b. a -> Either a b
Left (ParseError -> Either ParseError [Exp SrcSpanInfo])
-> ParseError -> Either ParseError [Exp SrcSpanInfo]
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected list"
tuple :: Haskellish st a -> Haskellish st b -> Haskellish st (a,b)
tuple :: Haskellish st a -> Haskellish st b -> Haskellish st (a, b)
tuple Haskellish st a
p1 Haskellish st b
p2 = (st -> Exp SrcSpanInfo -> Either ParseError ((a, b), st))
-> Haskellish st (a, b)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
a,Exp SrcSpanInfo
b) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
e
(a
a',st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
p1 st
st Exp SrcSpanInfo
a
(b
b',st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
p2 st
st' Exp SrcSpanInfo
b
((a, b), st) -> Either ParseError ((a, b), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a',b
b'),st
st'')
)
where
f :: Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
x
f (Tuple SrcSpanInfo
_ Boxed
Boxed (Exp SrcSpanInfo
a:Exp SrcSpanInfo
b:[])) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
a,Exp SrcSpanInfo
b)
f Exp SrcSpanInfo
e = ParseError -> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected tuple"
asRightSection :: Haskellish st (a -> b -> c) -> Haskellish st b -> Haskellish st (a -> c)
asRightSection :: Haskellish st (a -> b -> c)
-> Haskellish st b -> Haskellish st (a -> c)
asRightSection Haskellish st (a -> b -> c)
opP Haskellish st b
bP = (st -> Exp SrcSpanInfo -> Either ParseError (a -> c, st))
-> Haskellish st (a -> c)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
opExp,Exp SrcSpanInfo
bExp) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
e
(a -> b -> c
op',st
st') <- Haskellish st (a -> b -> c)
-> st -> Exp SrcSpanInfo -> Either ParseError (a -> b -> c, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st (a -> b -> c)
opP st
st Exp SrcSpanInfo
opExp
(b
b,st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
bP st
st' Exp SrcSpanInfo
bExp
(a -> c, st) -> Either ParseError (a -> c, st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
op' b
b,st
st'')
)
where
f :: Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
x
f (RightSection SrcSpanInfo
_ (QVarOp SrcSpanInfo
l (UnQual SrcSpanInfo
_ (Symbol SrcSpanInfo
_ String
x))) Exp SrcSpanInfo
e1) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (SrcSpanInfo -> String -> Exp SrcSpanInfo
forall l. l -> String -> Exp l
g SrcSpanInfo
l String
x,Exp SrcSpanInfo
e1)
f Exp SrcSpanInfo
e = ParseError -> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected right section"
g :: l -> String -> Exp l
g l
l String
x = (l -> QName l -> Exp l
forall l. l -> QName l -> Exp l
Var l
l (l -> Name l -> QName l
forall l. l -> Name l -> QName l
UnQual l
l (l -> String -> Name l
forall l. l -> String -> Name l
Ident l
l String
x)))
ifThenElse :: Haskellish st a -> Haskellish st b -> Haskellish st c -> Haskellish st (a,b,c)
ifThenElse :: Haskellish st a
-> Haskellish st b -> Haskellish st c -> Haskellish st (a, b, c)
ifThenElse Haskellish st a
aP Haskellish st b
bP Haskellish st c
cP = (st -> Exp SrcSpanInfo -> Either ParseError ((a, b, c), st))
-> Haskellish st (a, b, c)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
aExp,Exp SrcSpanInfo
bExp,Exp SrcSpanInfo
cExp) <- Exp SrcSpanInfo
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
e
(a
a,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
aP st
st Exp SrcSpanInfo
aExp
(b
b,st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
bP st
st' Exp SrcSpanInfo
bExp
(c
c,st
st''') <- Haskellish st c
-> st -> Exp SrcSpanInfo -> Either ParseError (c, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st c
cP st
st'' Exp SrcSpanInfo
cExp
((a, b, c), st) -> Either ParseError ((a, b, c), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c),st
st''')
)
where
f :: Exp SrcSpanInfo
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
f (Paren SrcSpanInfo
_ Exp SrcSpanInfo
x) = Exp SrcSpanInfo
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
x
f (If SrcSpanInfo
_ Exp SrcSpanInfo
x Exp SrcSpanInfo
y Exp SrcSpanInfo
z) = (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
x,Exp SrcSpanInfo
y,Exp SrcSpanInfo
z)
f Exp SrcSpanInfo
e = ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected if-then-else"
collectDoStatements :: Exp SrcSpanInfo -> [Exp SrcSpanInfo]
collectDoStatements :: Exp SrcSpanInfo -> [Exp SrcSpanInfo]
collectDoStatements (Do SrcSpanInfo
_ [Stmt SrcSpanInfo]
xs) = [Maybe (Exp SrcSpanInfo)] -> [Exp SrcSpanInfo]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Exp SrcSpanInfo)] -> [Exp SrcSpanInfo])
-> [Maybe (Exp SrcSpanInfo)] -> [Exp SrcSpanInfo]
forall a b. (a -> b) -> a -> b
$ (Stmt SrcSpanInfo -> Maybe (Exp SrcSpanInfo))
-> [Stmt SrcSpanInfo] -> [Maybe (Exp SrcSpanInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stmt SrcSpanInfo -> Maybe (Exp SrcSpanInfo)
forall l. Stmt l -> Maybe (Exp l)
f [Stmt SrcSpanInfo]
xs
where
f :: Stmt l -> Maybe (Exp l)
f (Qualifier l
_ Exp l
e) = Exp l -> Maybe (Exp l)
forall a. a -> Maybe a
Just Exp l
e
f Stmt l
_ = Maybe (Exp l)
forall a. Maybe a
Nothing
collectDoStatements Exp SrcSpanInfo
_ = []
listOfDoStatements :: Haskellish st a -> Haskellish st [a]
listOfDoStatements :: Haskellish st a -> Haskellish st [a]
listOfDoStatements Haskellish st a
p = (st -> Exp SrcSpanInfo -> Either ParseError ([a], st))
-> Haskellish st [a]
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
let xs :: [Exp SrcSpanInfo]
xs = Exp SrcSpanInfo -> [Exp SrcSpanInfo]
collectDoStatements Exp SrcSpanInfo
e
(([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st))
-> ([a], st) -> [Exp SrcSpanInfo] -> Either ParseError ([a], st)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st)
f ([],st
st) [Exp SrcSpanInfo]
xs
)
where
f :: ([a], st) -> Exp SrcSpanInfo -> Either ParseError ([a], st)
f ([a]
ys,st
st) Exp SrcSpanInfo
x = do
(a
y,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
p st
st Exp SrcSpanInfo
x
([a], st) -> Either ParseError ([a], st)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
y],st
st')
span :: Haskellish st Span
span :: Haskellish st ((Int, Int), (Int, Int))
span = (st
-> Exp SrcSpanInfo
-> Either ParseError (((Int, Int), (Int, Int)), st))
-> Haskellish st ((Int, Int), (Int, Int))
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> (((Int, Int), (Int, Int)), st)
-> Either ParseError (((Int, Int), (Int, Int)), st)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e,st
st))
expToSpan :: Exp SrcSpanInfo -> Span
expToSpan :: Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan (Var SrcSpanInfo
x QName SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (Paren SrcSpanInfo
x Exp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (App SrcSpanInfo
x Exp SrcSpanInfo
_ Exp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (InfixApp SrcSpanInfo
x Exp SrcSpanInfo
_ QOp SrcSpanInfo
_ Exp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (LeftSection SrcSpanInfo
x Exp SrcSpanInfo
_ QOp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (NegApp SrcSpanInfo
x Exp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (Lit SrcSpanInfo
x Literal SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (List SrcSpanInfo
x [Exp SrcSpanInfo]
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (RightSection SrcSpanInfo
x QOp SrcSpanInfo
_ Exp SrcSpanInfo
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (Tuple SrcSpanInfo
x Boxed
_ [Exp SrcSpanInfo]
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan (Do SrcSpanInfo
x [Stmt SrcSpanInfo]
_) = SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x
expToSpan Exp SrcSpanInfo
_ = ((Int
0,Int
0),(Int
0,Int
0))
srcSpanInfoToSpan :: SrcSpanInfo -> Span
srcSpanInfoToSpan :: SrcSpanInfo -> ((Int, Int), (Int, Int))
srcSpanInfoToSpan SrcSpanInfo
x = ((Int
by,Int
bx),(Int
ey,Int
ex))
where
bx :: Int
bx = SrcSpan -> Int
srcSpanStartColumn (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
x
by :: Int
by = SrcSpan -> Int
srcSpanStartLine (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
x
ex :: Int
ex = SrcSpan -> Int
srcSpanEndColumn (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
x
ey :: Int
ey = SrcSpan -> Int
srcSpanEndLine (SrcSpan -> Int) -> SrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
x
reverseApplication :: Haskellish st a -> Haskellish st (a -> b) -> Haskellish st b
reverseApplication :: Haskellish st a -> Haskellish st (a -> b) -> Haskellish st b
reverseApplication Haskellish st a
x Haskellish st (a -> b)
f = (st -> Exp SrcSpanInfo -> Either ParseError (b, st))
-> Haskellish st b
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
e1,Exp SrcSpanInfo
e2) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
e
(a
x',st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
x st
st Exp SrcSpanInfo
e1
(a -> b
f',st
st'') <- Haskellish st (a -> b)
-> st -> Exp SrcSpanInfo -> Either ParseError (a -> b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st (a -> b)
f st
st' Exp SrcSpanInfo
e2
(b, st) -> Either ParseError (b, st)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f' a
x',st
st'')
)
binaryApplication :: Haskellish st f -> Haskellish st a -> Haskellish st b -> Haskellish st (f,a,b)
binaryApplication :: Haskellish st f
-> Haskellish st a -> Haskellish st b -> Haskellish st (f, a, b)
binaryApplication Haskellish st f
fP Haskellish st a
aP Haskellish st b
bP = (st -> Exp SrcSpanInfo -> Either ParseError ((f, a, b), st))
-> Haskellish st (f, a, b)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
x,Exp SrcSpanInfo
bE) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
e
(Exp SrcSpanInfo
fE,Exp SrcSpanInfo
aE) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
x
(f
f,st
st') <- Haskellish st f
-> st -> Exp SrcSpanInfo -> Either ParseError (f, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st f
fP st
st Exp SrcSpanInfo
fE
(a
a,st
st'') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
aP st
st' Exp SrcSpanInfo
aE
(b
b,st
st''') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
bP st
st'' Exp SrcSpanInfo
bE
((f, a, b), st) -> Either ParseError ((f, a, b), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((f
f,a
a,b
b),st
st''')
)
functionApplication :: Haskellish st a -> Haskellish st b -> Haskellish st (a,b)
functionApplication :: Haskellish st a -> Haskellish st b -> Haskellish st (a, b)
functionApplication Haskellish st a
fP Haskellish st b
xP = (st -> Exp SrcSpanInfo -> Either ParseError ((a, b), st))
-> Haskellish st (a, b)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
fE,Exp SrcSpanInfo
xE) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
applicationExpressions Exp SrcSpanInfo
e
(a
f,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
fP st
st Exp SrcSpanInfo
fE
(b
x,st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
xP st
st' Exp SrcSpanInfo
xE
((a, b), st) -> Either ParseError ((a, b), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
f,b
x),st
st'')
)
enumFromTo :: Haskellish st a -> Haskellish st b -> Haskellish st (a,b)
enumFromTo :: Haskellish st a -> Haskellish st b -> Haskellish st (a, b)
enumFromTo Haskellish st a
aP Haskellish st b
bP = (st -> Exp SrcSpanInfo -> Either ParseError ((a, b), st))
-> Haskellish st (a, b)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
aE,Exp SrcSpanInfo
bE) <- Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
e
(a
a,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
aP st
st Exp SrcSpanInfo
aE
(b
b,st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
bP st
st' Exp SrcSpanInfo
bE
((a, b), st) -> Either ParseError ((a, b), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b),st
st'')
)
where
f :: Exp SrcSpanInfo
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
f (EnumFromTo SrcSpanInfo
_ Exp SrcSpanInfo
aE Exp SrcSpanInfo
bE) = (Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
aE,Exp SrcSpanInfo
bE)
f Exp SrcSpanInfo
e = ParseError -> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected application enumFromTo"
enumFromThenTo :: Haskellish st a -> Haskellish st b -> Haskellish st c -> Haskellish st (a,b,c)
enumFromThenTo :: Haskellish st a
-> Haskellish st b -> Haskellish st c -> Haskellish st (a, b, c)
enumFromThenTo Haskellish st a
aP Haskellish st b
bP Haskellish st c
cP = (st -> Exp SrcSpanInfo -> Either ParseError ((a, b, c), st))
-> Haskellish st (a, b, c)
forall st a.
(st -> Exp SrcSpanInfo -> Either ParseError (a, st))
-> Haskellish st a
Haskellish (\st
st Exp SrcSpanInfo
e -> do
(Exp SrcSpanInfo
aE,Exp SrcSpanInfo
bE,Exp SrcSpanInfo
cE) <- Exp SrcSpanInfo
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
f Exp SrcSpanInfo
e
(a
a,st
st') <- Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st a
aP st
st Exp SrcSpanInfo
aE
(b
b,st
st'') <- Haskellish st b
-> st -> Exp SrcSpanInfo -> Either ParseError (b, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st b
bP st
st' Exp SrcSpanInfo
bE
(c
c,st
st''') <- Haskellish st c
-> st -> Exp SrcSpanInfo -> Either ParseError (c, st)
forall st a.
Haskellish st a
-> st -> Exp SrcSpanInfo -> Either ParseError (a, st)
_run Haskellish st c
cP st
st'' Exp SrcSpanInfo
cE
((a, b, c), st) -> Either ParseError ((a, b, c), st)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,b
b,c
c),st
st''')
)
where
f :: Exp SrcSpanInfo
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
f (EnumFromThenTo SrcSpanInfo
_ Exp SrcSpanInfo
aE Exp SrcSpanInfo
bE Exp SrcSpanInfo
cE) = (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. b -> Either a b
Right (Exp SrcSpanInfo
aE,Exp SrcSpanInfo
bE,Exp SrcSpanInfo
cE)
f Exp SrcSpanInfo
e = ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. a -> Either a b
Left (ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo))
-> ParseError
-> Either
ParseError (Exp SrcSpanInfo, Exp SrcSpanInfo, Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> Text -> ParseError
NonFatal (Exp SrcSpanInfo -> ((Int, Int), (Int, Int))
expToSpan Exp SrcSpanInfo
e) Text
"expected application enumFromThenTo"