ats-format 0.1.0.19 → 0.1.0.20

raw patch · 9 files changed

+53/−84 lines, 9 filesdep +hspec-dirstreamdep −blaze-htmldep −blaze-markupdep −dirstreamPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec-dirstream

Dependencies removed: blaze-html, blaze-markup, dirstream, filepath, hspec-core, pipes, pipes-safe

API changes (from Hackage documentation)

Files

• Justfile +1/−1
• ats-format.cabal +4/−11
• src/Language/ATS.hs +3/−3
• src/Language/ATS/Doc.hs +0/−16
• src/Language/ATS/Parser.y +1/−1
• src/Language/ATS/PrettyPrint.hs +10/−10
• src/Language/ATS/Types.hs +28/−9
• stack.yaml +2/−2
• test/Spec.hs +4/−31

@@ -29,7 +29,7 @@     @poly . -e data/  bench:-    bench "atsfmt test/data/polyglot.dats" "atsfmt test/data/left-pad.dats" "atsfmt ~/programming/ats/toml-parse/src/toml-parse.dats"+    bench "atsfmt test/data/polyglot.dats" "atsfmt test/data/left-pad.dats" "atsfmt ~/programming/ats/toml-parse/src/vml-parse.dats"  manpages:     pandoc man/MANPAGE.md -s -t man -o man/atsfmt.1

@@ -1,14 +1,14 @@ name:                ats-format-version:             0.1.0.19+version:             0.1.0.20 synopsis:            A source-code formatter for ATS-description:         An opinionated source-code formatter for ATS (http://www.ats-lang.org/).+description:         An opinionated source-code formatter for [ATS](http://www.ats-lang.org/). homepage:            https://hub.darcs.net/vmchale/ats-format#readme license:             BSD3 license-file:        LICENSE author:              Vanessa McHale maintainer:          vamchale@gmail.com copyright:           Copyright: (c) 2017 Vanessa McHale-category:            Parser, Language+category:            Parser, Language, ATS, Development build-type:          Custom extra-doc-files:     README.md data-files:          .travis.yml@@ -41,7 +41,6 @@                      , Language.ATS.Parser                      , Language.ATS.PrettyPrint                      , Language.ATS.Exec-                     , Language.ATS.Doc                      , Paths_ats_format   build-depends:       base >= 4.8 && < 5                      , array@@ -56,8 +55,6 @@                      , megaparsec                      , unordered-containers                      , text-                     , blaze-markup-                     , blaze-html                      , directory                      , process                      , file-embed@@ -89,12 +86,8 @@   build-depends:       base                      , ats-format                      , hspec-                     , dirstream-                     , pipes+                     , hspec-dirstream                      , system-filepath-                     , pipes-safe-                     , filepath-                     , hspec-core   if flag(development)     ghc-options:       -Werror   if impl(ghc >= 8.0)

@@ -3,8 +3,6 @@                       lexATS                     , parseATS                     , printATS-                    -- * Documentation generation-                    , generateATSDocs                     -- * Syntax Tree                     , ATS (..)                     , Declaration (..)@@ -32,11 +30,13 @@                     , Keyword (..)                     -- * Error types                     , ATSError+                    -- * Lenses+                    , leaves+                    , constructorUniversals                     -- * Executable                     , exec                     ) where -import           Language.ATS.Doc import           Language.ATS.Exec import           Language.ATS.Lexer import           Language.ATS.Parser

@@ -1,16 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Language.ATS.Doc ( generateATSDocs-                        ) where--import           Language.ATS.Types-import           Text.Blaze.Html5--generateATSDocs :: ATS -> Html-generateATSDocs = toHtml . markupATS--markupATS :: ATS -> Markup-markupATS _ = html $-    body $ do-        p "First paragraph"-        p "Second paragraph"

@@ -464,7 +464,7 @@        | Leaves SumLeaf { $2 : $1 }        | Universals identifierSpace of Type { [Leaf $1 $2 [] (Just $4)] }        | Universals identifier { [Leaf $1 $2 [] Nothing] }-       | Universals identifier openParen IdentifiersIn closeParen OfType { [Leaf $1 $2 $4 $6] }+       | Universals identifier openParen IdentifiersIn closeParen OfType { [Leaf $1 $2 $4 $6] } -- FIXME should take any static expression.        | dollar {% Left $ Expected $1 "|" "$" }  Universals : { [] }

