diff --git a/lib/GEODE/Metadata.hs b/lib/GEODE/Metadata.hs index 34515a138e651c2a3aed4096d1aaa193b96d71a9..d07145b197b50f89ae72d6822e94893324ff23d5 100644 --- a/lib/GEODE/Metadata.hs +++ b/lib/GEODE/Metadata.hs @@ -9,13 +9,11 @@ module GEODE.Metadata , module Types , groupBy , indexBy - , list , sortBy ) where import Data.Foldable as Foldable (toList) import Data.List (sortOn) import Data.Map.Strict as Map (Map, alter, empty, insert, toList) -import Data.Text as Text (Text, intercalate, unpack) import GEODE.Metadata.Contrastive as Contrastive import GEODE.Metadata.Entry as Entry ( Entry(headWord, name, page), newEntry, normalize ) @@ -26,9 +24,6 @@ import GEODE.Metadata.TSV.Header as TSV_Header ( DefaultFields(..), HasDefaultHeader(..), WithDefaultHeader(..), glue ) import GEODE.Metadata.Types as Types -list :: [Text] -> String -list ts = Text.unpack $ ":" <> intercalate ":" ts <> ":" - sortBy :: (Foldable t, Ord k) => (a -> k) -> t a -> [a] sortBy field = sortOn field . Foldable.toList diff --git a/lib/GEODE/Metadata/Contrastive.hs b/lib/GEODE/Metadata/Contrastive.hs index 5a437995e0c26dac35f8c3818132a76545fab691..f6149ce9c2b0a347d5d3a87ad0c111de5f7b19a2 100644 --- a/lib/GEODE/Metadata/Contrastive.hs +++ b/lib/GEODE/Metadata/Contrastive.hs @@ -1,25 +1,44 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module GEODE.Metadata.Contrastive - ( Authors(..) - , Domains(..) ) where + ( Contrastive(..) + , MultiText(..) + , formatList ) where -import Data.Csv (Field, FromField(..), Parser, ToField(..)) -import Data.Text (Text, intercalate, splitOn) -newtype Authors = Authors - { getAuthors :: [Text] } deriving Show -newtype Domains = Domains - { getDomains :: [Text] } deriving Show +import Data.Csv + ( FromField(..), FromNamedRecord(..), ToNamedRecord(..), ToField(..) ) +import Data.Text (Text, intercalate, splitOn, uncons, unsnoc) +import GEODE.Metadata.TSV.Header (DefaultFields(..), HasDefaultHeader(..)) +import GHC.Generics (Generic) -sepBy :: Text -> Field -> Parser [Text] -sepBy s = fmap (splitOn s) . parseField +newtype MultiText = MultiText + { getList :: [Text] } deriving (Show) -instance FromField Authors where - parseField = fmap Authors . sepBy " & " -instance ToField Authors where - toField = toField . intercalate " & ". getAuthors +formatList :: MultiText -> Text +formatList = colonFormat . getList + where + colonFormat ts = ":" <> intercalate ":" ts <> ":" -instance FromField Domains where - parseField = fmap Domains . sepBy " | " -instance ToField Domains where - toField = toField . intercalate " | ". getDomains +instance FromField MultiText where + parseField f = parseField f >>= checkAndSplit + where + popBoundaries t0 = do + (firstChar,t1) <- uncons t0 + (middle,lastChar) <- unsnoc t1 + pure (firstChar,middle,lastChar) + checkAndSplit t = + case popBoundaries t of + Just (':',fields,':') -> pure.MultiText $ splitOn ":" fields + _ -> mempty +instance ToField MultiText where + toField = toField . formatList + +data Contrastive = Contrastive + { authors :: MultiText + , domains :: MultiText } deriving (Generic, Show) + +instance FromNamedRecord Contrastive +instance ToNamedRecord Contrastive + +instance HasDefaultHeader Contrastive where + defaultFields = DefaultFields [ "authors", "domains" ] diff --git a/lib/GEODE/Metadata/PrimaryKey.hs b/lib/GEODE/Metadata/PrimaryKey.hs index 2bfffa76c24bf604b7a4b585469885735178d8bc..037c4a5d126149179f058a87a14bbcd6102d2961 100644 --- a/lib/GEODE/Metadata/PrimaryKey.hs +++ b/lib/GEODE/Metadata/PrimaryKey.hs @@ -7,8 +7,7 @@ module GEODE.Metadata.PrimaryKey import Data.Csv (FromField(..), FromNamedRecord(..), ToNamedRecord(..), ToField(..)) import GEODE.Metadata.Types (Has(..)) -import GEODE.Metadata.TSV.Header - (DefaultFields(..), HasDefaultHeader(..), HasDefaultHeader(..)) +import GEODE.Metadata.TSV.Header (DefaultFields(..), HasDefaultHeader(..)) import GHC.Generics (Generic) import System.FilePath ((</>), (<.>)) import Text.Printf (printf) @@ -39,7 +38,7 @@ uid a = printf "%s_%d_%d" (show $ book) tome rank relativePath :: Has PrimaryKey a => a -> String -> FilePath relativePath a extension = - (show book) </> (show tome) </> (show rank) <.> extension + (show book) </> ("T" <> show tome) </> (show rank) <.> extension where PrimaryKey {book, tome, rank} = get a diff --git a/lib/GEODE/Metadata/Types.hs b/lib/GEODE/Metadata/Types.hs index d8ecc47c02e4eb87827eeb7ca304fecf5fcc1965..362be18e9626830368a66fe8879a155d5f825747 100644 --- a/lib/GEODE/Metadata/Types.hs +++ b/lib/GEODE/Metadata/Types.hs @@ -6,19 +6,21 @@ module GEODE.Metadata.Types import Data.Csv (FromNamedRecord(..), ToNamedRecord(..)) import Data.HashMap.Strict (union) +infixr 9 @ +infixr 9 :@: +data a @ b = a :@: b + class Has a b where get :: b -> a -instance Has a (a, b) where - get = fst +instance Has a a where + get = id -instance Has a b => Has a (b, c) where - get = get . fst +instance Has a c => Has a (b @ c) where + get (_ :@: c) = get c -instance {-# OVERLAPS #-} Has a (b, a) where - get = snd - -data a @ b = a :@: b +instance {-# OVERLAPS #-} Has a (a @ b) where + get (a :@: _) = a instance (ToNamedRecord a, ToNamedRecord b) => ToNamedRecord (a @ b) where toNamedRecord (a :@: b) = union (toNamedRecord a) (toNamedRecord b)