Skip to content
Snippets Groups Projects
Commit c1195363 authored by Alice Brenon's avatar Alice Brenon
Browse files

Follow type renaming in ghc-geode

parent ada94702
No related branches found
No related tags found
No related merge requests found
...@@ -6,42 +6,42 @@ import Data.Foldable (toList) ...@@ -6,42 +6,42 @@ import Data.Foldable (toList)
import Data.Map (Map, (!?)) import Data.Map (Map, (!?))
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import GEODE.Metadata (Contrastive(..), Entry, Has(..), MultiText(..), PrimaryKey, type(@)(..), indexBy, readNamedTsv, tsvFile) import GEODE.Metadata (Contrastive(..), Entry, Has(..), MultiText(..), ArticleRecord, type(@)(..), indexBy, readNamedTsv, tsvFile)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (die) import System.Exit (die)
import System.Script (syntax) import System.Script (syntax)
leftJoin :: forall a b c t. (Foldable t, Functor t, Has PrimaryKey a, Has PrimaryKey b) => leftJoin :: forall a b c t. (Foldable t, Functor t, Has ArticleRecord a, Has ArticleRecord b) =>
(a -> Maybe b -> c) -> t a -> t b -> t c (a -> Maybe b -> c) -> t a -> t b -> t c
leftJoin f left right = outputRow <$> left leftJoin f left right = outputRow <$> left
where where
indexed :: Map PrimaryKey b indexed :: Map ArticleRecord b
indexed = indexBy get right indexed = indexBy get right
outputRow leftLine = outputRow leftLine =
f leftLine (indexed !? get leftLine) f leftLine (indexed !? get leftLine)
rightJoin :: (Foldable t, Functor t, Has PrimaryKey a, Has PrimaryKey b) => rightJoin :: (Foldable t, Functor t, Has ArticleRecord a, Has ArticleRecord b) =>
(Maybe a -> b -> c) -> t a -> t b -> t c (Maybe a -> b -> c) -> t a -> t b -> t c
rightJoin f left right = leftJoin (flip f) right left rightJoin f left right = leftJoin (flip f) right left
join :: forall a b c t. (Foldable t, Functor t, Has PrimaryKey a, Has PrimaryKey b) => join :: forall a b c t. (Foldable t, Functor t, Has ArticleRecord a, Has ArticleRecord b) =>
(a -> b -> c) -> t a -> t b -> [c] (a -> b -> c) -> t a -> t b -> [c]
join f left right = catMaybes . toList $ outputRow <$> left join f left right = catMaybes . toList $ outputRow <$> left
where where
indexed :: Map PrimaryKey b indexed :: Map ArticleRecord b
indexed = indexBy get right indexed = indexBy get right
outputRow leftLine = outputRow leftLine =
f leftLine <$> (indexed !? get leftLine) f leftLine <$> (indexed !? get leftLine)
merge :: (PrimaryKey @ Entry) -> (PrimaryKey @ Contrastive) -> (PrimaryKey @ Entry @ Contrastive) merge :: (ArticleRecord @ Entry) -> (ArticleRecord @ Contrastive) -> (ArticleRecord @ Entry @ Contrastive)
merge (pK :@: e) (_ :@: c) = pK :@: e :@: c merge (pK :@: e) (_ :@: c) = pK :@: e :@: c
tag :: Text -> Maybe PrimaryKey -> (PrimaryKey @ Entry @ Contrastive) -> (PrimaryKey @ Entry @ Contrastive) tag :: Text -> Maybe ArticleRecord -> (ArticleRecord @ Entry @ Contrastive) -> (ArticleRecord @ Entry @ Contrastive)
tag _ Nothing l = l tag _ Nothing l = l
tag name (Just _) (pK :@: e :@: contr) = tag name (Just _) (pK :@: e :@: contrastive) =
pK :@: e :@: contr { subCorpus = MultiText (name : subCorpora) } pK :@: e :@: contrastive { subCorpus = MultiText (name : subCorpora) }
where where
MultiText subCorpora = subCorpus contr MultiText subCorpora = subCorpus contrastive
main :: IO () main :: IO ()
main = getArgs >>= run main = getArgs >>= run
......
...@@ -6,12 +6,12 @@ import Control.Monad.Except (ExceptT(..), runExceptT) ...@@ -6,12 +6,12 @@ import Control.Monad.Except (ExceptT(..), runExceptT)
import Data.Map ((!?)) import Data.Map ((!?))
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Vector (Vector, toList) import Data.Vector (Vector, toList)
import GEODE.Metadata (Entry, Has(..), PrimaryKey, type(@), indexBy, readNamedTsv, tsvFile) import GEODE.Metadata (Entry, Has(..), ArticleRecord, type(@), indexBy, readNamedTsv, tsvFile)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (die) import System.Exit (die)
import System.Script (syntax) import System.Script (syntax)
getMeta :: Vector PrimaryKey -> Vector (PrimaryKey @ Entry) -> [(PrimaryKey @ Entry)] getMeta :: Vector ArticleRecord -> Vector (ArticleRecord @ Entry) -> [(ArticleRecord @ Entry)]
getMeta coords meta = catMaybes ((indexed !?) <$> toList coords) getMeta coords meta = catMaybes ((indexed !?) <$> toList coords)
where where
indexed = indexBy get meta indexed = indexBy get meta
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment