From 6fd24c0b88a38ed0febecd8b64e72d1935f38583 Mon Sep 17 00:00:00 2001 From: Daniel Slapman Date: Sat, 5 Oct 2024 17:52:52 +0200 Subject: [PATCH] Use Data.Sequence instead of Deque --- app/Main.hs | 12 ++++----- opl.csv | 6 +++++ package.yaml | 1 - src/DequePatterns.hs | 12 --------- src/DequeUtils.hs | 23 ---------------- src/Json2Csv.hs | 4 +-- src/Schema.hs | 62 +++++++++++++++++++++----------------------- src/SequenceUtils.hs | 18 +++++++++++++ 8 files changed, 62 insertions(+), 76 deletions(-) create mode 100644 opl.csv delete mode 100644 src/DequePatterns.hs delete mode 100644 src/DequeUtils.hs create mode 100644 src/SequenceUtils.hs diff --git a/app/Main.hs b/app/Main.hs index 4d2458e..6717403 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,15 +13,15 @@ import qualified Data.HashMap.Strict as HM import Data.HashSet (HashSet, empty, intersection, null, union) import qualified Data.HashSet as HS (toList) import Data.IORef +import Data.Sequence (Seq) +import qualified Data.Sequence as Seq (fromList) import Data.Text (Text, intercalate) import qualified Data.Text.IO as TIO -import Deque.Strict (Deque) -import DequeUtils (uniq) -import GHC.Exts (fromList) import Json2Csv import Options.Applicative hiding (empty) import Options.Applicative.Text import Schema +import SequenceUtils (uniq) import System.IO import System.ProgressBar import Prelude hiding (foldl, foldl', map, null, sequence) @@ -75,7 +75,7 @@ main = do (parseAndWriteEntry mkSepString flat schema columns hIn hOut) incProgress pb 1 -computeHeaderMultiline :: PathSetCombine -> Handle -> IO (Deque JsonPath, Int) +computeHeaderMultiline :: PathSetCombine -> Handle -> IO (Seq JsonPath, Int) computeHeaderMultiline combine handle = do currentLineNumber <- newIORef (0 :: Int) pathSet <- newIORef (empty :: HashSet JsonPath) @@ -90,9 +90,9 @@ computeHeaderMultiline combine handle = do modifyIORef' pathSet (combine header) pathes <- readIORef pathSet numberOfLines <- readIORef currentLineNumber - return (fromList . HS.toList $ pathes, numberOfLines) + return (Seq.fromList . HS.toList $ pathes, numberOfLines) -parseAndWriteEntry :: (Deque Text -> Text) -> Bool -> JsonSchema -> Deque Text -> Handle -> Handle -> IO () +parseAndWriteEntry :: (Seq Text -> Text) -> Bool -> JsonSchema -> Seq Text -> Handle -> Handle -> IO () parseAndWriteEntry mkSepString flat schema columns hIn hOut = do line <- LBS.fromStrict <$> BS.hGetLine hIn let (Just parsed) = decode line :: Maybe Value diff --git a/opl.csv b/opl.csv new file mode 100644 index 0000000..ab23808 --- /dev/null +++ b/opl.csv @@ -0,0 +1,6 @@ +b.$.value;a +field b2;field a0 +field b xxx;field a0 +field b1;field a1 +field b2;field a2 +field b xxx;field a2 diff --git a/package.yaml b/package.yaml index 63d0451..271f02e 100644 --- a/package.yaml +++ b/package.yaml @@ -31,7 +31,6 @@ dependencies: - lens - lens-aeson - monad-loops -- deque - hashable - deepseq - optparse-applicative diff --git a/src/DequePatterns.hs b/src/DequePatterns.hs deleted file mode 100644 index e3bc7ca..0000000 --- a/src/DequePatterns.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module DequePatterns where - -import Data.Bool -import Data.Maybe -import Deque.Strict - -pattern d :|| ds <- (uncons -> Just(d, ds)) -pattern D_ <- (null -> True) \ No newline at end of file diff --git a/src/DequeUtils.hs b/src/DequeUtils.hs deleted file mode 100644 index c5f219f..0000000 --- a/src/DequeUtils.hs +++ /dev/null @@ -1,23 +0,0 @@ -module DequeUtils where - -import Data.Foldable (find, toList) -import qualified Data.List as L -import qualified Data.Maybe as Mb (mapMaybe) -import Deque.Strict -import DequePatterns -import GHC.Exts (fromList) -import Prelude hiding (concat, elem, foldl, foldl', foldl1, mapM, null, (++)) - -empty :: Deque a -empty = fromConsAndSnocLists [] [] - -maybeNeq :: Deque a -> Maybe (Deque a) -maybeNeq = find (not . null) . Just - -uniq :: Eq a => Deque a -> Deque a -uniq = fromList . L.nub . toList - -mapMaybe :: (a -> Maybe b) -> Deque a -> Deque b -mapMaybe _ D_ = empty -mapMaybe pred dq = - fromList . Mb.mapMaybe pred . toList $ dq \ No newline at end of file diff --git a/src/Json2Csv.hs b/src/Json2Csv.hs index 9f5f378..67c16ac 100644 --- a/src/Json2Csv.hs +++ b/src/Json2Csv.hs @@ -7,9 +7,9 @@ import qualified Data.Aeson.Key as JK import qualified Data.Aeson.KeyMap as KM import Data.HashSet import Data.Maybe (mapMaybe) +import Data.Sequence ((<|)) import Data.Text (Text, pack) import qualified Data.Vector as V -import Deque.Strict (cons) import HashSetUtils import Schema import TextShow hiding (singleton) @@ -17,7 +17,7 @@ import Prelude hiding (concatMap, foldl, join, map, null) prepend :: JsonPathElement -> HashSet JsonPath -> HashSet JsonPath prepend prefix s | null s = singleton $ pure prefix -prepend prefix path = map (prefix `cons`) path +prepend prefix path = map (prefix <|) path nonEmptyJ :: Value -> Bool nonEmptyJ Null = False diff --git a/src/Schema.hs b/src/Schema.hs index 6646abd..6083076 100644 --- a/src/Schema.hs +++ b/src/Schema.hs @@ -15,13 +15,11 @@ import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HM import Data.Hashable import Data.Maybe hiding (mapMaybe) +import Data.Sequence import Data.Text (Text, intercalate) import Data.Typeable (Typeable) -import Deque.Strict -import DequePatterns -import DequeUtils -import GHC.Exts (fromList) import GHC.Generics (Generic) +import SequenceUtils import Prelude hiding (any, foldl, foldl', head) data JsonPathElement @@ -33,63 +31,63 @@ instance Hashable JsonPathElement instance NFData JsonPathElement -type JsonPath = Deque JsonPathElement +type JsonPath = Seq JsonPathElement data JsonSchemaTree - = PathNode JsonPathElement (Deque JsonSchemaTree) + = PathNode JsonPathElement (Seq JsonSchemaTree) | PathEnd deriving (Eq, Show, Typeable) -type JsonSchema = Deque JsonSchemaTree +type JsonSchema = Seq JsonSchemaTree hasSameRoot :: JsonPath -> JsonSchemaTree -> Bool hasSameRoot path tree = case (tree, path) of - (PathNode el _, h :|| _) | el == h -> True + (PathNode el _, h :<| _) | el == h -> True otherwise -> False toSchemaTree :: JsonPath -> JsonSchemaTree toSchemaTree = \case - D_ -> PathEnd - root :|| path -> PathNode root $ pure $ toSchemaTree path + Empty -> PathEnd + root :<| path -> PathNode root $ pure $ toSchemaTree path (#+) :: JsonSchema -> JsonPath -> JsonSchema (#+) schema path = let append path tree = case (tree, path) of - (t, D_) -> t - (PathNode el D_, h :|| tail) + (t, Empty) -> t + (PathNode el Empty, h :<| tail) | el == h -> PathNode el $ pure $ toSchemaTree tail - (PathNode el branches, h :|| tail) + (PathNode el branches, h :<| tail) | el == h -> PathNode el $ uniq $ branches #+ tail (PathEnd, path) -> toSchemaTree path (t, _) -> t in if any (hasSameRoot path) schema then append path <$> schema - else toSchemaTree path `snoc` schema + else schema |> toSchemaTree path -toSchema :: Deque JsonPath -> JsonSchema +toSchema :: Seq JsonPath -> JsonSchema toSchema = foldl' (#+) empty data JsonValueTree - = ValueRoot JsonPathElement (Deque JsonValueTree) + = ValueRoot JsonPathElement (Seq JsonValueTree) | SingleValue JsonPathElement Value - | ValueArray (Deque Value) - | TreeArray (Deque (Deque JsonValueTree)) + | ValueArray (Seq Value) + | TreeArray (Seq (Seq JsonValueTree)) deriving (Eq, Show, Typeable) -type JsonTree = Deque JsonValueTree +type JsonTree = Seq JsonValueTree extract :: JsonSchema -> Value -> JsonTree extract schema value = let extractTree v schemaTree = case schemaTree of PathEnd -> Nothing - (PathNode el (PathEnd :|| D_)) -> + (PathNode el (PathEnd :<| Empty)) -> case el of Key k -> SingleValue el <$> v ^? (key $ fromText k) - Iterator -> ValueArray <$> (maybeNeq $ fromList $ v ^.. values) + Iterator -> ValueArray <$> (maybeNes $ fromList $ v ^.. values) (PathNode el@(Key k) children) -> let keyValue = (v ^? (key $ fromText k)) childrenExtractors = flip extractTree <$> children @@ -99,20 +97,20 @@ extract schema value = let nodeValues = fromList $ v ^.. values childrenExtractors = flip extractTree <$> children nodeTrees = (\val -> mapMaybe id $ ($ val) <$> childrenExtractors) <$> nodeValues - in TreeArray <$> maybeNeq nodeTrees + in TreeArray <$> maybeNes nodeTrees in mapMaybe id $ (extractTree value <$> schema) -genMaps :: Bool -> JsonPath -> JsonValueTree -> Deque (HashMap Text Value) +genMaps :: Bool -> JsonPath -> JsonValueTree -> Seq (HashMap Text Value) genMaps flat jp jvt = case (flat, jvt) of - (_, ValueRoot jpe trees) -> xfold $ genMaps flat (jpe `snoc` jp) <$> trees - (_, SingleValue jpe value) -> pure $ HM.singleton (jsonPathText $ jpe `snoc` jp) value - (False, ValueArray values) -> HM.singleton (jsonPathText (Iterator `snoc` jp)) <$> values + (_, ValueRoot jpe trees) -> xfold $ genMaps flat (jp |> jpe) <$> trees + (_, SingleValue jpe value) -> pure $ HM.singleton (jsonPathText $ jp |> jpe) value + (False, ValueArray values) -> HM.singleton (jsonPathText (jp |> Iterator)) <$> values (True, ValueArray values) -> HM.singleton (jsonPathText jp) <$> values - (False, TreeArray trees) -> trees >>= (xfold . (genMaps flat (Iterator `snoc` jp) <$>)) + (False, TreeArray trees) -> trees >>= (xfold . (genMaps flat (jp |> Iterator) <$>)) (True, TreeArray trees) -> trees >>= (xfold . (genMaps flat jp <$>)) -generateTuples :: Bool -> JsonTree -> Deque (HashMap Text Value) +generateTuples :: Bool -> JsonTree -> Seq (HashMap Text Value) generateTuples flat jTree = xfold $ genMaps flat empty <$> jTree jsonPathText :: JsonPath -> Text @@ -131,13 +129,13 @@ dropIterators jpath = Key k -> Just $ Key k Iterator -> Nothing -xseq :: (a -> a -> a) -> Deque a -> Deque a -> Deque a -xseq _ va D_ = va -xseq _ D_ vb = vb +xseq :: (a -> a -> a) -> Seq a -> Seq a -> Seq a +xseq _ va Empty = va +xseq _ Empty vb = vb xseq f va vb = do a <- va b <- vb return $ f a b -xfold :: Deque (Deque (HashMap Text Value)) -> Deque (HashMap Text Value) +xfold :: Seq (Seq (HashMap Text Value)) -> Seq (HashMap Text Value) xfold = foldl' (xseq HM.union) empty \ No newline at end of file diff --git a/src/SequenceUtils.hs b/src/SequenceUtils.hs new file mode 100644 index 0000000..d627987 --- /dev/null +++ b/src/SequenceUtils.hs @@ -0,0 +1,18 @@ +module SequenceUtils where + +import Data.Foldable (find, toList) +import qualified Data.List as L +import qualified Data.Maybe as Mb (mapMaybe) +import Data.Sequence +import Prelude hiding (concat, elem, foldl, foldl', foldl1, mapM, null, (++)) + +maybeNes :: Seq a -> Maybe (Seq a) +maybeNes = find (not . null) . Just + +uniq :: Eq a => Seq a -> Seq a +uniq = fromList . L.nub . toList + +mapMaybe :: (a -> Maybe b) -> Seq a -> Seq b +mapMaybe _ Empty = empty +mapMaybe pred dq = + fromList . Mb.mapMaybe pred . toList $ dq \ No newline at end of file