From 240ed648841c3ff91b845c6ce1c28926d1498984 Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Thu, 12 Jan 2023 18:59:48 +0000
Subject: [PATCH 1/6] Support pretty JSON output in compiler

---
 internal/Main.hs                   |  5 +--
 lib/Intlc/Backend/JSON/Compiler.hs | 53 ++++++++++++++++++++++--------
 lib/Intlc/Compiler.hs              |  2 +-
 3 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/internal/Main.hs b/internal/Main.hs
index c4f3e4c..cb5d122 100644
--- a/internal/Main.hs
+++ b/internal/Main.hs
@@ -3,7 +3,7 @@ module Main where
 import           CLI                         (Opts (..), getOpts)
 import qualified Data.Text                   as T
 import           Data.Text.IO                (getContents)
-import           Intlc.Backend.JSON.Compiler (compileDataset)
+import qualified Intlc.Backend.JSON.Compiler as JSON
 import           Intlc.Compiler              (expandPlurals)
 import           Intlc.Core
 import           Intlc.ICU                   (AnnNode, Message, Node)
@@ -24,7 +24,8 @@ lint path = do
   whenJust (lintDatasetInternal path raw dataset) $ die . T.unpack
 
 compileExpandedPlurals :: MonadIO m => Dataset (Translation (Message Node)) -> m ()
-compileExpandedPlurals = putTextLn . compileDataset . fmap (\x -> x { message = expandPlurals x.message })
+compileExpandedPlurals = putTextLn . JSON.compileDataset JSON.Minified . fmap f
+  where f x = x { message = expandPlurals x.message }
 
 tryGetParsedStdinSansAnn :: IO (Dataset (Translation (Message Node)))
 tryGetParsedStdinSansAnn = parserDie . fmap datasetSansAnn =<< getParsedStdin
diff --git a/lib/Intlc/Backend/JSON/Compiler.hs b/lib/Intlc/Backend/JSON/Compiler.hs
index 80e4313..49dfd74 100644
--- a/lib/Intlc/Backend/JSON/Compiler.hs
+++ b/lib/Intlc/Backend/JSON/Compiler.hs
@@ -3,12 +3,28 @@ module Intlc.Backend.JSON.Compiler where
 import           Data.List.Extra            (escapeJSON)
 import qualified Data.Map                   as M
 import qualified Data.Text                  as T
-import           Intlc.Backend.ICU.Compiler (Formatting (SingleLine),
-                                             compileMsg)
+import qualified Intlc.Backend.ICU.Compiler as ICU
 import           Intlc.Core
 import           Intlc.ICU                  (Message, Node)
 import           Prelude
 
+type Compiler = Reader Config
+
+data Config = Config
+  -- Expected to be potentially supplied externally.
+  { fmt          :: Formatting
+  -- Expected to be supplied internally.
+  , indentLevels :: Int
+  }
+
+-- | For prettified formatting we simply indent and inject newlines at objects.
+data Formatting
+  = Minified
+  | Pretty
+
+increment :: Compiler a -> Compiler a
+increment = local $ \x -> x { indentLevels = x.indentLevels + 1 }
+
 -- Assumes unescaped input.
 dblqts :: Text -> Text
 dblqts v = "\"" <> escapeJSONText v <> "\""
@@ -23,20 +39,31 @@ nullVal = "null"
 objKey :: Text -> Text
 objKey = dblqts
 
-objPair :: Text -> Text -> Text
-objPair k v = objKey k <> ":" <> v
-
-obj :: [(Text, Text)] -> Text
-obj xs = "{" <> ys <> "}"
-  where ys = T.intercalate "," . fmap (uncurry objPair) $ xs
+-- | This is where we'll manage indentation for all objects, hence taking a
+-- monadic input.
+obj :: Compiler [(Text, Text)] -> Compiler Text
+obj xs = asks fmt >>= \case
+  Minified -> do
+    let objPair k v = objKey k <> ":" <> v
+    contents <- fmap (T.intercalate "," . fmap (uncurry objPair)) $ xs
+    pure $ "{" <> contents <> "}"
+  Pretty   -> do
+    i <- asks indentLevels
+    let objPair k v = (indentBy (i + 1) <>) $ objKey k <> ": " <> v
+    contents <- fmap (T.intercalate ("," <> newline) . fmap (uncurry objPair)) . increment $ xs
+    pure $ "{" <> newline <> contents <> newline <> indentBy i <> "}"
+    where newline = "\n"
+          indentBy = flip T.replicate "\t"
 
