From 73e81ce7f4ab35a7e83d7f9b017a985e4d3bd68e Mon Sep 17 00:00:00 2001 From: Julien Moutinho Date: Fri, 12 Jul 2019 21:17:08 +0000 Subject: [PATCH] Update to lastest symantic-document --- symantic-lib/test/HUnit/Foldable.hs | 1 - symantic/Language/Symantic/Typing/Document.hs | 45 +++++++++---------- symantic/Language/Symantic/Typing/Show.hs | 5 +-- symantic/symantic.cabal | 4 +- 4 files changed, 26 insertions(+), 29 deletions(-) diff --git a/symantic-lib/test/HUnit/Foldable.hs b/symantic-lib/test/HUnit/Foldable.hs index b9de41a..2c97213 100644 --- a/symantic-lib/test/HUnit/Foldable.hs +++ b/symantic-lib/test/HUnit/Foldable.hs @@ -2,7 +2,6 @@ module HUnit.Foldable where import Test.Tasty -import Control.Applicative (Applicative) import Data.Either (Either(..)) import Data.Foldable (Foldable) import Data.Int (Int) diff --git a/symantic/Language/Symantic/Typing/Document.hs b/symantic/Language/Symantic/Typing/Document.hs index 468a1fe..76ab450 100644 --- a/symantic/Language/Symantic/Typing/Document.hs +++ b/symantic/Language/Symantic/Typing/Document.hs @@ -11,7 +11,6 @@ import Data.Semigroup (Semigroup(..)) import Data.Set (Set) import Data.Text (Text) import Data.Typeable -import Symantic.Document (DocFrom(..)) import qualified Data.List as L import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -48,8 +47,8 @@ config_Doc_Type = docType :: forall src vs t d. Semigroup d => - DocFrom (Doc.Word Char) d => - DocFrom (Doc.Word Text) d => + Doc.From (Doc.Word Char) d => + Doc.From (Doc.Word Text) d => Doc.Spaceable d => Doc.Colorable16 d => Config_Doc_Type -> @@ -69,7 +68,7 @@ docType conf@Config_Doc_Type{config_Doc_Type_imports=imps} pr ty = let iv = indexVar v in case Map.lookup iv v2n of Nothing -> error "[BUG] docType: variable name missing" - Just n -> docFrom (Doc.Word n) + Just n -> Doc.from (Doc.Word n) -- Const go _v2n _po (TyConst _src _vs c@Const{}) = (if isNameTyOp c then docParen else id) $ @@ -77,7 +76,7 @@ docType conf@Config_Doc_Type{config_Doc_Type_imports=imps} pr ty = -- [] Const go v2n _po (TyApp _ (TyConst _ _ f@Const{}) a) | Just HRefl <- proj_ConstKi @(K []) @[] f = - Doc.between (docFrom (Doc.Word '[')) (docFrom (Doc.Word ']')) $ + Doc.between (Doc.from (Doc.Word '[')) (Doc.from (Doc.Word ']')) $ go v2n (infixB SideL 0, SideL) a -- Infix Const go v2n po (TyApp _ (TyApp _ (TyConst _ _ f@Const{}) a) b) @@ -92,7 +91,7 @@ docType conf@Config_Doc_Type{config_Doc_Type_imports=imps} pr ty = go v2n (op, SideR) b where d_op :: Text -> d - d_op = Doc.yellower . docFrom . Doc.Word + d_op = Doc.yellower . Doc.from . Doc.Word prettyConst :: forall k c. Const src (c::k) -> d prettyConst c | Just HRefl <- proj_ConstKi @(K (#>)) @(#>) c = Doc.space <> d_op "=>" <> Doc.space prettyConst c | Just HRefl <- proj_ConstKi @(K (#)) @(#) c = d_op "," <> Doc.space @@ -176,21 +175,21 @@ poolNames = docTypes :: forall src vs ts d. Semigroup d => - DocFrom (Doc.Word Char) d => - DocFrom (Doc.Word Text) d => + Doc.From (Doc.Word Char) d => + Doc.From (Doc.Word Text) d => Doc.Spaceable d => Doc.Colorable16 d => Config_Doc_Type -> Types src vs ts -> d docTypes conf tys = - d_op (docFrom (Doc.Word '[')) <> go tys <> d_op (docFrom (Doc.Word ']')) + d_op (Doc.from (Doc.Word '[')) <> go tys <> d_op (Doc.from (Doc.Word ']')) where d_op = Doc.yellower go :: forall xs. Types src vs xs -> d go TypesZ = mempty go (TypesS t0 (TypesS t1 ts)) = docType conf 10 t0 <> - d_op (docFrom (Doc.Word ',')) <> Doc.space <> + d_op (Doc.from (Doc.Word ',')) <> Doc.space <> docType conf 10 t1 <> go ts go (TypesS t ts) = docType conf 10 t <> go ts @@ -198,8 +197,8 @@ docTypes conf tys = -- * Document 'Const' docConst :: Monoid d => - DocFrom (Doc.Word Char) d => - DocFrom (Doc.Word Text) d => + Doc.From (Doc.Word Char) d => + Doc.From (Doc.Word Text) d => Imports NameTy -> Const src c -> d docConst imps c@Const{} = docMod docNameTy $ @@ -210,31 +209,31 @@ docConst imps c@Const{} = mn@(m `Mod` n) = nameTyOf c -- * Document 'NameTy' -docNameTy :: DocFrom (Doc.Word Text) d => NameTy -> d -docNameTy (NameTy t) = docFrom (Doc.Word t) +docNameTy :: Doc.From (Doc.Word Text) d => NameTy -> d +docNameTy (NameTy t) = Doc.from (Doc.Word t) -- * Document 'Mod' docMod :: Monoid d => - DocFrom (Doc.Word Char) d => - DocFrom (Doc.Word Text) d => + Doc.From (Doc.Word Char) d => + Doc.From (Doc.Word Text) d => (a -> d) -> Mod a -> d docMod a2d ([] `Mod` a) = a2d a -docMod a2d (m `Mod` a) = docPathMod m <> (docFrom (Doc.Word '.')) <> a2d a +docMod a2d (m `Mod` a) = docPathMod m <> (Doc.from (Doc.Word '.')) <> a2d a -- * Document 'PathMod' docPathMod :: Monoid d => - DocFrom (Doc.Word Char) d => - DocFrom (Doc.Word Text) d => + Doc.From (Doc.Word Char) d => + Doc.From (Doc.Word Text) d => PathMod -> d docPathMod (p::PathMod) = mconcat $ - L.intersperse (docFrom (Doc.Word '.')) $ - (\(NameMod n) -> docFrom (Doc.Word n)) <$> p + L.intersperse (Doc.from (Doc.Word '.')) $ + (\(NameMod n) -> Doc.from (Doc.Word n)) <$> p -docParen :: Doc.Spaceable d => DocFrom (Doc.Word Char) d => d -> d -docParen = Doc.between (docFrom (Doc.Word '(')) (docFrom (Doc.Word ')')) +docParen :: Doc.Spaceable d => Doc.From (Doc.Word Char) d => d -> d +docParen = Doc.between (Doc.from (Doc.Word '(')) (Doc.from (Doc.Word ')')) {- docModules :: diff --git a/symantic/Language/Symantic/Typing/Show.hs b/symantic/Language/Symantic/Typing/Show.hs index 0d60216..d59a152 100644 --- a/symantic/Language/Symantic/Typing/Show.hs +++ b/symantic/Language/Symantic/Typing/Show.hs @@ -11,12 +11,11 @@ import Language.Symantic.Typing.Type import Language.Symantic.Typing.Module import Language.Symantic.Typing.Document -stringDocTerm :: Doc.PlainText (Doc.Plain TLB.Builder) -> String +stringDocTerm :: Doc.Plain TLB.Builder -> String stringDocTerm = TL.unpack . TLB.toLazyText . - Doc.runPlain . - Doc.runPlainText + Doc.runPlain showType :: Config_Doc_Type -> Type src vs t -> String showType conf ty = stringDocTerm $ docType conf 0 ty diff --git a/symantic/symantic.cabal b/symantic/symantic.cabal index efc4198..7b7a716 100644 --- a/symantic/symantic.cabal +++ b/symantic/symantic.cabal @@ -2,7 +2,7 @@ name: symantic -- PVP: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 6.3.3.20190614 +version: 6.3.4.20190712 synopsis: Library for Typed Tagless-Final Higher-Order Composable DSL description: This is an experimental library for composing, parsing, typing, compiling, transforming and interpreting @@ -82,7 +82,7 @@ Library -fhide-source-paths build-depends: symantic-grammar - , symantic-document >= 1.0 + , symantic-document >= 1.5 , base >= 4.6 && < 5 , containers >= 0.5 , mono-traversable >= 1.0 -- 2.42.0