Merge pull request #36 from Tsukuba-Programming-Lab/develop

Release v0.1.0.0

Author: Yuta1004

README.md

@@ -1 +1,40 @@
-# Copager2（仮）
+# Ftpageh
+
+## 記述例（[app/src/Arithmetic.hs](./app/Arithmetic.hs)）
+
+```haskell
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> print sexp
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO ArithmeticToken ArithmeticRule (SExp _ _)
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    consume events
+
+```
+
+## Library
+
+- [Copager2](./lib/copager2/) : Copager2 本体
+- [ErrHandling](./lib/err_handling/) : エラーハンドリング用ライブラリ
+- [Language](./lib/language/) : 言語定義ライブラリ
+
+## Example
+
+### 普通のパーサ
+
+- [lang-arithmetic](./app/lang/src/Arithmetic.hs) : 四則演算
+- [lang-json](./app/lang/src/json.hs) : JSON
+- [lang-pl0](./app/lang/src/Pl0.hs) : Pl/0
+- [lang-xml](./app/lang/src/Xml.hs) : Xml
+
+### エラーハンドリング
+
+- [errh-panicmode](./app/errh/src/PanicMode.hs) : パニックモード
+- [errh-corchuelo](./app/errh/src/Corchuelo.hs) : Corchuelo (※)

app/Main.hs

@@ -0,0 +1,26 @@
+cabal-version:      3.0
+name:               errh
+version:            0.1.0.0
+author:             NakagamiYuta
+maintainer:         guguru0014@gmail.com
+build-type:         Simple
+
+executable errh-panicmode
+    main-is:        PanicMode.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,
+        err-handling,
+
+executable errh-corchuelo
+    main-is:        Corchuelo.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,
+        err-handling,

app/errh/errh.cabal

@@ -0,0 +1,37 @@
+import Prelude hiding (lex)
+
+import Control.Monad.State (lift)
+
+import Ftpageh.Prelude
+import Ftpageh.Core.Process (foldProcess)
+import Ftpageh.Core.Progress (Progress(..))
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse (Event(..))
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.Void (Void, build, feed)
+
+import ErrHandling.Core (recover)
+import ErrHandling.Corchuelo (corchuelo)
+import Language.Arithmetic (ArithmeticToken, ArithmeticRule(..))
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> putStrLn "Accept"
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO ArithmeticToken ArithmeticRule Void
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    foldProcess events $ \event ->
+        case event of
+            Accept -> build
+            Error err -> do
+                lift $ putStrLn $ "recover: " ++ show err
+                recover corchuelo
+            _ -> do
+                feed event
+                return Continue

app/errh/src/Corchuelo.hs

@@ -0,0 +1,37 @@
+import Prelude hiding (lex)
+
+import Control.Monad.State (lift)
+
+import Ftpageh.Prelude
+import Ftpageh.Core.Process (foldProcess)
+import Ftpageh.Core.Progress (Progress(..))
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse (Event(..))
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.Void (Void, build, feed)
+
+import ErrHandling.Core (recover)
+import ErrHandling.PanicMode (panicMode)
+import Language.Arithmetic (ArithmeticToken, ArithmeticRule(..))
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> putStrLn "Accept"
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO ArithmeticToken ArithmeticRule Void
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    foldProcess events $ \event ->
+        case event of
+            Accept -> build
+            Error err -> do
+                lift $ putStrLn $ "recover: " ++ show err
+                recover $ panicMode [Number]
+            _ -> do
+                feed event
+                return Continue

app/errh/src/PanicMode.hs

@@ -0,0 +1,42 @@
+cabal-version:      3.0
+name:               lang
+version:            0.1.0.0
+author:             NakagamiYuta
+maintainer:         guguru0014@gmail.com
+build-type:         Simple
+
+executable lang-arithmetic
+    main-is:        Arithmetic.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,
+
+executable lang-json
+    main-is:        Json.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,
+
+executable lang-pl0
+    main-is:        Pl0.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,
+
+executable lang-xml
+    main-is:        Xml.hs
+    hs-source-dirs: src
+    build-depends:
+        base,
+        mtl,
+        ftpageh,
+        language,

app/lang/lang.cabal

@@ -0,0 +1,25 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+import Prelude hiding (lex)
+
+import Ftpageh.Prelude
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.SExp (SExp, consume)
+
+import Language.Arithmetic (ArithmeticToken, ArithmeticRule)
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> print sexp
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO ArithmeticToken ArithmeticRule (SExp _ _)
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    consume events

app/lang/src/Arithmetic.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+import Prelude hiding (lex)
+
+import Ftpageh.Prelude
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.SExp (SExp, consume)
+
+import Language.Json (JsonToken, JsonRule)
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> print sexp
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO JsonToken JsonRule (SExp _ _)
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    consume events

app/lang/src/Json.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+import Prelude hiding (lex)
+
+import Ftpageh.Prelude
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.SExp (SExp, consume)
+
+import Language.Pl0 (Pl0Token, Pl0Rule)
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> print sexp
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO Pl0Token Pl0Rule (SExp _ _)
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    consume events

app/lang/src/Pl0.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+import Prelude hiding (lex)
+
+import Ftpageh.Prelude
+import Ftpageh.Lex.RegexLex (lex)
+import Ftpageh.Parse.LR.Common.Driver (parse)
+import Ftpageh.IR.SExp (SExp, consume)
+
+import Language.Xml (XmlToken, XmlRule)
+
+main :: IO ()
+main = do
+    input <- getLine
+    result <- runProcessor mkProcessor input
+    case result of
+        Right sexp -> print sexp
+        Left err -> putStrLn $ "error: " ++ show err
+
+mkProcessor :: ProcessorT IO XmlToken XmlRule (SExp _ _)
+mkProcessor = ProcessorT $ do
+    token <- lex
+    events <- parse token
+    consume events