module Curry.Base.LexComb
(
Symbol (..), Indent, Context, P, CYM, SuccessP, FailP, Lexer
, parse, applyLexer, returnP, thenP, thenP_, failP, warnP
, liftP, closeP0, closeP1
, pushContext, popContext
, convertSignedIntegral, convertSignedFloating
, convertIntegral, convertFloating
) where
import Data.Char (digitToInt)
import Curry.Base.Monad (CYM, failMessageAt, warnMessageAt)
import Curry.Base.Span ( Distance, Span (..), startCol, fstSpan
, setDistance)
infixl 1 `thenP`, `thenP_`
class (Ord s, Show s) => Symbol s where
isEOF :: s -> Bool
dist :: Int -> s -> Distance
type Indent = Int
type Context = [Indent]
type P a = Span
-> String
-> Bool
-> Context
-> CYM a
parse :: P a -> FilePath -> String -> CYM a
parse :: P a -> FilePath -> FilePath -> CYM a
parse p :: P a
p fn :: FilePath
fn s :: FilePath
s = P a
p (FilePath -> Span
fstSpan FilePath
fn) FilePath
s Bool
True []
type SuccessP s a = Span -> s -> P a
type FailP a = Span -> String -> P a
type Lexer s a = SuccessP s a -> FailP a -> P a
applyLexer :: Symbol s => Lexer s [(Span, s)] -> P [(Span, s)]
applyLexer :: Lexer s [(Span, s)] -> P [(Span, s)]
applyLexer lexer :: Lexer s [(Span, s)]
lexer = Lexer s [(Span, s)]
lexer SuccessP s [(Span, s)]
successP Span -> FilePath -> P [(Span, s)]
forall a. Span -> FilePath -> P a
failP
where successP :: SuccessP s [(Span, s)]
successP sp :: Span
sp t :: s
t | s -> Bool
forall s. Symbol s => s -> Bool
isEOF s
t = [(Span, s)] -> P [(Span, s)]
forall a. a -> P a
returnP [(Span
sp', s
t)]
| Bool
otherwise = ((Span
sp', s
t) (Span, s) -> [(Span, s)] -> [(Span, s)]
forall a. a -> [a] -> [a]
:) ([(Span, s)] -> [(Span, s)]) -> P [(Span, s)] -> P [(Span, s)]
forall a b. (a -> b) -> P a -> P b
`liftP` Lexer s [(Span, s)]
lexer SuccessP s [(Span, s)]
successP Span -> FilePath -> P [(Span, s)]
forall a. Span -> FilePath -> P a
failP
where sp' :: Span
sp' = Span -> Distance -> Span
setDistance Span
sp (Int -> s -> Distance
forall s. Symbol s => Int -> s -> Distance
dist (Span -> Int
startCol Span
sp) s
t)
returnP :: a -> P a
returnP :: a -> P a
returnP x :: a
x _ _ _ _ = a -> WriterT [Message] (ExceptT [Message] Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
thenP :: P a -> (a -> P b) -> P b
thenP :: P a -> (a -> P b) -> P b
thenP lexer :: P a
lexer k :: a -> P b
k sp :: Span
sp s :: FilePath
s bol :: Bool
bol ctxt :: Context
ctxt
= P a
lexer Span
sp FilePath
s Bool
bol Context
ctxt WriterT [Message] (ExceptT [Message] Identity) a
-> (a -> WriterT [Message] (ExceptT [Message] Identity) b)
-> WriterT [Message] (ExceptT [Message] Identity) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: a
x -> a -> P b
k a
x Span
sp FilePath
s Bool
bol Context
ctxt
thenP_ :: P a -> P b -> P b
p1 :: P a
p1 thenP_ :: P a -> P b -> P b
`thenP_` p2 :: P b
p2 = P a
p1 P a -> (a -> P b) -> P b
forall a b. P a -> (a -> P b) -> P b
`thenP` P b -> a -> P b
forall a b. a -> b -> a
const P b
p2
failP :: Span -> String -> P a
failP :: Span -> FilePath -> P a
failP sp :: Span
sp msg :: FilePath
msg _ _ _ _ = Span -> FilePath -> CYT Identity a
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt Span
sp FilePath
msg
warnP :: Span -> String -> P a -> P a
warnP :: Span -> FilePath -> P a -> P a
warnP warnSpan :: Span
warnSpan msg :: FilePath
msg lexer :: P a
lexer sp :: Span
sp s :: FilePath
s bol :: Bool
bol ctxt :: Context
ctxt
= Span -> FilePath -> CYT Identity ()
forall (m :: * -> *). Monad m => Span -> FilePath -> CYT m ()
warnMessageAt Span
warnSpan FilePath
msg CYT Identity ()
-> WriterT [Message] (ExceptT [Message] Identity) a
-> WriterT [Message] (ExceptT [Message] Identity) a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P a
lexer Span
sp FilePath
s Bool
bol Context
ctxt
liftP :: (a -> b) -> P a -> P b
liftP :: (a -> b) -> P a -> P b
liftP f :: a -> b
f p :: P a
p = P a
p P a -> (a -> P b) -> P b
forall a b. P a -> (a -> P b) -> P b
`thenP` b -> P b
forall a. a -> P a
returnP (b -> P b) -> (a -> b) -> a -> P b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
closeP0 :: P a -> P (P a)
closeP0 :: P a -> P (P a)
closeP0 lexer :: P a
lexer sp :: Span
sp s :: FilePath
s bol :: Bool
bol ctxt :: Context
ctxt = P a -> WriterT [Message] (ExceptT [Message] Identity) (P a)
forall (m :: * -> *) a. Monad m => a -> m a
return (\_ _ _ _ -> P a
lexer Span
sp FilePath
s Bool
bol Context
ctxt)
closeP1 :: (a -> P b) -> P (a -> P b)
closeP1 :: (a -> P b) -> P (a -> P b)
closeP1 f :: a -> P b
f sp :: Span
sp s :: FilePath
s bol :: Bool
bol ctxt :: Context
ctxt = (a -> P b)
-> WriterT [Message] (ExceptT [Message] Identity) (a -> P b)
forall (m :: * -> *) a. Monad m => a -> m a
return (\x :: a
x _ _ _ _ -> a -> P b
f a
x Span
sp FilePath
s Bool
bol Context
ctxt)
pushContext :: Indent -> P a -> P a
pushContext :: Int -> P a -> P a
pushContext col :: Int
col cont :: P a
cont sp :: Span
sp s :: FilePath
s bol :: Bool
bol ctxt :: Context
ctxt = P a
cont Span
sp FilePath
s Bool
bol (Int
col Int -> Context -> Context
forall a. a -> [a] -> [a]
: Context
ctxt)
popContext :: P a -> P a
popContext :: P a -> P a
popContext cont :: P a
cont sp :: Span
sp s :: FilePath
s bol :: Bool
bol (_ : ctxt :: Context
ctxt) = P a
cont Span
sp FilePath
s Bool
bol Context
ctxt
popContext _ sp :: Span
sp _ _ [] = Span -> FilePath -> CYT Identity a
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt Span
sp (FilePath -> CYT Identity a) -> FilePath -> CYT Identity a
forall a b. (a -> b) -> a -> b
$
"Parse error: popping layout from empty context stack. " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
"Perhaps you have inserted too many '}'?"
convertSignedIntegral :: Num a => a -> String -> a
convertSignedIntegral :: a -> FilePath -> a
convertSignedIntegral b :: a
b ('+':s :: FilePath
s) = a -> FilePath -> a
forall a. Num a => a -> FilePath -> a
convertIntegral a
b FilePath
s
convertSignedIntegral b :: a
b ('-':s :: FilePath
s) = - a -> FilePath -> a
forall a. Num a => a -> FilePath -> a
convertIntegral a
b FilePath
s
convertSignedIntegral b :: a
b s :: FilePath
s = a -> FilePath -> a
forall a. Num a => a -> FilePath -> a
convertIntegral a
b FilePath
s
convertIntegral :: Num a => a -> String -> a
convertIntegral :: a -> FilePath -> a
convertIntegral b :: a
b = (a -> Char -> a) -> a -> FilePath -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> Char -> a
op 0
where m :: a
m op :: a -> Char -> a
`op` n :: Char
n = a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
m a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
n)
convertSignedFloating :: Fractional a => String -> String -> Int -> a
convertSignedFloating :: FilePath -> FilePath -> Int -> a
convertSignedFloating ('+':m :: FilePath
m) f :: FilePath
f e :: Int
e = FilePath -> FilePath -> Int -> a
forall a. Fractional a => FilePath -> FilePath -> Int -> a
convertFloating FilePath
m FilePath
f Int
e
convertSignedFloating ('-':m :: FilePath
m) f :: FilePath
f e :: Int
e = - FilePath -> FilePath -> Int -> a
forall a. Fractional a => FilePath -> FilePath -> Int -> a
convertFloating FilePath
m FilePath
f Int
e
convertSignedFloating m :: FilePath
m f :: FilePath
f e :: Int
e = FilePath -> FilePath -> Int -> a
forall a. Fractional a => FilePath -> FilePath -> Int -> a
convertFloating FilePath
m FilePath
f Int
e
convertFloating :: Fractional a => String -> String -> Int -> a
convertFloating :: FilePath -> FilePath -> Int -> a
convertFloating m :: FilePath
m f :: FilePath
f e :: Int
e
| Int
e' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = a
m'
| Int
e' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a
m' a -> a -> a
forall a. Num a => a -> a -> a
* 10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e'
| Bool
otherwise = a
m' a -> a -> a
forall a. Fractional a => a -> a -> a
/ 10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (- Int
e')
where m' :: a
m' = a -> FilePath -> a
forall a. Num a => a -> FilePath -> a
convertIntegral 10 (FilePath
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f)
e' :: Int
e' = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f