From 3a2b7ff4f05e545ab015b974096c0cb57043bfcd Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Wed, 17 Jan 2024 09:32:11 +0100
Subject: [PATCH] Trim TSV.Header from HasDefaultHeader, already covered by
DefaultOrdered from cassava
---
geode.cabal | 2 +-
lib/GEODE/Metadata.hs | 1 -
lib/GEODE/Metadata/ArticleRecord.hs | 7 ++----
lib/GEODE/Metadata/Contrastive.hs | 8 +++---
lib/GEODE/Metadata/Entry.hs | 8 ++----
lib/GEODE/Metadata/TSV/Header.hs | 31 ++++++++----------------
lib/GEODE/Metadata/Types.hs | 7 ++++--
test/GEODE/Metadata/TestArticleRecord.hs | 2 +-
test/GEODE/Metadata/TestEntry.hs | 3 +--
9 files changed, 25 insertions(+), 44 deletions(-)
diff --git a/geode.cabal b/geode.cabal
index 03309af..ba9c94f 100644
--- a/geode.cabal
+++ b/geode.cabal
@@ -24,7 +24,6 @@ library
exposed-modules: GEODE.Metadata
, GEODE.Metadata.Entry
, GEODE.Metadata.SplitContext
- , GEODE.Metadata.TSV.Header
, GEODE.Options
-- Modules included in this library but not exported.
@@ -32,6 +31,7 @@ library
, GEODE.Metadata.ArticleRecord
, GEODE.Metadata.Record
, GEODE.Metadata.TSV
+ , GEODE.Metadata.TSV.Header
, GEODE.Metadata.Types
, GEODE.Metadata.Work
diff --git a/lib/GEODE/Metadata.hs b/lib/GEODE/Metadata.hs
index 4376658..2d0dc5d 100644
--- a/lib/GEODE/Metadata.hs
+++ b/lib/GEODE/Metadata.hs
@@ -24,7 +24,6 @@ import GEODE.Metadata.Record as Record
import GEODE.Metadata.SplitContext as SplitContext hiding (get, page, rank)
import GEODE.Metadata.TSV as TSV
import GEODE.Metadata.TSV.Header as TSV_Header
- ( DefaultFields(..), HasDefaultHeader(..), WithDefaultHeader(..), glue )
import GEODE.Metadata.Types as Types
import GEODE.Metadata.Work as Work
diff --git a/lib/GEODE/Metadata/ArticleRecord.hs b/lib/GEODE/Metadata/ArticleRecord.hs
index b78b70a..1337b74 100644
--- a/lib/GEODE/Metadata/ArticleRecord.hs
+++ b/lib/GEODE/Metadata/ArticleRecord.hs
@@ -7,10 +7,9 @@ module GEODE.Metadata.ArticleRecord
import Data.Aeson ((.=), FromJSON(..), ToJSON(..))
import Data.Aeson.KeyMap as KeyMap (fromList)
-import Data.Csv (FromNamedRecord(..), ToNamedRecord(..))
+import Data.Csv (DefaultOrdered(..), FromNamedRecord(..), ToNamedRecord(..))
import GEODE.Metadata.Record (Record(..))
import GEODE.Metadata.Types (ToJSONObject(..))
-import GEODE.Metadata.TSV.Header (DefaultFields(..), HasDefaultHeader(..))
import GEODE.Metadata.Work (Work(..))
import GHC.Generics (Generic)
import System.FilePath ((</>), (<.>))
@@ -23,6 +22,7 @@ data ArticleRecord = ArticleRecord
instance FromNamedRecord ArticleRecord
instance ToNamedRecord ArticleRecord
+instance DefaultOrdered ArticleRecord
instance ToJSONObject ArticleRecord where
toJSONObject (ArticleRecord {work, volume, article}) = KeyMap.fromList
@@ -42,6 +42,3 @@ instance Record ArticleRecord where
relativePath (ArticleRecord {work, volume, article}) extension =
(show work) </> ("T" <> show volume) </> (show article) <.> extension
-
-instance HasDefaultHeader ArticleRecord where
- defaultFields = DefaultFields [ "work", "volume", "article" ]
diff --git a/lib/GEODE/Metadata/Contrastive.hs b/lib/GEODE/Metadata/Contrastive.hs
index 69d9c48..b044e0c 100644
--- a/lib/GEODE/Metadata/Contrastive.hs
+++ b/lib/GEODE/Metadata/Contrastive.hs
@@ -5,9 +5,9 @@ module GEODE.Metadata.Contrastive
, formatList ) where
import Data.Csv
- ( FromField(..), FromNamedRecord(..), ToNamedRecord(..), ToField(..) )
+ ( DefaultOrdered(..), FromField(..), FromNamedRecord(..), ToNamedRecord(..)
+ , ToField(..) )
import Data.Text (Text, intercalate, splitOn, uncons, unsnoc)
-import GEODE.Metadata.TSV.Header (DefaultFields(..), HasDefaultHeader(..))
import GHC.Generics (Generic)
newtype MultiText = MultiText
@@ -39,8 +39,6 @@ data Contrastive = Contrastive
, domains :: MultiText
, subCorpus :: MultiText } deriving (Generic, Show)
+instance DefaultOrdered Contrastive
instance FromNamedRecord Contrastive
instance ToNamedRecord Contrastive
-
-instance HasDefaultHeader Contrastive where
- defaultFields = DefaultFields [ "authors", "domains", "subCorpus" ]
diff --git a/lib/GEODE/Metadata/Entry.hs b/lib/GEODE/Metadata/Entry.hs
index 3a3ae44..f9e568b 100644
--- a/lib/GEODE/Metadata/Entry.hs
+++ b/lib/GEODE/Metadata/Entry.hs
@@ -5,11 +5,9 @@ module GEODE.Metadata.Entry
, normalize ) where
import Data.Char (isAlphaNum, isSpace, isUpper, toLower)
-import Data.Csv (FromNamedRecord(..), ToNamedRecord(..))
+import Data.Csv (DefaultOrdered(..), FromNamedRecord(..), ToNamedRecord(..))
import Data.Text as Text (Text, concat, foldl', pack, snoc)
import GEODE.Metadata.SplitContext (Field(..), SplitContext(..), next)
-import GEODE.Metadata.TSV.Header
- (DefaultFields(..), HasDefaultHeader(..), HasDefaultHeader(..))
import GHC.Generics (Generic)
data Entry = Entry
@@ -17,12 +15,10 @@ data Entry = Entry
, name :: Text
, page :: Int } deriving (Generic, Show)
+instance DefaultOrdered Entry
instance FromNamedRecord Entry
instance ToNamedRecord Entry
-instance HasDefaultHeader Entry where
- defaultFields = DefaultFields [ "headword", "name", "page" ]
-
normalize :: Text -> Text
normalize = Text.foldl' appendIf mempty
where
diff --git a/lib/GEODE/Metadata/TSV/Header.hs b/lib/GEODE/Metadata/TSV/Header.hs
index 6e084e6..7d9157d 100644
--- a/lib/GEODE/Metadata/TSV/Header.hs
+++ b/lib/GEODE/Metadata/TSV/Header.hs
@@ -1,38 +1,27 @@
{-# LANGUAGE ExplicitNamespaces, ScopedTypeVariables, TypeOperators #-}
module GEODE.Metadata.TSV.Header
- ( DefaultFields(..)
- , HasDefaultHeader(..)
- , WithDefaultHeader(..)
+ ( WithDefaultHeader(..)
, for
, getHeader
, glue ) where
-import Data.ByteString.Char8 as StrictByteString (pack)
-import Data.Csv (Header, ToNamedRecord(..), ToRecord(..))
+import Data.Csv (DefaultOrdered(..), Header, ToNamedRecord(..), ToRecord(..))
import Data.HashMap.Strict ((!))
-import Data.Vector (fromList)
import GEODE.Metadata.Types (type (@)(..))
newtype WithDefaultHeader a = WithDefaultHeader a
-newtype DefaultFields a = DefaultFields [String]
-class HasDefaultHeader a where
- defaultFields :: DefaultFields a
-instance (HasDefaultHeader a, HasDefaultHeader b) => HasDefaultHeader (a @ b) where
- defaultFields = DefaultFields (a ++ b)
- where
- DefaultFields a = (defaultFields :: DefaultFields a)
- DefaultFields b = (defaultFields :: DefaultFields b)
+-- | An alias to shorten and make more intuitive the magic of
+-- the DefaultOrdered class type
+getHeader :: DefaultOrdered a => a -> Header
+getHeader = headerOrder
-getHeader :: forall a. HasDefaultHeader a => a -> Header
-getHeader _ = StrictByteString.pack <$> fromList fields
- where
- DefaultFields fields = (defaultFields :: DefaultFields a)
-
-for :: HasDefaultHeader a => a
+-- | This is just `undefined`, but nicer to read and making more sense with the
+-- type notation `(for :: SomeTypeOfYours)`
+for :: DefaultOrdered a => a
for = undefined
-instance (HasDefaultHeader a, ToNamedRecord a) => ToRecord (WithDefaultHeader a) where
+instance (DefaultOrdered a, ToNamedRecord a) => ToRecord (WithDefaultHeader a) where
toRecord (WithDefaultHeader a) = (toNamedRecord a !) <$> getHeader a
glue :: a -> b -> WithDefaultHeader (a @ b)
diff --git a/lib/GEODE/Metadata/Types.hs b/lib/GEODE/Metadata/Types.hs
index 881168a..e8ff47a 100644
--- a/lib/GEODE/Metadata/Types.hs
+++ b/lib/GEODE/Metadata/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExplicitNamespaces, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ExplicitNamespaces, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
module GEODE.Metadata.Types
( Has(..)
, ToJSONObject(..)
@@ -6,7 +6,7 @@ module GEODE.Metadata.Types
import Data.Aeson (FromJSON(..), Object, Series, ToJSON(..), Value(..), pairs)
import Data.Aeson.KeyMap as Object (union)
-import Data.Csv (FromNamedRecord(..), ToNamedRecord(..))
+import Data.Csv (DefaultOrdered(..), FromNamedRecord(..), ToNamedRecord(..))
import Data.HashMap.Strict as Hash (union)
infixl 9 @
@@ -25,6 +25,9 @@ instance Has a b => Has a (b @ c) where
instance {-# OVERLAPS #-} Has b (a @ b) where
get (_ :@: b) = b
+instance (DefaultOrdered a, DefaultOrdered b) => DefaultOrdered (a @ b) where
+ headerOrder _ = headerOrder (undefined :: a) <> headerOrder (undefined :: b)
+
instance (ToNamedRecord a, ToNamedRecord b) => ToNamedRecord (a @ b) where
toNamedRecord (a :@: b) = Hash.union (toNamedRecord a) (toNamedRecord b)
diff --git a/test/GEODE/Metadata/TestArticleRecord.hs b/test/GEODE/Metadata/TestArticleRecord.hs
index 87ade55..139e4d5 100644
--- a/test/GEODE/Metadata/TestArticleRecord.hs
+++ b/test/GEODE/Metadata/TestArticleRecord.hs
@@ -5,7 +5,7 @@ import Data.Csv (ToNamedRecord(..))
import Data.Foldable (toList)
import Data.HashMap.Strict ((!?))
import GEODE.Metadata (Work(..), ArticleRecord(..))
-import GEODE.Metadata.TSV.Header (getHeader, for)
+import GEODE.Metadata (getHeader, for)
import Test.HUnit (Test(..), (~?=))
import Test.HUnit.Extra (isJust)
diff --git a/test/GEODE/Metadata/TestEntry.hs b/test/GEODE/Metadata/TestEntry.hs
index bf31fc7..3b4f92b 100644
--- a/test/GEODE/Metadata/TestEntry.hs
+++ b/test/GEODE/Metadata/TestEntry.hs
@@ -5,9 +5,8 @@ import Data.Csv (ToNamedRecord(..))
import Data.Foldable (toList)
import Data.HashMap.Strict ((!?))
import Data.Text (dropEnd)
-import GEODE.Metadata (evalSplit, newEntry, normalize)
+import GEODE.Metadata (evalSplit, for, getHeader, newEntry, normalize)
import GEODE.Metadata.Entry (Entry(..))
-import GEODE.Metadata.TSV.Header (getHeader, for)
import Test.HUnit (Test(..), (~?=))
import Test.HUnit.Extra (isJust)
--
GitLab