haskellish 0.1.2 → 0.2.0

raw patch · 2 files changed

+120/−80 lines, 2 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• Language/Haskellish.hs +118/−79
• haskellish.cabal +2/−1

@@ -1,26 +1,39 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ module Language.Haskellish where -import Language.Haskell.Exts+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)  -data Haskellish a = Haskellish { runHaskellish :: Exp SrcSpanInfo -> Either String a }+data Haskellish st a = Haskellish { runHaskellish :: st -> Exp SrcSpanInfo -> Either String (a,st) } +exp :: Haskellish st (Exp SrcSpanInfo)+exp = Haskellish (\st e -> return (e,st)) -instance Functor Haskellish where-  fmap f x = Haskellish (fmap f . runHaskellish x)+haskellishError :: String -> Haskellish st a+haskellishError x = Haskellish (\_ _ -> Left x) +instance Functor (Haskellish st) where+  fmap f x = Haskellish (\st e -> do+    (x',st') <- runHaskellish x st e+    Right (f x',st')+    ) -instance Applicative Haskellish where-  pure x = Haskellish (const (Right x))-  f <*> x = Haskellish (\e -> do -- ie. in (Either String) monad++instance Applicative (Haskellish st) where+  pure x = Haskellish (\st _ -> Right (x,st))+  f <*> x = Haskellish (\st e -> do     (e1,e2) <- applicationExpressions e-    f' <- runHaskellish f e1-    x' <- runHaskellish x e2-    return (f' x')+    (f',st') <- runHaskellish f st e1+    (x',st'') <- runHaskellish x st' e2+    Right (f' x',st'')     )  @@ -35,92 +48,110 @@ applicationExpressions _ = Left ""  -instance Alternative Haskellish where-  empty = Haskellish (const (Left ""))-  a <|> b = Haskellish (\e -> do-    let a' = runHaskellish a e-    if isRight a' then a' else runHaskellish b e+instance Alternative (Haskellish st) where+  empty = Haskellish (\_ _ -> Left "")+  a <|> b = Haskellish (\st e -> do+    let a' = runHaskellish a st e+    if isRight a' then a' else runHaskellish b st e     )  -instance Monad Haskellish where-  x >>= f = Haskellish (\e -> do-    x' <- runHaskellish x e-    runHaskellish (f x') e+instance Monad (Haskellish st) where+  x >>= f = Haskellish (\st e -> do+    (x',st') <- runHaskellish x st e+    runHaskellish (f x') st' e     ) -instance MonadPlus Haskellish where++instance MonadPlus (Haskellish st) where   mzero = empty   mplus = (<|>)  -identifier :: Haskellish String -- note: we don't distinguish between identifiers and symbols-identifier = Haskellish f-  where f (Paren _ x) = f x-        f (Var _ (UnQual _ (Ident _ x))) = Right x-        f (Var _ (UnQual _ (Symbol _ x))) = Right x-        f _ = Left ""+instance MonadState st (Haskellish st) where+  get = Haskellish (\st e -> return (st,st))+  put st = Haskellish (\_ e -> return ((),st)) -reserved :: String -> Haskellish ()-reserved x = Haskellish (\e -> do -- in (Either String)-   e' <- runHaskellish identifier e-   if e' == x then Right () else Left ""++instance MonadError String (Haskellish st) where+  throwError x = Haskellish (\_ _ -> Left x)+  catchError x f = Haskellish (\st e -> do+    let x' = runHaskellish x st e+    case x' of+      Left err -> runHaskellish (f err) st e+      Right (x'',st') -> Right (x'',st')+    )+++identifier :: Haskellish st String -- note: we don't distinguish between identifiers and symbols+identifier = Haskellish (\st e -> f st e)+  where f st (Paren _ x) = f st x+        f st (Var _ (UnQual _ (Ident _ x))) = Right (x,st)+        f st (Var _ (UnQual _ (Symbol _ x))) = Right (x,st)+        f _ _ = Left ""++reserved :: String -> Haskellish st ()+reserved x = Haskellish (\st e -> do+   (e',_) <- runHaskellish identifier st e+   if e' == x then Right ((),st) else Left ""    ) -string :: Haskellish String-string = Haskellish f-  where f (Paren _ x) = f x-        f (Lit _ (String _ x _)) = Right x-        f _ = Left ""+string :: Haskellish st String+string = Haskellish (\st e -> f st e)+  where f st (Paren _ x) = f st x+        f st (Lit _ (String _ x _)) = Right (x,st)+        f _ _ = Left "" -integer :: Haskellish Integer-integer = Haskellish f-  where f (Paren _ x) = f x-        f (NegApp _ (Lit _ (Int _ x _))) = Right (x * (-1))-        f (Lit _ (Int _ x _)) = Right x-        f _ = Left ""+integer :: Haskellish st Integer+integer = Haskellish (\st e -> f st e)+  where f st (Paren _ x) = f st x+        f st (NegApp _ (Lit _ (Int _ x _))) = Right (x * (-1),st)+        f st (Lit _ (Int _ x _)) = Right (x,st)+        f _ _ = Left "" -rational :: Haskellish Rational-rational = Haskellish f-  where f (Paren _ x) = f x-        f (NegApp _ (Lit _ (Frac _ x _))) = Right (x * (-1))-        f (Lit _ (Frac _ x _)) = Right x-        f _ = Left ""+rational :: Haskellish st Rational+rational = Haskellish (\st e -> f st e)+  where f st (Paren _ x) = f st x+        f st (NegApp _ (Lit _ (Frac _ x _))) = Right (x * (-1),st)+        f st (Lit _ (Frac _ x _)) = Right (x,st)+        f _ _ = Left "" -rationalOrInteger :: Haskellish Rational-rationalOrInteger = Haskellish f-  where f (Paren _ x) = f x-        f (NegApp _ (Lit _ (Frac _ x _))) = Right (x * (-1))-        f (Lit _ (Frac _ x _)) = Right x-        f (NegApp _ (Lit _ (Int _ x _))) = Right (fromIntegral $ x * (-1))-        f (Lit _ (Int _ x _)) = Right $ fromIntegral x-        f _ = Left ""+rationalOrInteger :: Haskellish st Rational+rationalOrInteger = rational <|> fromIntegral <$> integer -list :: Haskellish a -> Haskellish [a]-list p = Haskellish (\e -> f e >>= mapM (runHaskellish p))+list :: Haskellish st a -> Haskellish st [a]+list p = Haskellish (\st e -> do+  xs <- listExpressions e+  foldM f ([],st) xs+  )   where-    f (Paren _ x) = f x-    f (List _ xs) = Right xs-    f _ = Left ""+    f (ys,st) x = do+      (y,st') <- runHaskellish p st x+      return (ys ++ [y],st') -tuple :: Haskellish a -> Haskellish b -> Haskellish (a,b)-tuple p1 p2 = Haskellish (\e -> do+listExpressions :: Exp SrcSpanInfo -> Either String [Exp SrcSpanInfo]+listExpressions (Paren _ x) = listExpressions x+listExpressions (List _ xs) = Right xs+listExpressions _ = Left ""++tuple :: Haskellish st a -> Haskellish st b -> Haskellish st (a,b)+tuple p1 p2 = Haskellish (\st e -> do   (a,b) <- f e-  a' <- runHaskellish p1 a-  b' <- runHaskellish p2 b-  return (a',b')+  (a',st') <- runHaskellish p1 st a+  (b',st'') <- runHaskellish p2 st' b+  return ((a',b'),st'')   )   where     f (Paren _ x) = f x     f (Tuple _ Boxed (a:b:[])) = Right (a,b)     f _ = Left "" -asRightSection :: Haskellish (a -> b -> c) -> Haskellish b -> Haskellish (a -> c)-asRightSection opP bP = Haskellish (\e -> do+asRightSection :: Haskellish st (a -> b -> c) -> Haskellish st b -> Haskellish st (a -> c)+asRightSection opP bP = Haskellish (\st e -> do   (opExp,bExp) <- f e-  op' <- runHaskellish opP opExp-  b <- runHaskellish bP bExp-  return $ flip op' b+  (op',st') <- runHaskellish opP st opExp+  (b,st'') <- runHaskellish bP st' bExp+  return (flip op' b,st'')   )   where     f (Paren _ x) = f x@@ -136,13 +167,21 @@     f _ = Nothing collectDoStatements _ = [] -listOfDoStatements :: Haskellish a -> Haskellish [a]-listOfDoStatements p = Haskellish (\e -> mapM (runHaskellish p) $ collectDoStatements e)+listOfDoStatements :: Haskellish st a -> Haskellish st [a]+listOfDoStatements p = Haskellish (\st e -> do+  let xs = collectDoStatements e+  foldM f ([],st) xs+  )+  where+    f (ys,st) x = do+      (y,st') <- runHaskellish p st x+      return (ys ++ [y],st') + type Span = ((Int,Int),(Int,Int)) -askSpan :: Haskellish Span-askSpan = Haskellish $ return . expToSpan+span :: Haskellish st Span+span = Haskellish (\st e -> return (expToSpan e,st))  expToSpan :: Exp SrcSpanInfo -> Span expToSpan (Var x _) = srcSpanInfoToSpan x@@ -166,10 +205,10 @@     ex = srcSpanEndColumn $ srcInfoSpan x     ey = srcSpanEndLine $ srcInfoSpan x -reverseApplication :: Haskellish a -> Haskellish (a -> b) -> Haskellish b-reverseApplication x f = Haskellish (\e -> do+reverseApplication :: Haskellish st a -> Haskellish st (a -> b) -> Haskellish st b+reverseApplication x f = Haskellish (\st e -> do   (e1,e2) <- applicationExpressions e-  x' <- runHaskellish x e1-  f' <- runHaskellish f e2-  return (f' x')+  (x',st') <- runHaskellish x st e1+  (f',st'') <- runHaskellish f st' e2+  return (f' x',st'')   )

@@ -1,5 +1,5 @@ name:                haskellish-version:             0.1.2+version:             0.2.0 synopsis:            For parsing Haskell-ish languages homepage:            http://github.com/dktr0/Haskellish license:             BSD3@@ -27,6 +27,7 @@   Build-depends:       base >=4.8 && <5     , haskell-src-exts >=1.17.1 && <1.23+    , mtl >= 2.2.2 && <2.3  source-repository head   type:     git