Newer
Older
Alice Brenon
committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}
module GEODE.Metadata.PrimaryKey.Paragraph
( ParagraphPK(..) ) where
import Data.Aeson ((.=), ToJSON(..), object, pairs)
import Data.Csv
( (.:), FromNamedRecord(..), ToNamedRecord(..), namedField, namedRecord )
import GEODE.Metadata.File (File(..))
import GEODE.Metadata as Article
(DefaultFields(..), HasDefaultHeader(..), PrimaryKey(PrimaryKey, book, tome), uid, relativePath)
import qualified GEODE.Metadata as Article (PrimaryKey(rank))
import System.FilePath ((</>), (<.>), dropExtension)
import Text.Printf (printf)
data ParagraphPK = ParagraphPK
{ article :: PrimaryKey
, rank :: Int } deriving (Eq, Ord, Show)
instance FromNamedRecord ParagraphPK where
parseNamedRecord nr = ParagraphPK
<$> (PrimaryKey <$> nr .: "book" <*> nr .: "tome" <*> nr .: "article#")
<*> nr .: "paragraph#"
instance ToNamedRecord ParagraphPK where
toNamedRecord (ParagraphPK {article, rank}) = namedRecord
[ namedField "book" (book article)
, namedField "tome" (tome article)
, namedField "article#" (Article.rank article)
, namedField "paragraph#" rank ]
instance File ParagraphPK where
uid (ParagraphPK {article, rank}) = printf "%s_%d" (Article.uid article) rank
relativePath (ParagraphPK {article, rank}) extension =
articleDirectory </> (show rank) <.> extension
where
articleDirectory = dropExtension (Article.relativePath article "")
instance HasDefaultHeader ParagraphPK where
defaultFields = DefaultFields (["book", "tome", "article#", "paragraph#"])
instance ToJSON ParagraphPK where
toJSON (ParagraphPK {article, rank}) = object
[ "book" .= book article
, "tome" .= tome article
, "article#" .= Article.rank article
, "paragraph#" .= rank ]
toEncoding (ParagraphPK {article, rank}) = pairs
( "book" .= book article
<> "tome" .= tome article
<> "article#" .= Article.rank article
<> "paragraph#" .= rank )