elm-syntax 0.2.0.0 → 0.3.0.0

raw patch · 10 files changed

+224/−93 lines, 10 filesdep +hashabledep −protoludedep ~deriving-compatPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependencies removed: protolude

Dependency ranges changed: deriving-compat

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +1/−1
• elm-syntax.cabal +7/−6
• src/Language/Elm/Definition.hs +16/−13
• src/Language/Elm/Expression.hs +55/−16
• src/Language/Elm/Name.hs +36/−23
• src/Language/Elm/Pattern.hs +1/−2
• src/Language/Elm/Pretty.hs +46/−19
• src/Language/Elm/Simplification.hs +20/−6
• src/Language/Elm/Type.hs +31/−7

@@ -2,6 +2,17 @@  ## Unreleased changes +## 0.3.0.0++- Add support for parameterised types+- Handle Basics.() in isConstructor check+- Simplify case-of-case expressions++## 0.2.0.0++- Add simplification module with some useful optimisations++ ## 0.1.0.0  - Initial release

@@ -1,4 +1,4 @@-# elm-syntax [![Hackage](https://img.shields.io/hackage/v/elm-syntax.svg)](https://hackage.haskell.org/package/elm-syntax)+# elm-syntax [![Build Status](https://travis-ci.com/folq/elm-syntax.svg?branch=master)](https://travis-ci.com/folq/elm-syntax) [![Hackage](https://img.shields.io/hackage/v/elm-syntax.svg)](https://hackage.haskell.org/package/elm-syntax)  A library for generating Elm syntax from Haskell in a scope-safe way. 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3062daa5e99746ac78a65379398eeb1af44d09e10354ae4f3aaae3c1885431ef+-- hash: 7a5a97356a0303c135c29af83618eccb2a2d5844234020ab4cd4f38ee561609d  name:           elm-syntax-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Elm syntax and pretty-printing description:    Please see the README on GitHub at <https://github.com/folq/elm-syntax#readme> category:       Elm, Compiler, Language@@ -18,6 +18,7 @@ copyright:      2019 Olle Fredriksson license:        BSD3 license-file:   LICENSE+tested-with:    GHC == 8.4.3, GHC == 8.6.5, GHC == 8.8.3 build-type:     Simple extra-source-files:     README.md@@ -44,9 +45,9 @@   build-depends:       base >=4.7 && <5     , bound >=2.0.0-    , deriving-compat >=0.5+    , deriving-compat >=0.5.0+    , hashable >=1.2.5     , prettyprinter >=1.2.1-    , protolude >=0.2.3     , text >=1.2.0     , unordered-containers >=0.2.8   default-language: Haskell2010@@ -62,10 +63,10 @@   build-depends:       base >=4.7 && <5     , bound >=2.0.0-    , deriving-compat >=0.5+    , deriving-compat >=0.5.0     , elm-syntax+    , hashable >=1.2.5     , prettyprinter >=1.2.1-    , protolude >=0.2.3     , text >=1.2.0     , unordered-containers >=0.2.8   default-language: Haskell2010

@@ -1,7 +1,10 @@ module Language.Elm.Definition where -import Protolude hiding (Type)+import Data.Void +import Bound (Scope)+import qualified Bound+ import Language.Elm.Expression (Expression) import qualified Language.Elm.Expression as Expression import qualified Language.Elm.Name as Name@@ -9,15 +12,15 @@ import qualified Language.Elm.Type as Type  data Definition-  = Constant !Name.Qualified (Type Void) (Expression Void)-  | Type !Name.Qualified [(Name.Constructor, [Type Void])]-  | Alias !Name.Qualified (Type Void)+  = Constant !Name.Qualified !Int (Scope Int Type Void) (Expression Void)+  | Type !Name.Qualified !Int [(Name.Constructor, [Scope Int Type Void])]+  | Alias !Name.Qualified !Int (Scope Int Type Void)   deriving (Eq, Ord, Show)  name :: Definition -> Name.Qualified-name (Constant n _ _) = n-name (Type n _) = n-name (Alias n _) = n+name (Constant n _ _ _) = n+name (Type n _ _) = n+name (Alias n _ _) = n  foldMapGlobals   :: Monoid m@@ -26,15 +29,15 @@   -> m foldMapGlobals f def =   case def of-    Constant qname type_ expr ->+    Constant qname _ type_ expr ->       f qname <>-      Type.foldMapGlobals f type_ <>+      Type.foldMapGlobals f (Bound.fromScope type_) <>       Expression.foldMapGlobals f expr -    Type qname constrs ->+    Type qname _ constrs ->       f qname <>-      foldMap (foldMap (foldMap (Type.foldMapGlobals f))) constrs+      foldMap (foldMap (foldMap (Type.foldMapGlobals f . Bound.fromScope))) constrs -    Alias qname type_ ->+    Alias qname _ type_ ->       f qname <>-      Type.foldMapGlobals f type_+      Type.foldMapGlobals f (Bound.fromScope type_)