@@ -143,15 +143,15 @@             | otherwise = e <+> pretty op <+> e'         a (IndexF _ n e)                = pretty n <> "[" <> e <> "]"         a (UnaryF Negate e)             = "~" <> e-        a (NamedValF name)              = pretty name-        a (CallF name [] [] Nothing []) = pretty name <> "()"-        a (CallF name [] [] (Just e) xs) = pretty name <> prettyArgsG ("(" <> pretty e <+> "| ") ")" xs -- FIXME split eagerly on "|"-        a (CallF name [] [] Nothing xs) = pretty name <> prettyArgsG "(" ")" xs-        a (CallF name [] us Nothing []) = pretty name <> prettyArgsU "{" "}" us-        a (CallF name is [] Nothing []) = pretty name <> prettyArgsU "<" ">" is-        a (CallF name is [] Nothing [x])-            | startsParens x = pretty name <> prettyArgsU "<" ">" is <> pretty x-        a (CallF name is [] Nothing xs) = pretty name <> prettyArgsU "<" ">" is <> prettyArgsG "(" ")" xs+        a (NamedValF nam)              = pretty nam+        a (CallF nam [] [] Nothing []) = pretty nam <> "()"+        a (CallF nam [] [] (Just e) xs) = pretty nam <> prettyArgsG ("(" <> pretty e <+> "| ") ")" xs -- FIXME split eagerly on "|"+        a (CallF nam [] [] Nothing xs) = pretty nam <> prettyArgsG "(" ")" xs+        a (CallF nam [] us Nothing []) = pretty nam <> prettyArgsU "{" "}" us+        a (CallF nam is [] Nothing []) = pretty nam <> prettyArgsU "<" ">" is+        a (CallF nam is [] Nothing [x])+            | startsParens x = pretty nam <> prettyArgsU "<" ">" is <> pretty x+        a (CallF nam is [] Nothing xs) = pretty nam <> prettyArgsU "<" ">" is <> prettyArgsG "(" ")" xs         a (CaseF _ add e cs)            = "case" <> pretty add <+> e <+> "of" <$> indent 2 (prettyCases cs)         a (VoidLiteralF _)              = "()"         a (RecordValueF _ es Nothing)   = prettyRecord es@@ -294,7 +294,7 @@               go _                = "FIXME"  instance Pretty ATS where-    pretty (ATS xs) = concatSame xs+    pretty (ATS xs) = concatSame (fmap rewriteDecl xs)  instance Pretty Implementation where     pretty (Implement _ [] [] n [] e)  = "implement" <+> pretty n <+> "() =" <$> indent 2 (pretty e)

