0.1.1.0 release

albertprz · May 25, 2023 · d320cdd · d320cdd
1 parent 05a0402
commit d320cdd
Show file tree

Hide file tree

Showing 10 changed files with 83 additions and 63 deletions.
diff --git a/app/CommandLine/FileIO.hs b/app/CommandLine/FileIO.hs
@@ -4,13 +4,14 @@ import CommandLine.Options (Language (..), Opts (..))
 
 import Lexers.Haskell.Layout (adaptLayout)
 
-import Control.Monad               ((>=>))
+import Control.Monad               ((<=<))
 import Control.Parallel.Strategies (parMap, rseq)
 import Data.List                   (isPrefixOf)
 import Data.Text                   (Text, pack)
 import Data.Text.Encoding          (decodeUtf8, encodeUtf8)
 import Utils.Foldable              (andPred, orPred, wrapMaybe)
 import Utils.Functor               ((<<$>>))
+import Utils.String                (wrapBlock, wrapContext)
 
 
 import System.Directory      (canonicalizePath)
@@ -31,8 +32,8 @@ import Bookhound.Parser (ParseError, runParser)
 import Utils.String     (wrapNewLines)
 
 
-toTargetLanguage :: Language -> Text -> Either ParseError String
-toTargetLanguage language = adaptLayout >=> convert
+toTargetLanguage :: Language -> Text -> Either [ParseError] String
+toTargetLanguage language = convert <=< adaptLayout
   where
     convert = syntaxConverter <<$>> runParser Parser.moduleDef
     syntaxConverter = case language of
@@ -45,7 +46,8 @@ convertDirTree language (File x y)
   | isHaskellFile x = applyTransform y
     where
       applyTransform = either (Failed x . userError . wrapNewLines
-                               . ("  Parse Error: " ++) . show)
+                              . wrapContext . ("Parse Errors: " ++)
+                              . wrapBlock)
                               (File $ pathToLanguage language x)
                        . (pack <$>) . toTargetLanguage language
 
@@ -68,7 +70,7 @@ moveTree _ x                      = x
 
 reportFailure :: DirTree a -> IO ()
 reportFailure (Failed x y) = putStrLn $
-  "Failure when converting file " ++ x ++ ": " ++ show y
+  "\nFailure when converting file " ++ x ++ ": " ++ show y
 reportFailure _ = pure ()
 
 
@@ -121,8 +123,8 @@ formatterExec :: Language -> FilePath
 formatterExec Purescript = "purs-tidy"
 formatterExec Scala      = "scalafmt"
 
-emitError :: ParseError -> IO ()
-emitError = fail . ("\n\n" ++) . take 50 . show
+emitError :: [ParseError] -> IO ()
+emitError = fail . ("\n\nParse Errors: " ++) . wrapBlock
 
 
 dirNamePred :: String -> Bool

diff --git a/app/CommandLine/Process.hs b/app/CommandLine/Process.hs
@@ -44,7 +44,7 @@ process opts@Opts{watchMode, sourcePath, targetPath} homeDir
 
 
 
-action :: (ParseError -> IO ()) -> Opts -> IO ()
+action :: ([ParseError] -> IO ()) -> Opts -> IO ()
 action errorAction Opts{language, sourcePath, targetPath, autoFormat} =
   readFileUtf8 sourcePath
   >>= (pack <<$>>) . traverse format . toTargetLanguage language

diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 name:                polyglot
-version:             0.1.0.0
+version:             0.1.1.0
 github:              "albertprz/polyglot"
 license:             BSD3
 author:              "Alberto Perez Lopez"
@@ -10,16 +10,16 @@ extra-source-files:
 - README.md
 
 # Metadata used when publishing your package
-# synopsis:            Short description of your package
-# category:            Web
+synopsis:            Haskell to Purescript & Scala 3 transpiler
+category:            Compiler
 
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
 description:         Please see the README on GitHub at <https://github.com/albertprz/polyglot#readme>
 
 dependencies:
-- bookhound >= 0.1.11 && < 0.2
+- bookhound >= 0.1.24 && < 0.2
 - optparse-applicative >= 0.17.0 && < 0.18
 - directory-tree >= 0.12.1 && < 0.13
 - fsnotify >= 0.3.0.1 && < 0.4

diff --git a/polyglot.cabal b/polyglot.cabal
@@ -5,8 +5,10 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           polyglot
-version:        0.1.0.0
+version:        0.1.1.0
+synopsis:       Haskell to Purescript & Scala 3 transpiler
 description:    Please see the README on GitHub at <https://github.com/albertprz/polyglot#readme>
+category:       Compiler
 homepage:       https://github.com/albertprz/polyglot#readme
 bug-reports:    https://github.com/albertprz/polyglot/issues
 author:         Alberto Perez Lopez
@@ -112,7 +114,7 @@ library
   ghc-options: -Werror -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
-    , bookhound >=0.1.11 && <0.2
+    , bookhound >=0.1.24 && <0.2
     , bytestring
     , casing >=0.1.4.1 && <0.2
     , containers
@@ -173,7 +175,7 @@ executable polyglot
   ghc-options: -Werror -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
