From b2085e518d0dced00e46a539703da7d2440acab0 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Wed, 8 Mar 2017 17:38:24 +0100 Subject: [PATCH 01/16] Add pretty printing capabilities to Toml types --- htoml.cabal | 4 +++- src/Text/Toml/Pretty.hs | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 1 deletion(-) create mode 100644 src/Text/Toml/Pretty.hs diff --git a/htoml.cabal b/htoml.cabal index 77bfcbe..6b81ddc 100644 --- a/htoml.cabal +++ b/htoml.cabal @@ -33,6 +33,7 @@ library exposed-modules: Text.Toml , Text.Toml.Parser , Text.Toml.Types + , Text.Toml.Pretty ghc-options: -Wall hs-source-dirs: src default-language: Haskell2010 @@ -42,7 +43,8 @@ library , unordered-containers >= 0.2 , vector >= 0.10 , aeson >= 0.8 - , text >= 1.0 && < 2 + , text >= 1.0 && < 2.0.0 + , pretty >= 1.1.3 && < 2.0.0 , time -any , old-locale -any diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs new file mode 100644 index 0000000..78510cb --- /dev/null +++ b/src/Text/Toml/Pretty.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------- +-- | +-- Module : Text.Toml.Pretty +-- +-- Display TOML values using pretty printing combinators. + +module Text.Toml.Pretty ( + module Text.Toml.Pretty, + module Text.PrettyPrint.HughesPJ, + ) where + +import Text.Toml.Types +import Text.PrettyPrint.HughesPJ + +import Data.Text (Text) +import qualified Data.Text as T + +ppNode :: Node -> Doc +ppNode n = case n of + (VTable v) -> undefined + (VTArray v) -> undefined + (VString v) -> ppTomlString v + (VInteger v) -> undefined + (VFloat v) -> undefined + (VBoolean v) -> undefined + (VDatetime v) -> undefined + (VArray v) -> undefined + +ppTomlString :: T.Text -> Doc +ppTomlString str = doubleQuotes $ hcat $ map pp_char (T.unpack str) + where pp_char '\\' = text "\\\\" + pp_char '\"' = text "\\\"" + pp_char c = char c + From fb4f71ceb630803ebd0430d80a0346b07a4e7e5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Wed, 8 Mar 2017 21:39:06 +0100 Subject: [PATCH 02/16] Implemeneted ppTable, ppFloat, ppBoolean and ppArray --- src/Text/Toml/Pretty.hs | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 78510cb..eba52bd 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -13,23 +13,43 @@ module Text.Toml.Pretty ( import Text.Toml.Types import Text.PrettyPrint.HughesPJ +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as M +import Data.Vector as V import Data.Text (Text) import qualified Data.Text as T ppNode :: Node -> Doc ppNode n = case n of - (VTable v) -> undefined + (VTable v) -> ppTable v (VTArray v) -> undefined (VString v) -> ppTomlString v (VInteger v) -> undefined - (VFloat v) -> undefined - (VBoolean v) -> undefined + (VFloat v) -> ppFloat v + (VBoolean v) -> ppBoolean v (VDatetime v) -> undefined - (VArray v) -> undefined + (VArray v) -> ppArray v ppTomlString :: T.Text -> Doc -ppTomlString str = doubleQuotes $ hcat $ map pp_char (T.unpack str) +ppTomlString str = doubleQuotes $ hcat $ Prelude.map pp_char (T.unpack str) where pp_char '\\' = text "\\\\" pp_char '\"' = text "\\\"" pp_char c = char c +ppFloat :: Double -> Doc +ppFloat f = double f + +ppBoolean :: Bool -> Doc +ppBoolean True = text "true" +ppBoolean False = text "false" + +-- Unclear with fsep, vcat +ppArray :: Vector Node -> Doc +ppArray va = brackets $ fsep $ punctuate comma $ Prelude.map ppNode (V.toList va) + +ppTable :: Table -> Doc +ppTable t = vcat $ tableToList $ M.toList t + +tableToList :: [(Text,Node)] -> [Doc] +tableToList t = Prelude.map fsep (Prelude.map f t) + where f (x,y) = punctuate equals [text $ T.unpack x,ppNode y] \ No newline at end of file From 0851e792f60dad0f0a2da2cb6380568c792bffa2 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Wed, 8 Mar 2017 22:02:07 +0100 Subject: [PATCH 03/16] Parsing a whole file, some issues with nested tables and arrays --- htoml.cabal | 2 +- src/Text/Toml.hs | 1 + src/Text/Toml/Pretty.hs | 38 ++++++++++++++++++++++++++------------ 3 files changed, 28 insertions(+), 13 deletions(-) diff --git a/htoml.cabal b/htoml.cabal index 6b81ddc..0c273a9 100644 --- a/htoml.cabal +++ b/htoml.cabal @@ -44,7 +44,7 @@ library , vector >= 0.10 , aeson >= 0.8 , text >= 1.0 && < 2.0.0 - , pretty >= 1.1.3 && < 2.0.0 + , pretty >= 1.1 && < 2.0.0 , time -any , old-locale -any diff --git a/src/Text/Toml.hs b/src/Text/Toml.hs index 02a4d4d..471ff51 100644 --- a/src/Text/Toml.hs +++ b/src/Text/Toml.hs @@ -5,6 +5,7 @@ import Data.Set (empty) import Text.Parsec import Text.Toml.Parser +import Text.Toml.Pretty hiding (empty) -- | Parse a 'Text' that results in 'Either' a 'String' diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index eba52bd..90b083a 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -1,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} --------------------------------------------------------------------- +-- ----------------------------------------------------------------- -- | -- Module : Text.Toml.Pretty +-- Authors : Johan Backman +-- Hampus Ramström -- -- Display TOML values using pretty printing combinators. +-- ----------------------------------------------------------------- module Text.Toml.Pretty ( module Text.Toml.Pretty, @@ -13,31 +16,39 @@ module Text.Toml.Pretty ( import Text.Toml.Types import Text.PrettyPrint.HughesPJ -import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import Data.Vector as V import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (formatTime, defaultTimeLocale) import qualified Data.Text as T ppNode :: Node -> Doc ppNode n = case n of (VTable v) -> ppTable v - (VTArray v) -> undefined + (VTArray v) -> ppTArray v (VString v) -> ppTomlString v - (VInteger v) -> undefined + (VInteger v) -> ppInteger $ fromIntegral v (VFloat v) -> ppFloat v (VBoolean v) -> ppBoolean v - (VDatetime v) -> undefined + (VDatetime v) -> ppDateTime v (VArray v) -> ppArray v ppTomlString :: T.Text -> Doc -ppTomlString str = doubleQuotes $ hcat $ Prelude.map pp_char (T.unpack str) - where pp_char '\\' = text "\\\\" - pp_char '\"' = text "\\\"" - pp_char c = char c +ppTomlString str = doubleQuotes $ hcat $ Prelude.map ppChar (T.unpack str) + where ppChar '\\' = text "\\\\" + ppChar '\"' = text "\\\"" + ppChar c = char c + +ppInteger :: Integer -> Doc +ppInteger = integer + +ppDateTime :: UTCTime -> Doc +ppDateTime t = text $ show f_date + where f_date = formatTime defaultTimeLocale "%FT%TZ" t ppFloat :: Double -> Doc -ppFloat f = double f +ppFloat = double ppBoolean :: Bool -> Doc ppBoolean True = text "true" @@ -51,5 +62,8 @@ ppTable :: Table -> Doc ppTable t = vcat $ tableToList $ M.toList t tableToList :: [(Text,Node)] -> [Doc] -tableToList t = Prelude.map fsep (Prelude.map f t) - where f (x,y) = punctuate equals [text $ T.unpack x,ppNode y] \ No newline at end of file +tableToList = Prelude.map (fsep . f) + where f (x,y) = punctuate equals [text $ T.unpack x,ppNode y] + +ppTArray :: Vector Table -> Doc +ppTArray vt = brackets $ fsep $ punctuate comma $ Prelude.map ppTable (V.toList vt) From b861bdc2dcf709914b32b7f1b2a02eb059b51933 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 08:44:14 +0100 Subject: [PATCH 04/16] Fix qoutes around DateTime objects --- src/Text/Toml/Pretty.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 90b083a..73b2de4 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -44,8 +44,10 @@ ppInteger :: Integer -> Doc ppInteger = integer ppDateTime :: UTCTime -> Doc -ppDateTime t = text $ show f_date - where f_date = formatTime defaultTimeLocale "%FT%TZ" t +ppDateTime t = hcat $ Prelude.map ppDate (show f_date) + where f_date = formatTime defaultTimeLocale "%FT%TZ" t + ppDate '\"' = text "" + ppDate c = char c ppFloat :: Double -> Doc ppFloat = double From 29c6b30f5a1109d041ab119c4da6d20b4faffe39 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 09:12:18 +0100 Subject: [PATCH 05/16] Use qualified imports so we can use Prelude directly --- src/Text/Toml/Pretty.hs | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 73b2de4..1f3d802 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -2,8 +2,8 @@ -- ----------------------------------------------------------------- -- | -- Module : Text.Toml.Pretty --- Authors : Johan Backman --- Hampus Ramström +-- Authors : Johan Backman +-- Hampus Ramström -- -- Display TOML values using pretty printing combinators. -- ----------------------------------------------------------------- @@ -17,8 +17,7 @@ import Text.Toml.Types import Text.PrettyPrint.HughesPJ import qualified Data.HashMap.Strict as M -import Data.Vector as V -import Data.Text (Text) +import qualified Data.Vector as V import Data.Time.Clock (UTCTime) import Data.Time.Format (formatTime, defaultTimeLocale) import qualified Data.Text as T @@ -35,20 +34,20 @@ ppNode n = case n of (VArray v) -> ppArray v ppTomlString :: T.Text -> Doc -ppTomlString str = doubleQuotes $ hcat $ Prelude.map ppChar (T.unpack str) +ppTomlString str = doubleQuotes $ hcat $ map ppChar (T.unpack str) where ppChar '\\' = text "\\\\" ppChar '\"' = text "\\\"" ppChar c = char c -ppInteger :: Integer -> Doc -ppInteger = integer - ppDateTime :: UTCTime -> Doc -ppDateTime t = hcat $ Prelude.map ppDate (show f_date) +ppDateTime t = hcat $ map ppDate (show f_date) where f_date = formatTime defaultTimeLocale "%FT%TZ" t ppDate '\"' = text "" ppDate c = char c +ppInteger :: Integer -> Doc +ppInteger = integer + ppFloat :: Double -> Doc ppFloat = double @@ -57,15 +56,15 @@ ppBoolean True = text "true" ppBoolean False = text "false" -- Unclear with fsep, vcat -ppArray :: Vector Node -> Doc -ppArray va = brackets $ fsep $ punctuate comma $ Prelude.map ppNode (V.toList va) +ppArray :: V.Vector Node -> Doc +ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) ppTable :: Table -> Doc ppTable t = vcat $ tableToList $ M.toList t -tableToList :: [(Text,Node)] -> [Doc] -tableToList = Prelude.map (fsep . f) - where f (x,y) = punctuate equals [text $ T.unpack x,ppNode y] +tableToList :: [(T.Text, Node)] -> [Doc] +tableToList = map (fsep . f) + where f (x, y) = punctuate equals [text $ T.unpack x,ppNode y] -ppTArray :: Vector Table -> Doc -ppTArray vt = brackets $ fsep $ punctuate comma $ Prelude.map ppTable (V.toList vt) +ppTArray :: V.Vector Table -> Doc +ppTArray vt = brackets $ fsep $ punctuate comma $ map ppTable (V.toList vt) From 47cb6a95de17aa05f05948817a7f596f51e3e5fd Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 09:28:08 +0100 Subject: [PATCH 06/16] Import pretty printing module correctly --- src/Text/Toml.hs | 2 +- src/Text/Toml/Pretty.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Text/Toml.hs b/src/Text/Toml.hs index 471ff51..ab3e9f8 100644 --- a/src/Text/Toml.hs +++ b/src/Text/Toml.hs @@ -5,7 +5,7 @@ import Data.Set (empty) import Text.Parsec import Text.Toml.Parser -import Text.Toml.Pretty hiding (empty) +import Text.Toml.Pretty () -- | Parse a 'Text' that results in 'Either' a 'String' diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 1f3d802..0a31d03 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -52,7 +52,7 @@ ppFloat :: Double -> Doc ppFloat = double ppBoolean :: Bool -> Doc -ppBoolean True = text "true" +ppBoolean True = text "true" ppBoolean False = text "false" -- Unclear with fsep, vcat @@ -64,7 +64,7 @@ ppTable t = vcat $ tableToList $ M.toList t tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) - where f (x, y) = punctuate equals [text $ T.unpack x,ppNode y] + where f (x, y) = punctuate equals [text $ T.unpack x, ppNode y] ppTArray :: V.Vector Table -> Doc ppTArray vt = brackets $ fsep $ punctuate comma $ map ppTable (V.toList vt) From 84428bc7d9c24e0c0f9e4c15a24a5b18741f9b62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 9 Mar 2017 09:28:39 +0100 Subject: [PATCH 07/16] Fixed space before equal error --- src/Text/Toml/Pretty.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 90b083a..e317c13 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -61,9 +61,14 @@ ppArray va = brackets $ fsep $ punctuate comma $ Prelude.map ppNode (V.toList va ppTable :: Table -> Doc ppTable t = vcat $ tableToList $ M.toList t -tableToList :: [(Text,Node)] -> [Doc] +{-tableToList :: [(Text,Node)] -> Doc +tableToList (x:xs) = (title x) $$ (vcat $ (Prelude.map (fsep . f) xs)) + where f (x,y) = punctuate (space <> equals) [text $ T.unpack x,ppNode y] + title (x,_) = brackets $ text $ T.unpack x-} + +tableToList :: [(T.Text, Node)] -> [Doc] tableToList = Prelude.map (fsep . f) - where f (x,y) = punctuate equals [text $ T.unpack x,ppNode y] + where f (x, y) = punctuate (space <> equals) [text $ T.unpack x,ppNode y] ppTArray :: Vector Table -> Doc ppTArray vt = brackets $ fsep $ punctuate comma $ Prelude.map ppTable (V.toList vt) From 9f243ef80d8104bdce22fdb2829f045e372d1b9f Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 10:27:16 +0100 Subject: [PATCH 08/16] First pass on nestled tables. Types are still ugly. --- src/Text/Toml.hs | 2 +- src/Text/Toml/Pretty.hs | 18 +++++++++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/Text/Toml.hs b/src/Text/Toml.hs index ab3e9f8..471ff51 100644 --- a/src/Text/Toml.hs +++ b/src/Text/Toml.hs @@ -5,7 +5,7 @@ import Data.Set (empty) import Text.Parsec import Text.Toml.Parser -import Text.Toml.Pretty () +import Text.Toml.Pretty hiding (empty) -- | Parse a 'Text' that results in 'Either' a 'String' diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 0d5c933..7039741 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -24,7 +24,7 @@ import qualified Data.Text as T ppNode :: Node -> Doc ppNode n = case n of - (VTable v) -> ppTable v + (VTable v) -> ppTable $ M.toList v (VTArray v) -> ppTArray v (VString v) -> ppTomlString v (VInteger v) -> ppInteger $ fromIntegral v @@ -59,8 +59,10 @@ ppBoolean False = text "false" ppArray :: V.Vector Node -> Doc ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) -ppTable :: Table -> Doc -ppTable t = vcat $ tableToList $ M.toList t +ppTable :: [(T.Text, Node)] -> Doc +ppTable ((t, VTable v) : xs) = + brackets (text $ T.unpack t) $$ vcat (tableToList (M.toList v)) $$ ppTable xs +ppTable tb = vcat $ tableToList tb {-tableToList :: [(Text,Node)] -> Doc tableToList (x:xs) = (title x) $$ (vcat $ (Prelude.map (fsep . f) xs)) @@ -69,7 +71,13 @@ tableToList (x:xs) = (title x) $$ (vcat $ (Prelude.map (fsep . f) xs)) tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) - where f (x, y) = punctuate (space <> equals) [text $ T.unpack x,ppNode y] + where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] +-- Need fix ppTArray :: V.Vector Table -> Doc -ppTArray vt = brackets $ fsep $ punctuate comma $ map ppTable (V.toList vt) +ppTArray vt = brackets $ fsep $ punctuate comma $ map (ppTable . M.toList) (V.toList vt) + + + + + From 36369c48292298022c90ffc8801dbcc8fb6c4ab6 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 15:16:51 +0100 Subject: [PATCH 09/16] Pretty print Table correctly --- src/Text/Toml/Pretty.hs | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 7039741..746108c 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -24,7 +24,7 @@ import qualified Data.Text as T ppNode :: Node -> Doc ppNode n = case n of - (VTable v) -> ppTable $ M.toList v + (VTable v) -> ppTable v (VTArray v) -> ppTArray v (VString v) -> ppTomlString v (VInteger v) -> ppInteger $ fromIntegral v @@ -59,23 +59,26 @@ ppBoolean False = text "false" ppArray :: V.Vector Node -> Doc ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) -ppTable :: [(T.Text, Node)] -> Doc -ppTable ((t, VTable v) : xs) = - brackets (text $ T.unpack t) $$ vcat (tableToList (M.toList v)) $$ ppTable xs -ppTable tb = vcat $ tableToList tb - -{-tableToList :: [(Text,Node)] -> Doc -tableToList (x:xs) = (title x) $$ (vcat $ (Prelude.map (fsep . f) xs)) - where f (x,y) = punctuate (space <> equals) [text $ T.unpack x,ppNode y] - title (x,_) = brackets $ text $ T.unpack x-} +ppTable :: Table -> Doc +ppTable tb = findTTitle (M.toList tb) [text ""] + where + findTTitle [] ti = brackets $ hcat ti + findTTitle [(t, VTable v)] ti = findTTitle (M.toList v) $ ti ++ [text $ T.unpack t] + findTTitle ((t, VTable v) : xs) ti = (findTTitle (M.toList v) $ ti ++ [text $ T.unpack t]) $$ findTTitle xs ti + findTTitle v ti = (brackets $ hcat $ punctuate (char '.') (tail ti)) $$ vcat (tableToList v) tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] +ppTArrayWithName :: [(T.Text, Node)] -> Doc -> Doc +ppTArrayWithName ((t, VTable _) : xs) name = ppTArrayWithName xs $ name <+> text (T.unpack t) +ppTArrayWithName l name = brackets name $$ vcat (tableToList l) + -- Need fix ppTArray :: V.Vector Table -> Doc -ppTArray vt = brackets $ fsep $ punctuate comma $ map (ppTable . M.toList) (V.toList vt) +ppTArray vt = brackets $ fsep $ punctuate comma $ map ppTable (V.toList vt) + From 6ff5b95bafc50a8d5cb065fd348150e42c278976 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 17:53:51 +0100 Subject: [PATCH 10/16] Pretty printing of single level arrays --- src/Text/Toml/Pretty.hs | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 746108c..a0afede 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -5,7 +5,7 @@ -- Authors : Johan Backman -- Hampus Ramström -- --- Display TOML values using pretty printing combinators. +-- Display TOML nodes using pretty printing combinators. -- ----------------------------------------------------------------- module Text.Toml.Pretty ( @@ -25,7 +25,7 @@ import qualified Data.Text as T ppNode :: Node -> Doc ppNode n = case n of (VTable v) -> ppTable v - (VTArray v) -> ppTArray v + (VTArray v) -> ppTArray v "" (VString v) -> ppTomlString v (VInteger v) -> ppInteger $ fromIntegral v (VFloat v) -> ppFloat v @@ -55,29 +55,32 @@ ppBoolean :: Bool -> Doc ppBoolean True = text "true" ppBoolean False = text "false" --- Unclear with fsep, vcat ppArray :: V.Vector Node -> Doc ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) ppTable :: Table -> Doc ppTable tb = findTTitle (M.toList tb) [text ""] where - findTTitle [] ti = brackets $ hcat ti - findTTitle [(t, VTable v)] ti = findTTitle (M.toList v) $ ti ++ [text $ T.unpack t] - findTTitle ((t, VTable v) : xs) ti = (findTTitle (M.toList v) $ ti ++ [text $ T.unpack t]) $$ findTTitle xs ti - findTTitle v ti = (brackets $ hcat $ punctuate (char '.') (tail ti)) $$ vcat (tableToList v) + findTTitle [] ti = brackets $ hcat ti + -- findTTitle ((t, VTArray v) : xs) ti = brackets (brackets $ text $ T.unpack t) $$ (hcat $ map (\x -> findTTitle x [text $ T.unpack t]) (map M.toList $ V.toList v)) $$ findTTitle xs [text $ T.unpack t] + findTTitle ((t, VTArray v) : xs) ti = ppTArray v t + findTTitle [(t, VTable v)] ti = + findTTitle (M.toList v) $ ti ++ [text $ T.unpack t] + findTTitle ((t, VTable v) : xs) ti = + (findTTitle (M.toList v) $ ti ++ [text $ T.unpack t]) $$ findTTitle xs ti + findTTitle v [_] = vcat (tableToList v) + findTTitle v ti = + (brackets (hcat $ punctuate (char '.') (tail ti))) $$ vcat (tableToList v) tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] -ppTArrayWithName :: [(T.Text, Node)] -> Doc -> Doc -ppTArrayWithName ((t, VTable _) : xs) name = ppTArrayWithName xs $ name <+> text (T.unpack t) -ppTArrayWithName l name = brackets name $$ vcat (tableToList l) +ppTArray :: V.Vector Table -> T.Text -> Doc +ppTArray v t = vcat $ map (\x -> doubleBracket pt $$ ppTable x) (V.toList v) + where pt = text $ T.unpack t + doubleBracket x = brackets $ brackets x --- Need fix -ppTArray :: V.Vector Table -> Doc -ppTArray vt = brackets $ fsep $ punctuate comma $ map ppTable (V.toList vt) From eb0e9c758e4259c516950321147473fb3be657c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 9 Mar 2017 20:45:59 +0100 Subject: [PATCH 11/16] Fixed findTTitle for handling table arrays --- src/Text/Toml/Pretty.hs | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index a0afede..a0bfd46 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -59,25 +59,29 @@ ppArray :: V.Vector Node -> Doc ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) ppTable :: Table -> Doc -ppTable tb = findTTitle (M.toList tb) [text ""] - where - findTTitle [] ti = brackets $ hcat ti - -- findTTitle ((t, VTArray v) : xs) ti = brackets (brackets $ text $ T.unpack t) $$ (hcat $ map (\x -> findTTitle x [text $ T.unpack t]) (map M.toList $ V.toList v)) $$ findTTitle xs [text $ T.unpack t] - findTTitle ((t, VTArray v) : xs) ti = ppTArray v t - findTTitle [(t, VTable v)] ti = - findTTitle (M.toList v) $ ti ++ [text $ T.unpack t] - findTTitle ((t, VTable v) : xs) ti = - (findTTitle (M.toList v) $ ti ++ [text $ T.unpack t]) $$ findTTitle xs ti - findTTitle v [_] = vcat (tableToList v) - findTTitle v ti = - (brackets (hcat $ punctuate (char '.') (tail ti))) $$ vcat (tableToList v) +ppTable tb = findTTitle (M.toList tb) True [text ""] + +findTTitle :: [(T.Text, Node)] -> Bool -> [Doc] -> Doc +findTTitle [] b ti = brackets $ hcat ti +-- findTTitle ((t, VTArray v) : xs) ti = brackets (brackets $ text $ T.unpack t) $$ (hcat $ map (\x -> findTTitle x [text $ T.unpack t]) (map M.toList $ V.toList v)) $$ findTTitle xs [text $ T.unpack t] +findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t -- $$ findTTitle xs True ti +findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack ((render (hcat ti)) ++ "." ++ (T.unpack t))) -- $$ findTTitle xs False ti +findTTitle [(t, VTable v)] b ti = + findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] +findTTitle ((t, VTable v) : xs) b ti = + (findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t]) $$ findTTitle xs b ti +findTTitle (v:[]) False ti = (vcat (tableToList [v])) +findTTitle (v:xs) False ti = (vcat (tableToList [v])) $$ findTTitle xs False ti  +findTTitle v b [_] = vcat (tableToList v) +findTTitle v b ti = + (brackets (hcat $ punctuate (char '.') (tail ti))) $$ vcat (tableToList v) tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] ppTArray :: V.Vector Table -> T.Text -> Doc -ppTArray v t = vcat $ map (\x -> doubleBracket pt $$ ppTable x) (V.toList v) +ppTArray v t = vcat $ map (\x -> doubleBracket pt $$ findTTitle x False [pt]) (map M.toList (V.toList v)) where pt = text $ T.unpack t doubleBracket x = brackets $ brackets x From 791bd50089af6dc1d1ff805bc6526968a4ead131 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 9 Mar 2017 21:03:29 +0100 Subject: [PATCH 12/16] Fixed edge case regarding array of tables --- src/Text/Toml/Pretty.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index a0bfd46..63d6604 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -64,8 +64,10 @@ ppTable tb = findTTitle (M.toList tb) True [text ""] findTTitle :: [(T.Text, Node)] -> Bool -> [Doc] -> Doc findTTitle [] b ti = brackets $ hcat ti -- findTTitle ((t, VTArray v) : xs) ti = brackets (brackets $ text $ T.unpack t) $$ (hcat $ map (\x -> findTTitle x [text $ T.unpack t]) (map M.toList $ V.toList v)) $$ findTTitle xs [text $ T.unpack t] -findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t -- $$ findTTitle xs True ti -findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack ((render (hcat ti)) ++ "." ++ (T.unpack t))) -- $$ findTTitle xs False ti +findTTitle ((t, VTArray v) : []) True ti = ppTArray v t +findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t $$ findTTitle xs True ti +findTTitle ((t, VTArray v) : []) False ti = ppTArray v (T.pack ((render (hcat ti)) ++ "." ++ (T.unpack t))) +findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack ((render (hcat ti)) ++ "." ++ (T.unpack t))) $$ findTTitle xs False ti findTTitle [(t, VTable v)] b ti = findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] findTTitle ((t, VTable v) : xs) b ti = From e02fa7db2e6af1e6c76b72e0e6ea1a3749d37fe0 Mon Sep 17 00:00:00 2001 From: Johan Backman Date: Thu, 9 Mar 2017 20:59:39 +0100 Subject: [PATCH 13/16] Some formatting, hlint code --- src/Text/Toml/Pretty.hs | 31 ++++++++++--------------------- 1 file changed, 10 insertions(+), 21 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index a0bfd46..ab2dbad 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -62,32 +62,21 @@ ppTable :: Table -> Doc ppTable tb = findTTitle (M.toList tb) True [text ""] findTTitle :: [(T.Text, Node)] -> Bool -> [Doc] -> Doc -findTTitle [] b ti = brackets $ hcat ti --- findTTitle ((t, VTArray v) : xs) ti = brackets (brackets $ text $ T.unpack t) $$ (hcat $ map (\x -> findTTitle x [text $ T.unpack t]) (map M.toList $ V.toList v)) $$ findTTitle xs [text $ T.unpack t] -findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t -- $$ findTTitle xs True ti +findTTitle [] _ ti = brackets $ hcat ti +findTTitle ((t, VTArray v) : xs) True _ = ppTArray v t -- $$ findTTitle xs True ti findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack ((render (hcat ti)) ++ "." ++ (T.unpack t))) -- $$ findTTitle xs False ti -findTTitle [(t, VTable v)] b ti = - findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] -findTTitle ((t, VTable v) : xs) b ti = - (findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t]) $$ findTTitle xs b ti -findTTitle (v:[]) False ti = (vcat (tableToList [v])) -findTTitle (v:xs) False ti = (vcat (tableToList [v])) $$ findTTitle xs False ti  -findTTitle v b [_] = vcat (tableToList v) -findTTitle v b ti = - (brackets (hcat $ punctuate (char '.') (tail ti))) $$ vcat (tableToList v) +findTTitle [(t, VTable v)] _ ti = findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] +findTTitle ((t, VTable v) : xs) b ti = findTTitle (M.toList v) True (ti ++ [text $ T.unpack t]) $$ findTTitle xs b ti +findTTitle [v] False _ = vcat (tableToList [v]) +findTTitle (v:xs) False ti = vcat (tableToList [v]) $$ findTTitle xs False ti  +findTTitle v _ [_] = vcat (tableToList v) +findTTitle v _ ti = brackets (hcat $ punctuate (char '.') (tail ti)) $$ vcat (tableToList v) tableToList :: [(T.Text, Node)] -> [Doc] tableToList = map (fsep . f) where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] ppTArray :: V.Vector Table -> T.Text -> Doc -ppTArray v t = vcat $ map (\x -> doubleBracket pt $$ findTTitle x False [pt]) (map M.toList (V.toList v)) +ppTArray v t = vcat $ map ((\ x -> dBrackets pt $$ findTTitle x False [pt]) . M.toList) (V.toList v) where pt = text $ T.unpack t - doubleBracket x = brackets $ brackets x - - - - - - - + dBrackets x = brackets $ brackets x From 030cc3eddab5f87c1c2f5c7c7af89abaaf1af144 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 9 Mar 2017 21:57:16 +0100 Subject: [PATCH 14/16] Fixed edge case regarding empty table array --- src/Text/Toml/Pretty.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index e924e05..3a3191a 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -62,11 +62,11 @@ ppTable :: Table -> Doc ppTable tb = findTTitle (M.toList tb) True [text ""] findTTitle :: [(T.Text, Node)] -> Bool -> [Doc] -> Doc -findTTitle [] _ ti = brackets $ hcat ti +findTTitle [] True ti = brackets $ hcat ti findTTitle [(t, VTArray v)] True _ = ppTArray v t findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t $$ findTTitle xs True ti findTTitle [(t, VTArray v)] False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) -findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) $$ findTTitle xs False ti +findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) $$ findTTitle xs False (ti ++ [text "YPPP"]) findTTitle [(t, VTable v)] _ ti = findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] findTTitle ((t, VTable v) : xs) b ti = findTTitle (M.toList v) True (ti ++ [text $ T.unpack t]) $$ findTTitle xs b ti findTTitle [v] False _ = vcat (tableToList [v]) @@ -79,6 +79,7 @@ tableToList = map (fsep . f) where f (x, y) = punctuate (space <> equals) [text $ T.unpack x, ppNode y] ppTArray :: V.Vector Table -> T.Text -> Doc -ppTArray v t = vcat $ map ((\ x -> dBrackets pt $$ findTTitle x False [pt]) . M.toList) (V.toList v) +ppTArray v t | V.toList v == [] = pt + | otherwise = vcat $ map ((\ x -> dBrackets pt $$ findTTitle x False [pt]) . M.toList) (V.toList v) where pt = text $ T.unpack t dBrackets x = brackets $ brackets x From 4e8dca972e457b354c1a6e6a90b53de2715f331c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 9 Mar 2017 22:18:05 +0100 Subject: [PATCH 15/16] Fixed edge case empty document --- src/Text/Toml/Pretty.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index 3a3191a..b0e28d7 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -59,7 +59,8 @@ ppArray :: V.Vector Node -> Doc ppArray va = brackets $ fsep $ punctuate comma $ map ppNode (V.toList va) ppTable :: Table -> Doc -ppTable tb = findTTitle (M.toList tb) True [text ""] +ppTable tb | M.null tb = empty + | otherwise = findTTitle (M.toList tb) True [text ""] findTTitle :: [(T.Text, Node)] -> Bool -> [Doc] -> Doc findTTitle [] True ti = brackets $ hcat ti From eae963a8c58101697ffc20bd4322a72e6ba60d5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hampus=20Ramstr=C3=B6m?= Date: Thu, 16 Mar 2017 10:06:26 +0100 Subject: [PATCH 16/16] Clean version --- src/Text/Toml/Pretty.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Text/Toml/Pretty.hs b/src/Text/Toml/Pretty.hs index b0e28d7..ba68919 100644 --- a/src/Text/Toml/Pretty.hs +++ b/src/Text/Toml/Pretty.hs @@ -67,7 +67,7 @@ findTTitle [] True ti = brackets $ hcat ti findTTitle [(t, VTArray v)] True _ = ppTArray v t findTTitle ((t, VTArray v) : xs) True ti = ppTArray v t $$ findTTitle xs True ti findTTitle [(t, VTArray v)] False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) -findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) $$ findTTitle xs False (ti ++ [text "YPPP"]) +findTTitle ((t, VTArray v) : xs) False ti = ppTArray v (T.pack (render (hcat ti) ++ "." ++ T.unpack t)) $$ findTTitle xs False ti findTTitle [(t, VTable v)] _ ti = findTTitle (M.toList v) True $ ti ++ [text $ T.unpack t] findTTitle ((t, VTable v) : xs) b ti = findTTitle (M.toList v) True (ti ++ [text $ T.unpack t]) $$ findTTitle xs b ti findTTitle [v] False _ = vcat (tableToList [v])