ArticleRecord.hs

{-# LANGUAGE DeriveGeneric, FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings #-}
module GEODE.Metadata.ArticleRecord
  ( Work(..)
  , ArticleRecord(..)
  , relativePath
  , uid ) where

import Data.Aeson ((.=), FromJSON(..), ToJSON(..))
import Data.Aeson.KeyMap as KeyMap (fromList)
import Data.Csv (DefaultOrdered(..), FromNamedRecord(..), ToNamedRecord(..))
import GEODE.Metadata.Record (Record(..))
import GEODE.Metadata.Types (ToJSONObject(..))
import GEODE.Metadata.Work (Work(..))
import GHC.Generics (Generic)
import System.FilePath ((</>), (<.>))
import Text.Printf (printf)

data ArticleRecord = ArticleRecord
  { work :: Work
  , volume :: Int
  , article :: Int } deriving (Eq, Ord, Generic, Show)

instance FromNamedRecord ArticleRecord
instance ToNamedRecord ArticleRecord
instance DefaultOrdered ArticleRecord

instance ToJSONObject ArticleRecord where
  toJSONObject (ArticleRecord {work, volume, article}) = KeyMap.fromList
    [ ("work", toJSON work)
    , ("volume", toJSON volume)
    , ("article", toJSON article) ]
  toJSONPairs (ArticleRecord {work, volume, article}) =
      "work" .= work
    <> "volume" .= volume
    <> "article" .= article

instance FromJSON ArticleRecord

instance Record ArticleRecord where
  uid (ArticleRecord {work, volume, article}) =
    printf "%s_%d_%d" (show $ work) volume article

  relativePath (ArticleRecord {work, volume, article}) extension =
    (show work) </> ("T" <> show volume) </> (show article) <.> extension