-    , bookhound >=0.1.11 && <0.2
+    , bookhound >=0.1.24 && <0.2
     , bytestring
     , casing >=0.1.4.1 && <0.2
     , containers

diff --git a/src/Lexers/Haskell/Layout.hs b/src/Lexers/Haskell/Layout.hs
@@ -9,7 +9,8 @@ import Utils.String   (joinWords, wrapCurly', wrapDoubleQuotes', wrapParens',
                        wrapQuotes')
 
 
-import Bookhound.Parser            (ParseError, Parser, check, runParser)
+import Bookhound.Parser            (ParseError, Parser, check, runParser,
+                                    withError)
 import Bookhound.ParserCombinators (IsMatch (is, isNot, noneOf, oneOf), (->>-),
                                     (<|>), (|*), (|+), (|?))
 import Bookhound.Parsers.Char      (char, space)
@@ -24,7 +25,7 @@ import Data.Monoid.HT (when)
 import Data.Text      (Text, pack)
 
 
-adaptLayout :: Text -> Either ParseError Text
+adaptLayout :: Text -> Either [ParseError] Text
 adaptLayout str = pack . (++ " }") . unlines . fst4 <$> layoutLines
   where
     layoutLines = foldM layout args . (++ pure "") . filter hasSome =<< input
@@ -33,10 +34,10 @@ adaptLayout str = pack . (++ " }") . unlines . fst4 <$> layoutLines
     fst4 (x, _, _, _) = x
 
 
-layout :: ([String], [Int], Bool, Bool) -> String -> Either ParseError ([String], [Int], Bool, Bool)
+layout :: ([String], [Int], Bool, Bool) -> String -> Either [ParseError] ([String], [Int], Bool, Bool)
 layout (x, y, z, t) str = runParser layoutParser $ pack str
   where
-    layoutParser =
+    layoutParser = withError "Layout lexer" $
       do spaces' <- (space |*)
          beginning <- otherText
          layoutText <- (layoutBegin |?)

diff --git a/src/Parsers/Haskell/ClassDef.hs b/src/Parsers/Haskell/ClassDef.hs
@@ -9,35 +9,38 @@ import Parsers.Haskell.FnDef  (fnDefOrSig, withinContext)
 import Parsers.Haskell.Type   (anyKindedType, classConstraints, type',
                                typeParam)
 
-import Bookhound.Parser            (Parser)
+import Bookhound.Parser            (Parser, withError)
 import Bookhound.ParserCombinators (IsMatch (is), (<|>), (|*), (|+), (|?))
 
 import Data.Foldable               (Foldable (fold))
 import SyntaxTrees.Haskell.DataDef (DerivingStrategy (..))
 
 
 classDef :: Parser ClassDef
-classDef = ClassDef <$> (is "class" *> classConstraints')
-                    <*> class'
-                    <*> (typeParam |*)
-                    <* is "where"
-                    <*> withinContext fnDefOrSig
+classDef = withError "Class declaration" $
+  ClassDef <$> (is "class" *> classConstraints')
+           <*> class'
+           <*> (typeParam |*)
+           <* is "where"
+           <*> withinContext fnDefOrSig
 
 
 instanceDef :: Parser InstanceDef
-instanceDef = InstanceDef <$> (is "instance" *> classConstraints')
-                          <*> class'
-                          <*> (anyKindedType |+)
-                          <* is "where"
-                          <*> withinContext fnDefOrSig
+instanceDef = withError "Instance declaration" $
+  InstanceDef <$> (is "instance" *> classConstraints')
+              <*> class'
+              <*> (anyKindedType |+)
+              <* is "where"
+              <*> withinContext fnDefOrSig
 
 derivingDef :: Parser DerivingDef
-derivingDef = DerivingDef <$> (is "deriving" *>
-                               derivingStrategy <* is "instance")
-                          <*> classConstraints'
-                          <*> class'
-                          <*> (anyKindedType |+)
-                          <*> ((is "via" *> class') |?)
+derivingDef = withError "Standalone deriving declaration" $
+  DerivingDef <$> (is "deriving" *>
+                   derivingStrategy <* is "instance")
+              <*> classConstraints'
+              <*> class'
+              <*> (anyKindedType |+)
+              <*> ((is "via" *> class') |?)
 
 derivingStrategy :: Parser DerivingStrategy
 derivingStrategy = (StandardDeriving <$ is "stock")

diff --git a/src/Parsers/Haskell/DataDef.hs b/src/Parsers/Haskell/DataDef.hs
@@ -8,7 +8,7 @@ import SyntaxTrees.Haskell.DataDef (DataCtorDef (..), DataDef (..),
                                     NewTypeDef (..), TypeDef (..),
                                     UnNamedFieldDef (..))
 
-import Bookhound.Parser              (Parser)
+import Bookhound.Parser              (Parser, withError)
 import Bookhound.ParserCombinators   (IsMatch (..), anySepBy, someSepBy, (<#>),
                                       (<|>), (|*), (|?))
 import Bookhound.Parsers.Char        (colon, comma, equal)
@@ -20,25 +20,29 @@ import Data.Foldable (Foldable (fold))
 
 
 typeDef :: Parser TypeDef
-typeDef = TypeDef <$> ((is "type") *> typeCtor)
-                  <*> (typeParam |*) <* equal
-                  <*> anyKindedType
+typeDef = withError "Type declaration" $
+  TypeDef <$> ((is "type") *> typeCtor)
+          <*> (typeParam |*) <* equal
+          <*> anyKindedType
 
 newtypeDef :: Parser NewTypeDef
-newtypeDef = NewTypeDef <$> (is "newtype" *> typeCtor)
-                        <*> (typeParam |*) <* equal
-                        <*> ctor
-                        <*> fieldDef
-                        <*> (derivingClause |*)
+newtypeDef = withError "Newtype declaration" $
+  NewTypeDef <$> (is "newtype" *> typeCtor)
+             <*> (typeParam |*) <* equal
+             <*> ctor
+             <*> fieldDef
+             <*> (derivingClause |*)
 
 dataDef :: Parser DataDef
-dataDef = DataDef <$> (is "data" *> typeCtor)
-                  <*> (typeParam |*)
-                  <*> (fold <$> alternatives)
-                  <*> (derivingClause |*)
+dataDef = withError "Data declaration" $
+  DataDef <$> (is "data" *> typeCtor)
+          <*> (typeParam |*)
+          <*> (fold <$> alternatives)
+          <*> (derivingClause |*)
   where
     alternatives = ((equal *> someSepBy (is "|") dataCtorDef) |?)
 
+
 namedFieldDef :: Parser NamedFieldDef
 namedFieldDef = NamedFieldDef <$> var <* (colon <#> 2)
                               <*> type'

diff --git a/src/Parsers/Haskell/FnDef.hs b/src/Parsers/Haskell/FnDef.hs
@@ -13,7 +13,7 @@ import SyntaxTrees.Haskell.FnDef (Associativity (LAssoc, RAssoc),
                                   InfixFnAnnotation (InfixFnAnnotation),
                                   MaybeGuardedFnBody (..), PatternGuard (..))
 
-import Bookhound.Parser              (Parser, andThen, check)
+import Bookhound.Parser              (Parser, andThen, check, withError)
 import Bookhound.ParserCombinators   (IsMatch (is), someSepBy, (->>-), (<|>),
                                       (|*), (|+), (|?))
 import Bookhound.Parsers.Char        (comma, dot)
@@ -28,25 +28,29 @@ import Utils.String  (wrapCurly)
 
 
 fnSig :: Parser FnSig
-fnSig = FnSig <$> (var <* is "::")
-              <*> type'
+fnSig = withError "Function signature" $
+  FnSig <$> (var <* is "::")
+        <*> type'
+
 
 fnDef :: Parser FnDef
-fnDef = FnDef <$> (tupleOf var <|> pure <$> var)
-              <*> (pattern' |*)
-              <*> maybeGuardedFnBody (is "=")
+fnDef = withError "Function definition" $
+  FnDef <$> (tupleOf var <|> pure <$> var)
+        <*> (pattern' |*)
+        <*> maybeGuardedFnBody (is "=")
 
 
 infixAnnotation :: Parser InfixFnAnnotation
-infixAnnotation = InfixFnAnnotation
-  <$> token (LAssoc <$ is "infixl" <|> RAssoc <$ is "infixr")
-  <*> token int
-  <*> varOp
+infixAnnotation = withError "Infix annotation" $
+  InfixFnAnnotation <$> token (LAssoc <$ is "infixl" <|>
+                               RAssoc <$ is "infixr")
+                    <*> token int
+                    <*> varOp
 
 
 fnDefOrSig :: Parser FnDefOrSig
-fnDefOrSig = Def <$> fnDef <|>
-             Sig <$> fnSig
+fnDefOrSig =  Def <$> fnDef <|>
+              Sig <$> fnSig
 
 fnBody :: Parser FnBody
 fnBody = topLevelFnApply <|> openForm

diff --git a/src/Parsers/Haskell/ModuleDef.hs b/src/Parsers/Haskell/ModuleDef.hs
@@ -40,7 +40,7 @@ moduleExport = ModuleExport <$> withinParens (anySepBy comma moduleExportDef)
 
 
 moduleExportDef :: Parser ModuleExportDef
-moduleExportDef = ModuleExportDef  <$> importExportDef          <|>
+moduleExportDef = ModuleExportDef  <$> importExportDef <|>
                   FullModuleExport <$> (is "module" *> module')
 
 moduleImport :: Parser ModuleImport

diff --git a/stack.yaml b/stack.yaml
@@ -5,7 +5,10 @@ resolver:
 
 extra-deps:
 
-- bookhound-0.1.13.0
+# Own
+- bookhound-0.1.24.0
+
+# General
 - optparse-applicative-0.17.0.0
 - directory-tree-0.12.1
 - fsnotify-0.3.0.1
@@ -15,6 +18,7 @@ extra-deps:
 - casing-0.1.4.1
 - text-2.0
 
+# Utils
 - extra-1.7.10
 - utility-ht-0.0.16