@@ -4,18 +4,20 @@ {-# language DeriveGeneric #-} {-# language DeriveTraversable #-} {-# language OverloadedStrings #-}+{-# language ScopedTypeVariables #-} {-# language StandaloneDeriving #-} {-# language TemplateHaskell #-} module Language.Elm.Expression where -import Protolude- import Bound import Bound.Var (unvar)+import Control.Monad import Data.Bifoldable+import Data.Bifunctor import Data.Eq.Deriving import Data.Ord.Deriving import Data.String+import Data.Text (Text) import Text.Show.Deriving  import qualified Language.Elm.Name as Name@@ -42,19 +44,56 @@   (<*>) = ap  instance Monad Expression where-  Var v >>= f = f v-  Global g >>= _ = Global g-  App e1 e2 >>= f = App (e1 >>= f) (e2 >>= f)-  Let e s >>= f = Let (e >>= f) (s >>>= f)-  Lam s >>= f = Lam (s >>>= f)-  Record fs >>= f = Record [(fname, e >>= f) | (fname, e) <- fs]-  Proj f >>= _ = Proj f-  Case e brs >>= f = Case (e >>= f) [(pat, s >>>= f) | (pat, s) <- brs]-  List es >>= f = List ((>>= f) <$> es)-  String s >>= _ = String s-  Int n >>= _ = Int n-  Float f >>= _ = Float f+  (>>=) =+    flip $ bind Global +bind :: forall v v'. (Name.Qualified -> Expression v') -> (v -> Expression v') -> Expression v -> Expression v'+bind global var expression =+  case expression of+    Var v ->+      var v++    Global g ->+      global g++    App t1 t2 ->+      App (bind global var t1) (bind global var t2)++    Let e s ->+      Let (bind global var e) (bindScope s)++    Lam s ->+      Lam (bindScope s)++    Record fields ->+      Record $ second (bind global var) <$> fields++    Proj fname ->+      Proj fname++    Case scrutinee branches ->+      Case+        (bind global var scrutinee)+        (second bindScope <$> branches)++    List es ->+      List $ bind global var <$> es++    String s ->+      String s++    Int i ->+      Int i++    Float f ->+      Float f+  where+    bindScope :: Scope b Expression v -> Scope b Expression v'+    bindScope =+      toScope .+      bind (fmap F . global) (unvar (pure . B) (fmap F . var)) .+      fromScope+ deriving instance Eq v => Eq (Expression v) deriving instance Ord v => Ord (Expression v) deriving instance Show v => Show (Expression v)@@ -107,7 +146,7 @@  lets :: Eq b => [(b, Expression v)] -> Scope b Expression v -> Expression v lets =-  go (panic "Language.Elm.Expression.lets unbound var") identity+  go (error "Language.Elm.Expression.lets unbound var") id   where     go :: Eq b => (b -> v') -> (v -> v') -> [(b, Expression v)] -> Scope b Expression v -> Expression v'     go boundVar freeVar bindings scope =@@ -155,7 +194,7 @@     Case e branches ->       foldMapGlobals f e <>       foldMap-        (bifoldMap (Pattern.foldMapGlobals f) (foldMapGlobals f . Bound.fromScope))+        (bifoldMap (Pattern.foldMapGlobals f) (foldMapGlobals f .Bound.fromScope))         branches      List es ->

@@ -1,28 +1,40 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}+{-# language DeriveAnyClass #-}+{-# language DeriveGeneric #-}+{-# language DerivingStrategies #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language OverloadedStrings #-}+{-# language ViewPatterns #-} module Language.Elm.Name where -import Protolude--import Data.String+import Data.Bifunctor import qualified Data.Char as Char+import Data.Hashable+import Data.String+import Data.Text (Text) import qualified Data.Text as Text+import GHC.Generics (Generic)  type Module = [Text]  newtype Local = Local Text   deriving stock (Eq, Ord, Show, Generic)-  deriving newtype IsString+  deriving newtype (IsString)   deriving anyclass (Hashable)  data Qualified = Qualified Module Text-  deriving (Eq, Ord, Show, Generic, Hashable)+  deriving (Eq, Ord, Show, Generic)+  deriving anyclass (Hashable) +newtype Field = Field Text+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)+  deriving anyclass (Hashable)++newtype Constructor = Constructor Text+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)+  deriving anyclass (Hashable)+ isConstructor :: Qualified -> Bool isConstructor name =   case name of@@ -32,6 +44,9 @@     "Basics.," ->       True +    "Basics.()" ->+      True+     Qualified _ (Text.uncons -> Just (firstChar, _)) ->       Char.isUpper firstChar @@ -42,20 +57,18 @@   fromString s =     case unsnoc $ Text.splitOn "." $ fromString s of       Nothing ->-        panic "Empty name"+        error "Empty name"        Just ([], x) ->-        panic $ "Unqualified name " <> show x+        error $ "Unqualified name " <> show x        Just (xs, x) ->         Qualified xs x--newtype Field = Field Text-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype IsString-  deriving anyclass (Hashable)+    where+      unsnoc :: [a] -> Maybe ([a], a)+      unsnoc [] = Nothing+      unsnoc (a:as) = Just $ go a as -newtype Constructor = Constructor Text-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype IsString-  deriving anyclass (Hashable)+      go :: a -> [a] -> ([a], a)+      go a [] = ([], a)+      go a (a':as) = first (a:) $ go a' as

@@ -1,11 +1,10 @@ {-# language DeriveFoldable #-} {-# language DeriveFunctor #-} {-# language DeriveTraversable #-}-{-# language NoImplicitPrelude #-} {-# language OverloadedStrings #-} module Language.Elm.Pattern where -import Protolude+import Data.Text (Text)  import qualified Language.Elm.Name as Name 

@@ -1,4 +1,3 @@-{-# language NoImplicitPrelude #-} {-# language OverloadedStrings #-} {-# language ViewPatterns #-} module Language.Elm.Pretty@@ -26,16 +25,18 @@   , type_   ) where -import Protolude hiding (Type, local, list, moduleName)- import qualified Bound import qualified Bound.Var as Bound+import Data.Foldable import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet+import Data.List (sort, intersperse)+import Data.Maybe (isNothing) import Data.String import Data.Text.Prettyprint.Doc+import Data.Void  import Language.Elm.Definition (Definition) import qualified Language.Elm.Definition as Definition@@ -133,7 +134,7 @@ extend env =   case freshLocals env of     [] ->-      panic "Language.Elm.Pretty no locals"+      error "Language.Elm.Pretty no locals"      fresh:freshLocals' ->       ( env@@ -151,7 +152,12 @@      occurrences =       HashSet.toList occurrencesSet+  in+  extendMany env occurrences +extendMany :: Environment v -> [Int] -> Environment (Bound.Var Int v)+extendMany env occurrences =+  let     bindings =       HashMap.fromList $         zip occurrences $ freshLocals env@@ -162,7 +168,7 @@     lookupVar i =       case HashMap.lookup i bindings of         Nothing ->-          panic "Unbound pattern variable"+          error "Language.Elm.Pretty unbound pattern variable"          Just v ->           v@@ -365,11 +371,18 @@ definition :: Environment Void -> Definition -> Doc ann definition env def =   case def of-    Definition.Constant (Name.Qualified _ name) t e ->+    Definition.Constant (Name.Qualified _ name) numTypeParams t e ->       let-        (names, body) = lambdas env e+        typeParams =+          [0..numTypeParams - 1]++        typeEnv =+          extendMany env typeParams++        (names, body) =+          lambdas env e       in-      pretty name <+> ":" <+> nest 4 (type_ env 0 t) <> line <>+      pretty name <+> ":" <+> nest 4 (type_ typeEnv 0 $ Bound.fromScope t) <> line <>       (case names of         [] ->           pretty name <+> "="@@ -378,17 +391,31 @@           pretty name <+> hsep (local <$> names) <+> "=") <>       line <> indent 4 body -    Definition.Type (Name.Qualified _ name) constrs ->-      "type" <+> pretty name <> line <>+    Definition.Type (Name.Qualified _ name) numParams constrs ->+      let+        params =+          [0..numParams - 1]++        env' =+          extendMany env params+      in+      "type" <+> pretty name <+> hsep (local . locals env' . Bound.B <$> params) <> line <>         indent 4 ("=" <+>           mconcat             (intersperse (line <> "| ")-              [constructor c <+> hsep (type_ env (appPrec + 1) <$> ts) | (c, ts) <- constrs]))+              [constructor c <+> hsep (type_ env' (appPrec + 1) . Bound.fromScope <$> ts) | (c, ts) <- constrs])) -    Definition.Alias (Name.Qualified _ name) t ->-      "type alias" <+> pretty name <+> "=" <> line <>-      indent 4 (type_ env 0 t)+    Definition.Alias (Name.Qualified _ name) numParams t ->+      let+        params =+          [0..numParams - 1] +        env' =+          extendMany env params+      in+      "type alias" <+> pretty name <+> hsep (local . locals env' . Bound.B <$> params) <+> "=" <> line <>+      indent 4 (type_ env' 0 $ Bound.fromScope t)+ ------------------------------------------------------------------------------- -- * Expressions @@ -424,10 +451,10 @@       apps (expression env) prec fun args      Expression.Global _ ->-      panic "Language.Elm.Pretty expression Global"+      error "Language.Elm.Pretty expression Global"      Expression.App {} ->-      panic "Language.Elm.Pretty expression App"+      error "Language.Elm.Pretty expression App"      Expression.Let {} ->       parensWhen (prec > letPrec) $@@ -612,10 +639,10 @@       apps (type_ env) prec fun args      Type.Global _ ->-      panic "Language.Elm.Pretty type_ Global"+      error "Language.Elm.Pretty type_ Global"      Type.App {} ->-      panic "Language.Elm.Pretty type_ App"+      error "Language.Elm.Pretty type_ App"      Type.Fun t1 t2 ->       parensWhen (prec > funPrec) $@@ -656,7 +683,7 @@     parens    else-    identity+    id  appPrec, letPrec, lamPrec, casePrec, ifPrec, funPrec, projPrec :: Int appPrec = 10

@@ -8,6 +8,7 @@ import Bound import qualified Bound.Scope as Scope import Bound.Var (unvar)+import Data.Bifunctor import Data.Foldable (fold) import Data.Text (Text) import qualified Data.Text as Text@@ -27,8 +28,8 @@   -> Definition simplifyDefinition def =   case def of-    Definition.Constant name type_ expr ->-      Definition.Constant name type_ $ simplifyExpression expr+    Definition.Constant name numTypeParams type_ expr ->+      Definition.Constant name numTypeParams type_ $ simplifyExpression expr      Definition.Type {} ->       def@@ -50,8 +51,8 @@ -- * @x :: [y, z, ...] = [x, y, z, ...]@ -- * Calls to @String.join@, @String.concat@, @List.concat@, and @++@ with --   known arguments are simplified. For example,--- --   @String.join "/" [Config.api, "endpoint"] = Config.api ++ "/endpoint"@+-- * @(\x. e x) = e@ -- * Inline @x@ in @e'@ in --   @ --   let x = e in e'@@ -67,6 +68,7 @@ --   @ --   is simplified to @let xs = es in branch@ provided that @e@ matches none of --   @prefixBranches@ and that it matches @pat@.+-- * case-of-case -- simplifyExpression   :: Expression v@@ -171,9 +173,21 @@       in         case findMatchingBranch scrutinee' branches of           Nothing ->-            Expression.apps-              (Expression.Case scrutinee' $ fmap simplifyScope <$> branches)-              args+            case scrutinee' of+              Expression.Case innerScrutinee innerBranches ->+                simplifyApplication+                  (Expression.Case+                    innerScrutinee+                    [ (pat, toScope $ Expression.Case (fromScope branch) (second (fmap F) <$> branches))+                    | (pat, branch) <- innerBranches+                    ]+                  )+                  args++              _ ->+                Expression.apps+                  (Expression.Case scrutinee' $ fmap simplifyScope <$> branches)+                  args            Just expr' ->             simplifyApplication expr' args

@@ -2,11 +2,16 @@ {-# language DeriveFunctor #-} {-# language DeriveTraversable #-} {-# language OverloadedStrings #-}+{-# language TemplateHaskell #-} module Language.Elm.Type where -import Protolude hiding (Type)-+import Control.Monad+import Data.Bifunctor+import Data.Eq.Deriving (deriveEq1)+import Data.Foldable+import Data.Ord.Deriving (deriveOrd1) import Data.String+import Text.Show.Deriving (deriveShow1)  import qualified Language.Elm.Name as Name @@ -18,16 +23,35 @@   | Record [(Name.Field, Type v)]   deriving (Eq, Ord, Show, Functor, Foldable, Traversable) +deriveEq1 ''Type+deriveOrd1 ''Type+deriveShow1 ''Type+ instance Applicative Type where   pure = Var   (<*>) = ap  instance Monad Type where-  Var v >>= f = f v-  Global g >>= _ = Global g-  App t1 t2 >>= f = App (t1 >>= f) (t2 >>= f)-  Fun t1 t2 >>= f = Fun (t1 >>= f) (t2 >>= f)-  Record fields >>= f = Record [(n, t >>= f) | (n, t) <- fields]+  (>>=) =+    flip $ bind Global++bind :: (Name.Qualified -> Type v') -> (v -> Type v') -> Type v -> Type v'+bind global var type_ =+  case type_ of+    Var v ->+      var v++    Global g ->+      global g++    App t1 t2 ->+      App (bind global var t1) (bind global var t2)++    Fun t1 t2 ->+      Fun (bind global var t1) (bind global var t2)++    Record fields ->+      Record $ second (bind global var) <$> fields  instance IsString (Type v) where   fromString = Global . fromString