src/Phylomemy/Indexation.hs

   1 {-# OPTIONS_GHC -Wno-orphans #-}
   2
   3 module Phylomemy.Indexation where
   4
   5 import Data.Eq (Eq)
   6 import Data.Map.Strict qualified as Map
   7 import Data.Monoid (Monoid (..))
   8 import Data.Ord (Ord)
   9 import Data.Set qualified as Set
  10 import Data.Text.Short (ShortText)
  11 import Data.Time (UTCTime)
  12 import Data.Validity (Validity (..), declare, delve, trivialValidation)
  13 import Data.Validity.Map ()
  14 import Data.Validity.Set ()
  15 import Data.Validity.Time ()
  16 import GHC.Generics (Generic)
  17 import Text.Show (Show)
  18
  19 type Date = UTCTime
  20
  21 -- | A contiguous sequence of n terms
  22 newtype Ngram = Ngram ShortText
  23   deriving (Eq, Generic, Ord)
  24   deriving stock (Show)
  25
  26 instance Validity Ngram where
  27   validate = trivialValidation
  28
  29 -- | A 'Root' is a set of `Ngram`s conveying the same meaning
  30 -- (according to the analyst).
  31 data Root = Root
  32   { rootLabel :: Ngram
  33   , rootEquivalents :: Set.Set Ngram
  34   }
  35   deriving (Eq, Generic, Ord, Show)
  36
  37 instance Validity Root where
  38   validate r =
  39     mconcat
  40       [ delve "rootLabel" (rootLabel r)
  41       , declare
  42           "The rootLabel is not a member of the rootEquivalents"
  43           (Set.notMember (rootLabel r) (rootEquivalents r))
  44       , delve "rootEquivalents" (rootEquivalents r)
  45       ]
  46
  47 type Foundations = Set.Set Root
  48
  49 data Document = Document
  50   { documentDate :: Date
  51   , documentRoots :: Map.Map Root ()
  52   }
  53   deriving (Eq, Generic, Show)
  54 instance Validity Document
  55
  56 data Period = Period
  57   { periodBegin :: Date
  58   , periodEnd :: Date
  59   -- , periodScales :: [Scale]
  60   }
  61   deriving (Eq, Generic, Show)
  62 instance Validity Period
  63
  64 type Vocabulary = Map.Map Root ()