-compileDataset :: Dataset (Translation (Message Node)) -> Text
-compileDataset = obj . M.toList . M.map translation
+compileDataset :: Formatting -> Dataset (Translation (Message Node)) -> Text
+compileDataset fo ds = runReader (dataset ds) (Config fo 0)
+  where dataset = obj . traverse (uncurry f) . M.toList
+        f x = fmap (x,) . translation
 
-translation :: Translation (Message Node) -> Text
-translation Translation { message, backend, mdesc } = obj . fromList $ ys
+translation :: Translation (Message Node) -> Compiler Text
+translation Translation { message, backend, mdesc } = obj . pure . fromList $ ys
   where ys =
-          [ ("message", strVal . compileMsg SingleLine $ message)
+          [ ("message", strVal . ICU.compileMsg ICU.SingleLine $ message)
           , ("backend", backendVal)
           , ("description", maybe nullVal strVal mdesc)
           ]
diff --git a/lib/Intlc/Compiler.hs b/lib/Intlc/Compiler.hs
index 7d6ac9d..17eb257 100644
--- a/lib/Intlc/Compiler.hs
+++ b/lib/Intlc/Compiler.hs
@@ -37,7 +37,7 @@ compileTranslation l k (Translation v be _) = case be of
   TypeScriptReact -> TS.compileNamedExport JSX         l k v
 
 compileFlattened :: Dataset (Translation (ICU.Message ICU.Node)) -> Text
-compileFlattened = JSON.compileDataset . mapMsgs (fmap flatten)
+compileFlattened = JSON.compileDataset JSON.Minified . mapMsgs (fmap flatten)
 
 mapMsgs :: (ICU.Message ICU.Node -> ICU.Message ICU.Node) -> Dataset (Translation (ICU.Message ICU.Node)) -> Dataset (Translation (ICU.Message ICU.Node))
 mapMsgs f = fmap $ \x -> x { message = f x.message }

From 422f13455f5e9007760238ad4a34d828b4384879 Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Thu, 12 Jan 2023 19:18:10 +0000
Subject: [PATCH 2/6] Add basic JSON formatting tests

---
 cli/Main.hs                | 18 ++++++-----
 lib/Intlc/Compiler.hs      |  4 +--
 test/Intlc/CompilerSpec.hs | 62 +++++++++++++++++++++++++++++---------
 3 files changed, 60 insertions(+), 24 deletions(-)

diff --git a/cli/Main.hs b/cli/Main.hs
index 3dd34e6..735005b 100644
--- a/cli/Main.hs
+++ b/cli/Main.hs
@@ -1,14 +1,16 @@
 module Main where
 
-import           CLI                (Opts (..), getOpts)
-import qualified Data.Text          as T
-import           Intlc.Compiler     (compileDataset, compileFlattened)
+import           CLI                         (Opts (..), getOpts)
+import qualified Data.Text                   as T
+import qualified Intlc.Backend.JSON.Compiler as JSON
+import           Intlc.Compiler              (compileDataset, compileFlattened)
 import           Intlc.Core
-import           Intlc.ICU          (AnnNode, Message, Node, sansAnn)
+import           Intlc.ICU                   (AnnNode, Message, Node, sansAnn)
 import           Intlc.Linter
-import           Intlc.Parser       (parseDataset, parseMessage, printErr)
-import           Intlc.Parser.Error (ParseFailure)
-import           Intlc.Prettify     (prettify)
+import           Intlc.Parser                (parseDataset, parseMessage,
+                                              printErr)
+import           Intlc.Parser.Error          (ParseFailure)
+import           Intlc.Prettify              (prettify)
 import           Prelude
 
 main :: IO ()
@@ -24,7 +26,7 @@ compile loc = compileDataset loc >>> \case
   Right x -> putTextLn x
 
 flatten :: MonadIO m => Dataset (Translation (Message Node)) -> m ()
-flatten = putTextLn . compileFlattened
+flatten = putTextLn . compileFlattened JSON.Minified
 
 lint :: MonadIO m => FilePath -> m ()
 lint path = do
diff --git a/lib/Intlc/Compiler.hs b/lib/Intlc/Compiler.hs
index 17eb257..8b3ce71 100644
--- a/lib/Intlc/Compiler.hs
+++ b/lib/Intlc/Compiler.hs
@@ -36,8 +36,8 @@ compileTranslation l k (Translation v be _) = case be of
   TypeScript      -> TS.compileNamedExport TemplateLit l k v
   TypeScriptReact -> TS.compileNamedExport JSX         l k v
 
-compileFlattened :: Dataset (Translation (ICU.Message ICU.Node)) -> Text
-compileFlattened = JSON.compileDataset JSON.Minified . mapMsgs (fmap flatten)
+compileFlattened :: JSON.Formatting -> Dataset (Translation (ICU.Message ICU.Node)) -> Text
+compileFlattened fo = JSON.compileDataset fo . mapMsgs (fmap flatten)
 
 mapMsgs :: (ICU.Message ICU.Node -> ICU.Message ICU.Node) -> Dataset (Translation (ICU.Message ICU.Node)) -> Dataset (Translation (ICU.Message ICU.Node))
 mapMsgs f = fmap $ \x -> x { message = f x.message }
diff --git a/test/Intlc/CompilerSpec.hs b/test/Intlc/CompilerSpec.hs
index c78f753..1bc276e 100644
--- a/test/Intlc/CompilerSpec.hs
+++ b/test/Intlc/CompilerSpec.hs
@@ -1,13 +1,15 @@
 module Intlc.CompilerSpec (spec) where
 
-import           Intlc.Compiler    (compileDataset, compileFlattened,
-                                    expandRules, flatten)
-import           Intlc.Core        (Backend (..), Locale (Locale),
-                                    Translation (Translation))
+import qualified Data.Text                   as T
+import qualified Intlc.Backend.JSON.Compiler as JSON
+import           Intlc.Compiler              (compileDataset, compileFlattened,
+                                              expandRules, flatten)
+import           Intlc.Core                  (Backend (..), Locale (Locale),
+                                              Translation (Translation))
 import           Intlc.ICU
-import           Prelude           hiding (one)
+import           Prelude                     hiding (one)
 import           Test.Hspec
-import           Text.RawString.QQ (r)
+import           Text.RawString.QQ           (r)
 
 spec :: Spec
 spec = describe "compiler" $ do
@@ -25,16 +27,48 @@ spec = describe "compiler" $ do
       f [""] `shouldSatisfy` isLeft
 
   describe "compile flattened dataset" $ do
-    it "flattens messages and outputs JSON" $ do
-      compileFlattened (fromList
-        [ ("x", Translation (Message "xfoo") TypeScript Nothing)
-        , ("z", Translation (Message "zfoo") TypeScriptReact (Just "zbar"))
-        , ("y", Translation (Message $ mconcat ["yfoo ", String' "ybar"]) TypeScript Nothing)
-        ])
-          `shouldBe` [r|{"x":{"message":"xfoo","backend":"ts","description":null},"y":{"message":"yfoo {ybar}","backend":"ts","description":null},"z":{"message":"zfoo","backend":"tsx","description":"zbar"}}|]
+    let f = compileFlattened
+
+    describe "flattens messages and outputs JSON" $ do
+      let xs = fromList
+            [ ("x", Translation (Message "xfoo") TypeScript Nothing)
+            , ("z", Translation (Message "zfoo") TypeScriptReact (Just "zbar"))
+            , ("y", Translation (Message $ mconcat ["yfoo ", String' "ybar"]) TypeScript Nothing)
+            ]
+
+      it "minified" $ do
+        f JSON.Minified xs `shouldBe`
+          [r|{"x":{"message":"xfoo","backend":"ts","description":null},"y":{"message":"yfoo {ybar}","backend":"ts","description":null},"z":{"message":"zfoo","backend":"tsx","description":"zbar"}}|]
+
+      it "prettified" $ do
+        let toTabs = T.replace "  " "\t"
+
+        -- Ideally this'd be improved, but the current simple algo gives us
+        -- this on an empty dataset.
+        f JSON.Pretty mempty `shouldBe` [r|{
+
+}|]
+
+        f JSON.Pretty xs `shouldBe` toTabs [r|{
+  "x": {
+    "message": "xfoo",
+    "backend": "ts",
+    "description": null
+  },
+  "y": {
+    "message": "yfoo {ybar}",
+    "backend": "ts",
+    "description": null
+  },
+  "z": {
+    "message": "zfoo",
+    "backend": "tsx",
+    "description": "zbar"
+  }
+}|]
 
     it "escapes double quotes in JSON" $ do
-      compileFlattened (fromList [("x\"y", Translation (Message "\"z\"") TypeScript Nothing)])
+      f JSON.Minified (fromList [("x\"y", Translation (Message "\"z\"") TypeScript Nothing)])
         `shouldBe` [r|{"x\"y":{"message":"\"z\"","backend":"ts","description":null}}|]
 
   describe "flatten message" $ do

From fecdc2573e272be68c89f53d307a05230ea3984d Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Thu, 12 Jan 2023 19:25:45 +0000
Subject: [PATCH 3/6] Improve JSON pretty newline algo

Same output except for empty datasets for which there's now one newline
rather than two, which is more reasonable.
---
 lib/Intlc/Backend/JSON/Compiler.hs | 8 ++++----
 test/Intlc/CompilerSpec.hs         | 3 ---
 2 files changed, 4 insertions(+), 7 deletions(-)

diff --git a/lib/Intlc/Backend/JSON/Compiler.hs b/lib/Intlc/Backend/JSON/Compiler.hs
index 49dfd74..a476a33 100644
--- a/lib/Intlc/Backend/JSON/Compiler.hs
+++ b/lib/Intlc/Backend/JSON/Compiler.hs
@@ -45,13 +45,13 @@ obj :: Compiler [(Text, Text)] -> Compiler Text
 obj xs = asks fmt >>= \case
   Minified -> do
     let objPair k v = objKey k <> ":" <> v
-    contents <- fmap (T.intercalate "," . fmap (uncurry objPair)) $ xs
+    contents <- T.intercalate "," . fmap (uncurry objPair) <$> xs
     pure $ "{" <> contents <> "}"
   Pretty   -> do
     i <- asks indentLevels
-    let objPair k v = (indentBy (i + 1) <>) $ objKey k <> ": " <> v
-    contents <- fmap (T.intercalate ("," <> newline) . fmap (uncurry objPair)) . increment $ xs
-    pure $ "{" <> newline <> contents <> newline <> indentBy i <> "}"
+    let objPair k v = newline <> indentBy (i + 1) <> objKey k <> ": " <> v
+    contents <- fmap (T.intercalate "," . fmap (uncurry objPair)) . increment $ xs
+    pure $ "{" <> contents <> newline <> indentBy i <> "}"
     where newline = "\n"
           indentBy = flip T.replicate "\t"
 
diff --git a/test/Intlc/CompilerSpec.hs b/test/Intlc/CompilerSpec.hs
index 1bc276e..8bbcf78 100644
--- a/test/Intlc/CompilerSpec.hs
+++ b/test/Intlc/CompilerSpec.hs
@@ -43,10 +43,7 @@ spec = describe "compiler" $ do
       it "prettified" $ do
         let toTabs = T.replace "  " "\t"
 
-        -- Ideally this'd be improved, but the current simple algo gives us
-        -- this on an empty dataset.
         f JSON.Pretty mempty `shouldBe` [r|{
-
 }|]
 
         f JSON.Pretty xs `shouldBe` toTabs [r|{

From e3018baa689f8a3ea038fdf859ea323a354deb78 Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Thu, 12 Jan 2023 19:34:04 +0000
Subject: [PATCH 4/6] Add intlc flatten --minify flag

---
 cli/CLI.hs  | 10 +++++++---
 cli/Main.hs |  6 +++---
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/cli/CLI.hs b/cli/CLI.hs
index c947f2a..4b275d7 100644
--- a/cli/CLI.hs
+++ b/cli/CLI.hs
@@ -1,12 +1,13 @@
 module CLI (Opts (..), getOpts) where
 
-import           Intlc.Core          (Locale (..))
+import qualified Intlc.Backend.JSON.Compiler as JSON
+import           Intlc.Core                  (Locale (..))
 import           Options.Applicative
 import           Prelude
 
 data Opts
   = Compile FilePath Locale
-  | Flatten FilePath
+  | Flatten FilePath JSON.Formatting
   | Lint    FilePath
   | Prettify Text
 
@@ -26,7 +27,7 @@ compile :: Parser Opts
 compile = Compile <$> pathp <*> localep
 
 flatten :: Parser Opts
-flatten = Flatten <$> pathp
+flatten = Flatten <$> pathp <*> minifyp
 
 lint :: Parser Opts
 lint = Lint <$> pathp
@@ -40,5 +41,8 @@ pathp = argument str (metavar "filepath")
 localep :: Parser Locale
 localep = Locale <$> strOption (short 'l' <> long "locale")
 
+minifyp :: Parser JSON.Formatting
+minifyp = flag JSON.Pretty JSON.Minified (long "minify")
+
 prettify :: Parser Opts
 prettify = Prettify <$> msgp
diff --git a/cli/Main.hs b/cli/Main.hs
index 735005b..2579c29 100644
--- a/cli/Main.hs
+++ b/cli/Main.hs
@@ -16,7 +16,7 @@ import           Prelude
 main :: IO ()
 main = getOpts >>= \case
   Compile path loc -> tryGetParsedAtSansAnn path >>= compile loc
-  Flatten path     -> tryGetParsedAtSansAnn path >>= flatten
+  Flatten path fo  -> tryGetParsedAtSansAnn path >>= flatten fo
   Lint    path     -> lint path
   Prettify msg     -> tryPrettify msg
 
@@ -25,8 +25,8 @@ compile loc = compileDataset loc >>> \case
   Left es -> die . T.unpack . ("Invalid keys:\n" <>) . T.intercalate "\n" . fmap ("\t" <>) . toList $ es
   Right x -> putTextLn x
 
-flatten :: MonadIO m => Dataset (Translation (Message Node)) -> m ()
-flatten = putTextLn . compileFlattened JSON.Minified
+flatten :: MonadIO m => JSON.Formatting -> Dataset (Translation (Message Node)) -> m ()
+flatten fo = putTextLn . compileFlattened fo
 
 lint :: MonadIO m => FilePath -> m ()
 lint path = do

From 2395994ce607cb5696d0dc5189e1d1e03be828d6 Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Thu, 12 Jan 2023 19:36:10 +0000
Subject: [PATCH 5/6] Add intlc-internal expand-plurals --minify flag

---
 internal/CLI.hs  | 8 ++++++--
 internal/Main.hs | 8 ++++----
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/internal/CLI.hs b/internal/CLI.hs
index 869178d..f6a75e9 100644
--- a/internal/CLI.hs
+++ b/internal/CLI.hs
@@ -1,12 +1,13 @@
 module CLI (Opts (..), getOpts) where
 
+import qualified Intlc.Backend.JSON.Compiler as JSON
 import           Options.Applicative
 import           Prelude
 
 data Opts
   = Lint FilePath
   -- Takes stdin.
-  | ExpandPlurals
+  | ExpandPlurals JSON.Formatting
 
 getOpts :: IO Opts
 getOpts = execParser (info (opts <**> helper) (progDesc h))
@@ -22,7 +23,10 @@ lint :: Parser Opts
 lint = Lint <$> pathp
 
 expandPlurals :: Parser Opts
-expandPlurals = pure ExpandPlurals
+expandPlurals = ExpandPlurals <$> minifyp
 
 pathp :: Parser FilePath
 pathp = argument str (metavar "filepath")
+
+minifyp :: Parser JSON.Formatting
+minifyp = flag JSON.Pretty JSON.Minified (long "minify")
diff --git a/internal/Main.hs b/internal/Main.hs
index cb5d122..d427ca8 100644
--- a/internal/Main.hs
+++ b/internal/Main.hs
@@ -14,8 +14,8 @@ import           Prelude                     hiding (filter)
 
 main :: IO ()
 main = getOpts >>= \case
-  Lint path     -> lint path
-  ExpandPlurals -> tryGetParsedStdinSansAnn >>= compileExpandedPlurals
+  Lint path        -> lint path
+  ExpandPlurals fo -> tryGetParsedStdinSansAnn >>= compileExpandedPlurals fo
 
 lint :: MonadIO m => FilePath -> m ()
 lint path = do
@@ -23,8 +23,8 @@ lint path = do
   dataset <- parserDie $ parseDataset path raw
   whenJust (lintDatasetInternal path raw dataset) $ die . T.unpack
 
-compileExpandedPlurals :: MonadIO m => Dataset (Translation (Message Node)) -> m ()
-compileExpandedPlurals = putTextLn . JSON.compileDataset JSON.Minified . fmap f
+compileExpandedPlurals :: MonadIO m => JSON.Formatting -> Dataset (Translation (Message Node)) -> m ()
+compileExpandedPlurals fo = putTextLn . JSON.compileDataset fo . fmap f
   where f x = x { message = expandPlurals x.message }
 
 tryGetParsedStdinSansAnn :: IO (Dataset (Translation (Message Node)))

From eeee773144ca83ab75c4b704720141b45759dd05 Mon Sep 17 00:00:00 2001
From: "Sam A. Horvath-Hunt" <hello@samhh.com>
Date: Fri, 13 Jan 2023 11:31:58 +0000
Subject: [PATCH 6/6] Update README command for --minify

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 589f5f8..53026e4 100644
--- a/README.md
+++ b/README.md
@@ -49,7 +49,7 @@ Hoist selectors up as much as possible. This is often preferred by translators.
 ```console
 $ cat translations.json
 {"openSource":{"message": "Open source at {company} is {company, select, Unsplash {encouraged!} other {unknown}}"}}
-$ intlc flatten translations.json
+$ intlc flatten --minify translations.json
 {"openSource":{"message":"{company, select, Unsplash {Open source at {company} is encouraged!} other {Open source at {company} is unknown}}"}}
 ```