github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00
Code Issues Projects Releases Wiki Activity

Get the ~> all headed in the same direction

Browse Source
This commit is contained in:
Timothy Clem 2018-08-28 09:47:31 -07:00
parent 5da417d01c
commit 16f6728d65
4 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Language/JSON/PrettyPrint.hs
View File

@ -25,7 +25,7 @@ defaultJSONPipeline
-- | Print JSON syntax.
printingJSON :: Monad m => ProcessT m Fragment Fragment
printingJSON = flattened <~ auto step where
printingJSON = auto step ~> flattened where
step :: Fragment -> Seq Fragment
step s@(Defer el cs) =
let ins = insert el cs
@ -58,7 +58,7 @@ defaultBeautyOpts = JSONBeautyOpts 2 False
-- | Produce JSON with configurable whitespace and layout.
beautifyingJSON :: (Member (Exc TranslationError) effs)
=> JSONBeautyOpts -> ProcessT (Eff effs) Fragment Splice
beautifyingJSON _ = flattened <~ autoT (Kleisli step) where
beautifyingJSON _ = autoT (Kleisli step) ~> flattened where
step (Defer el cs) = throwError (NoTranslation el cs)
step (Verbatim txt) = pure $ emit txt
step (New el cs txt) = pure $ case (el, listToMaybe cs) of
@ -72,7 +72,7 @@ beautifyingJSON _ = flattened <~ autoT (Kleisli step) where
-- | Produce whitespace minimal JSON.
minimizingJSON :: (Member (Exc TranslationError) effs)
=> ProcessT (Eff effs) Fragment Splice
minimizingJSON = flattened <~ autoT (Kleisli step) where
minimizingJSON = autoT (Kleisli step) ~> flattened where
step (Defer el cs) = throwError (NoTranslation el cs)
step (Verbatim txt) = pure $ emit txt
step (New _ _ txt) = pure $ emit txt

2
src/Language/Ruby/PrettyPrint.hs
View File

@ -11,7 +11,7 @@ import Data.Reprinting.Token as Token
-- | Print Ruby syntax.
printingRuby :: (Member (Exc TranslationError) effs) => ProcessT (Eff effs) Fragment Splice
printingRuby = flattened <~ autoT (Kleisli step)
printingRuby = autoT (Kleisli step) ~> flattened
step :: (Member (Exc TranslationError) effs) => Fragment -> Eff effs (Seq Splice)
step (Verbatim txt) = pure $ emit txt

2
src/Reprinting/Translate.hs
View File

@ -27,7 +27,7 @@ contextualizing ::
, Member (Exc TranslationError) effs
)
=> ProcessT (Eff effs) Token Fragment
contextualizing = flattened <~ autoT (Kleisli step) where
contextualizing = autoT (Kleisli step) ~> flattened where
step t = case t of
Chunk source -> pure $ copy (Source.toText source)
TElement el -> toFragment el <$> get

6
src/Semantic/Util/Rewriting.hs
View File

@ -125,7 +125,7 @@ addKVPair = repeatedly $ do
testAddKVPair = do
(src, tree) <- testJSONFile
tagged <- runM $ cata (toAlgebra (addKVPair <~ fromMatcher matchHash)) (mark Unmodified tree)
tagged <- runM $ cata (toAlgebra (fromMatcher matchHash ~> addKVPair)) (mark Unmodified tree)
printToTerm $ runReprinter src defaultJSONPipeline tagged
overwriteFloats :: forall effs syntax ann fields term .
@ -143,7 +143,7 @@ overwriteFloats = repeatedly $ do
testOverwriteFloats = do
(src, tree) <- testJSONFile
tagged <- runM $ cata (toAlgebra (overwriteFloats <~ fromMatcher matchFloat)) (mark Unmodified tree)
tagged <- runM $ cata (toAlgebra (fromMatcher matchFloat ~> overwriteFloats)) (mark Unmodified tree)
printToTerm $ runReprinter src defaultJSONPipeline tagged
findKV ::
@ -187,7 +187,7 @@ changeKV = auto $ either id injKV
testChangeKV = do
(src, tree) <- testJSONFile
tagged <- runM $ cata (toAlgebra (changeKV <~ findKV "\"bar\"")) (mark Unmodified tree)
tagged <- runM $ cata (toAlgebra (findKV "\"bar\"" ~> changeKV)) (mark Unmodified tree)
printToTerm $ runReprinter src defaultJSONPipeline tagged
-- Temporary, until new KURE system lands.