@@ -38,11 +38,17 @@     , StaticExpression (..)     , StaticExpressionF (..)     , rewriteATS+    , rewriteDecl+    -- * Lenses+    , leaves+    , constructorUniversals     ) where  import           Control.DeepSeq          (NFData)-import           Data.Functor.Foldable    (cata, embed)+import           Control.Lens+import           Data.Functor.Foldable    (ListF (Cons), ana, cata, embed, project) import           Data.Functor.Foldable.TH (makeBaseFunctor)+import           Data.Maybe               (isJust) import           GHC.Generics             (Generic) import           Language.ATS.Lexer       (Addendum (..), AlexPosn) @@ -54,7 +60,7 @@ newtype ATS = ATS { unATS :: [Declaration] }     deriving (Show, Eq, Generic, NFData) -data Leaf = Leaf [Universal] String [String] (Maybe Type)+data Leaf = Leaf { _constructorUniversals :: [Universal], name :: String, constructorArgs :: [String], maybeType :: Maybe Type }     deriving (Show, Eq, Generic, NFData)  -- | Declare something in a scope (a function, value, action, etc.)@@ -73,8 +79,8 @@                  | RecordViewType String [Arg] [Universal] [(String, Type)]                  | TypeDef AlexPosn String [Arg] Type                  | ViewTypeDef AlexPosn String [Arg] Type-                 | SumType String [Arg] [Leaf]-                 | SumViewType String [Arg] [Leaf]+                 | SumType { typeName :: String, typeArgs :: [Arg], _leaves :: [Leaf] }+                 | SumViewType { typeName :: String, typeArgs :: [Arg], _leaves :: [Leaf] }                  | AbsType AlexPosn String [Arg] (Maybe Type)                  | AbsViewType AlexPosn String [Arg] (Maybe Type)                  | AbsView AlexPosn String [Arg] (Maybe Type)@@ -135,13 +141,13 @@           | ViewLiteral Addendum           deriving (Show, Eq, Generic, NFData) --- | A type for the various lambda arrows (`=>`, `=<cloref1>`, etc.)+-- | A type for the various lambda arrows (@=>@, @=<cloref1>@, etc.) data LambdaType = Plain AlexPosn                 | Full AlexPosn String                 | Spear AlexPosn                 deriving (Show, Eq, Generic, NFData) --- | A name can be qualified (`$UN.unsafefn`) or not+-- | A name can be qualified (@$UN.unsafefn@) or not data Name = Unqualified String           | Qualified AlexPosn String String           | SpecialName AlexPosn String@@ -173,14 +179,14 @@     deriving (Show, Eq, Generic, NFData)  -- | Wrapper for universal quantifiers (refinement types)-data Universal = Universal { bound :: [Arg], typeU :: Maybe Type, prop :: Maybe StaticExpression }+data Universal = Universal { bound :: [Arg], typeU :: Maybe Type, prop :: Maybe StaticExpression } -- TODO NonEmpty type?     deriving (Show, Eq, Generic, NFData)  -- | Wrapper for existential quantifiers/types data Existential = Existential { boundE :: [Arg], typeE :: Maybe Type, propE :: Maybe Expression } -- TODO #[id:int] existentials     deriving (Show, Eq, Generic, NFData) --- | `~` is used to negate numbers in ATS+-- | @~@ is used to negate numbers in ATS data UnOp = Negate     deriving (Show, Eq, Generic, NFData) @@ -241,7 +247,7 @@                 | Case { posE :: AlexPosn                        , kind :: Addendum                        , val  :: Expression-                       , arms :: [(Pattern, LambdaType, Expression)] -- ^ Each `(Pattern, Expression)` pair corresponds to a branch of the 'case' statement+                       , arms :: [(Pattern, LambdaType, Expression)] -- ^ Each @(Pattern, Expression)@ pair corresponds to a branch of the 'case' statement                        }                 | RecordValue AlexPosn [(String, Expression)] (Maybe Type)                 | Precede Expression Expression@@ -303,6 +309,19 @@ makeBaseFunctor ''Expression makeBaseFunctor ''StaticExpression makeBaseFunctor ''Type+makeLenses ''Leaf+makeLenses ''Declaration++rewriteDecl :: Declaration -> Declaration+rewriteDecl x@SumViewType{} = g x+    where g = over (leaves.mapped.constructorUniversals) h+          h :: [Universal] -> [Universal]+          h = ana c where+            c (y:y':ys)+                | typeU y == typeU y' && isJust (typeU y) =+                    Cons (Universal (bound y ++ bound y') (typeU y) (StaticBinary LogicalAnd <$> prop y <*> prop y')) ys+            c y = project y+rewriteDecl x = x  -- precedence: rewrite n + 2 * x to n + (2 * x) -- TODO: rewrite multiple universals when it's the right context?

@@ -4,8 +4,8 @@   - '.' extra-deps:   - ansi-wl-pprint-0.6.8.1-  - htoml-megaparsec-1.0.1.11-  - composition-prelude-0.1.1.2+  - htoml-megaparsec-1.0.1.12+  - composition-prelude-0.1.1.4   - dirstream-1.0.3 flags:   ats-format:

@@ -1,41 +1,14 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE OverloadedStrings #-} -import           Data.DirStream import qualified Filesystem.Path.CurrentOS as F import           Language.ATS-import           Pipes-import qualified Pipes.Prelude             as P-import           Pipes.Safe-import           System.FilePath import           Test.Hspec-import           Test.Hspec.Core.Spec--deriving instance MonadCatch (SpecM a)-deriving instance MonadThrow (SpecM a)-deriving instance MonadMask (SpecM a)-deriving instance MonadIO (SpecM a)+import           Test.Hspec.Dirstream  isATS :: F.FilePath -> Bool-isATS x = (F.extension x `elem`) (pure <$> ["ats", "dats", "sats", "hats", "cats"])--testFile :: String -> SpecWith ()-testFile f = it f $ do-    sample <- readFile f-    expected <- readFile (replaceExtension f ".out")-    (fmap printATS . parseATS . lexATS) sample `shouldBe` Right expected+isATS x = (extension x `elem`) (pure <$> ["ats", "dats", "sats", "hats", "cats"])  main :: IO () main = hspec $     describe "pretty-print" $ parallel $-        runSafeT $ runEffect $ atsPath >-> mapS testFile--mapS :: (a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r-mapS = P.mapM_ . (lift .)--atsPath :: MonadSafe m => Producer String m ()-atsPath = every (childOf p) >-> P.filter isATS >-> P.map F.encodeString-    where p = F.decodeString "test/data"+        testFiles "test/data" isATS (fmap printATS . parseATS . lexATS)