Various adjustments: declaring a new type constructor @, cleaning imports and...

Various adjustments: declaring a new type constructor @, cleaning imports and exports, improving design of Authors/Domains metadata

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
 

lib/GEODE/Metadata/Contrastive.hs

-{-# 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" ]

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
 

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)