{- This file is part of berenice.
 -
 - Written in 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Data.Berenice
    (
    )
where

import Control.Applicative ((<|>))
import Control.Monad ((>=>), when, guard)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
import Control.Monad.Trans.State.Strict
import Data.Bifunctor (bimap, first, second)
import Data.ByteString (ByteString)
import Data.Either (partitionEithers)
import Data.Foldable (fold, foldl', foldlM, foldrM, asum, minimumBy)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import Data.Int (Int64)
import Data.List (sortBy, sortOn)
import Data.List.NonEmpty (NonEmpty (..), (<|), nonEmpty)
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe, catMaybes)
import Data.Scientific
import Data.Vector (Vector)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Traversable (for)
import GHC.Generics (Generic)
import Network.IRI hiding (Ref)
import Numeric (showEFloat)
import Text.Read (readMaybe)

import qualified Data.ByteString as B (length)
import qualified Data.ByteString.Char8 as BC (pack)
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as S
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Network.IRI as U (Ref)

import Data.Berenice.TH

-- Tuple utils

(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
(f &&& g) x = (f x, g x)

-- Maybe utils

partitionMaybes :: [(Maybe a, b)] -> ([(a, b)], [b])
partitionMaybes = foldr f ([], [])
    where
    f (Nothing, y) (ps, ys) = (ps         , y : ys)
    f (Just x , y) (ps, ys) = ((x, y) : ps, ys)

partitionMaybesNE
    :: NonEmpty (Maybe a, b)
    -> Either (NonEmpty (a, b), [b]) ([(a, b)], NonEmpty b)
partitionMaybesNE ((mx, y) :| zs) =
    let (ps, ys) = partitionMaybes zs
    in  case mx of
            Nothing -> Right (ps          , y :| ys)
            Just x  -> Left  ((x, y) :| ps, ys)

-- Foldable utils

-- | Like 'foldl'', except it checks each intermediate result (including the
-- initial value passed) with the given predicate. If the predicate gives
-- False, then that intermediate result is returned and the rest of the
-- structure isn't observed, allowing for early termination.
--
-- >>> foldlWhile' (< 200) (+) 0 $ repeat 31
-- 217
foldlWhile' :: Foldable f => (b -> Bool) -> (b -> a -> b) -> b -> f a -> b
foldlWhile' p f i xs = foldr f' id xs i
    where
    f' x k z =
        if p z
            then k $! f z x
            else z

-- | Like 'foldlWhile'', except folding stops when the predicate returns 'True'
-- rather than False. In other words, @foldlUntil' p@ is the same as
-- @foldlWhile' $ not . p@. Fold while checking each intermediate result
-- (including the initial value passed) with a predicate, stopping the folding
-- if it returns True. In other words, return the first intermediate result for
-- which the predicate holds (or the result of the full fold, if the predicate
-- returns 'False' all the way).
--
-- >>> foldlUntil' (> 106) (+) 18 $ repeat 19
-- 113
foldlUntil' :: Foldable f => (b -> Bool) -> (b -> a -> b) -> b -> f a -> b
foldlUntil' p = foldlWhile' $ not . p

-- NonEmpty utils

extract :: (a -> b) -> (a -> c) -> NonEmpty a -> (b, NonEmpty c)
extract f g (head :| tail) = (f head, g head :| map g tail)

groupAllExtract :: Ord b => (a -> b) -> (a -> c) -> [a] -> [(b, NonEmpty c)]
groupAllExtract f g = map (extract f g) . NE.groupAllWith f

groupAllExtract1
    :: Ord b => (a -> b) -> (a -> c) -> NonEmpty a -> NonEmpty (b, NonEmpty c)
groupAllExtract1 f g = NE.map (extract f g) . NE.groupAllWith1 f

groupAllExtractDefault
    :: Ord b => b -> (a -> Maybe b) -> (a -> c) -> [a] -> [(b, NonEmpty c)]
groupAllExtractDefault d mf g l =
    let (justs, nothings) = partitionMaybes $ map (mf &&& g) l
        groups = groupAllExtract fst snd justs
    in  case nonEmpty nothings of
            Nothing        -> groups
            Just nothings' ->
                case update fst (second (<> nothings')) d groups of
                    Just groups' -> groups'
                    Nothing      -> (d, nothings') : groups
    where
    update :: Ord b => (a -> b) -> (a -> a) -> b -> [a] -> Maybe [a]
    update p f x l =
        let (lt, eqgt) = span ((< x) . p) l
        in  case eqgt of
                []   -> Nothing
                y:ys ->
                    if x == p y
                        then Just $ lt ++ f y : ys
                        else Nothing

groupAllExtractDefault1
    :: Ord b
    => b
    -> (a -> Maybe b)
    -> (a -> c)
    -> NonEmpty a
    -> NonEmpty (b, NonEmpty c)
groupAllExtractDefault1 d mf g l =
    case partitionMaybesNE $ NE.map (mf &&& g) l of
        Left (justs, nothings) ->
            let groups = groupAllExtract1 fst snd justs
            in  case nonEmpty nothings of
                    Nothing        -> groups
                    Just nothings' -> insertNothings nothings' groups
        Right (justs, nothings) ->
            case nonEmpty justs of
                Nothing -> (d, nothings) :| []
                Just justs' ->
                    let groups = groupAllExtract1 fst snd justs'
                    in  insertNothings nothings groups
    where
    update
        :: Ord b
        => (a -> b) -> (a -> a) -> b -> NonEmpty a -> Maybe (NonEmpty a)
    update p f x l =
        let (lt, eqgt) = NE.span ((< x) . p) l
        in  case eqgt of
                []   -> Nothing
                y:ys ->
                    if x == p y
                        then Just $ case nonEmpty lt of
                            Nothing  -> f y :| ys
                            Just lt' -> lt' <> (f y :| ys)
                        else Nothing
    insertNothings nothings groups =
        case update fst (second (<> nothings)) d groups of
            Just groups' -> groups'
            Nothing      -> (d, nothings) <| groups

-- HashMap utils

lookupAndDelete k m =
    case M.lookup k m of
        Nothing -> (Nothing, m)
        Just v  -> (Just v , M.delete k m)

recordMap3
    :: (Ord b1, Hashable b1, Ord b2, Hashable b2)
    => (a -> b1)
    -> (a -> b2)
    -> (a -> b3)
    -> [a]
    -> HashMap b1 (HashMap b2 (Vector b3))
recordMap3 field1 field2 field3 =
    M.fromList .
    map (second $ ne2hm . NE.map (second ne2v) . groupAllExtract1 fst snd) .
    groupAllExtract field1 (\ x -> (field2 x, field3 x))
    where
    ne2hm = M.fromList . NE.toList
    ne2v = V.fromList . NE.toList

-- We're going to go through the process of parsing JSON-LD and converting to
-- RDF triples. We start with the basic data model that JSON-LD uses, which is
-- the one of JSON:

-- | A container that holds either a single value or an array or zero or more
-- values. It preserves the distinction between a single value and an array.
data Multi a = One a | Many (Vector a)
    deriving (Eq, Functor, Foldable, Traversable)

data Scalar
    = ScalarString Text
    | ScalarNumber Scientific
    | ScalarBool Bool

type Dictionary = HashMap Text (Multi Value)

data Value
    = ValueScalar Scalar
    | ValueDictionary Dictionary
    | ValueNull

-- Once we parse a JSON document into that structure, in the next step we'll do
-- the following:
--
-- * Parse the contexts, from 'Value' to a dedicated context type
-- * Parse the properties, identifying keywords and URIs and so on
-- * Parse string scalars, identifying keywords and URIs and so on
--
-- Here's the new structure we'll produce. First, some building blocks:

data KeywordC
    = KeywordContainer
    | KeywordBase
    | KeywordVocab
    deriving (Eq, Ord, Generic)

instance Hashable KeywordC

data KeywordNC
    = KeywordId
    | KeywordValue
    | KeywordLanguage
    | KeywordType
    | KeywordList
    | KeywordSet
    | KeywordReverse
    | KeywordIndex
    | KeywordGraph
    deriving (Eq, Ord, Generic)

instance Hashable KeywordNC

data Keyword
    = KeywordContext
    | KeywordC KeywordC
    | KeywordNC KeywordNC

-- | A string that syntactically can be interpretted as a absolute URI, or a
-- compact URI, or as both.
data AbsoluteOrCompact
    = JustAbsolute (URI Gen)
    -- ^ The string parses as a valid absolute URI, but it can't be used as a
    -- compact URI. For example if the colon is followed by two slashes, the
    -- string may be considered as as an absolute URI and not allowed to be
    -- considered as a compact one.
    | JustCompact CompactURI
    -- ^ The string fails to parse as a valid absolute URI, but it has a colon
    -- and can be used as a compact URI. In the JSON-LD spec, strings can be
    -- considered as absolute URIs without being valid URIs, so if a string
    -- with a colon doesn't have a term definition for its prefix, the error to
    -- give may be "invalid absolute URI". Because in JSON-LD it's blindly
    -- treated as an absolute URI, while here we discard it on this basis.
    | AbsoluteOrCompact (URI Gen) CompactURI
    -- ^ The string is syntactically both a valid absolute URI and a valid
    -- compact URI.
    deriving (Eq, Ord, Generic)

instance Hashable AbsoluteOrCompact where
    hashWithSalt s (JustAbsolute u) =
        s `hashWithSalt` (0 :: Int) `hashWithSalt` u
    hashWithSalt s (JustCompact c) =
        s `hashWithSalt` (1 :: Int) `hashWithSalt` c
    hashWithSalt s (AbsoluteOrCompact _u c) =
        s `hashWithSalt` (1 :: Int) `hashWithSalt` c

-- | A reference that possibly points to some other string value, such as a URI
-- or a keyword. Ref expansion (or IRI expansion, as the JSON-LD spec calls it)
-- can produce the value that's being referred to.
data Ref
    = RefURI AbsoluteOrCompact
    | RefBlank RelToken
    | RefTerm RelNoAuth
    deriving (Eq, Ord, Generic)

instance Hashable Ref

data ObjectKey
    = ObjectKeyKeyword KeywordNC
    | ObjectKeyOther Ref

data Weird
    = WKeywordContext
    | WKeywordC KeywordC
    | WKeywordU Text
    | WEmpty
    | WBlank Text
    | WTerm Text
    deriving Eq

data Token
    = TWeird Weird
    | TKeywordNC KeywordNC
    | TRef Ref
    deriving Eq

data TScalar
    = TScalarString Text Token
    | TScalarNumber Scientific
    | TScalarBool Bool
    deriving Eq

-- Now, here's the typed parsed context structure:

type Reverse = Ref

-- TODO
-- Does it really make sense for Id to allow Keyword? Maybe just KeywordNC? Or
-- KeywordNC+KeywordC but excluding KeywordContext?
data Id
    = IdKeyword Keyword
    | IdRef Ref
    | IdNull

data Type
    = TypeURI AbsoluteOrCompact
    | TypeTerm RelNoAuth
    | TypeId
    | TypeVocab
    | TypeNull

data Container
    = ContainerNull
    | ContainerSet
    | ContainerList
    | ContainerLanguage
    | ContainerIndex

data ContainerReverse
    = ContainerReverseNull
    | ContainerReverseSet
    | ContainerReverseIndex

data ExpandedTermDefinitionId = ExpandedTermDefinitionId
    { expandedId        :: Maybe Id
    , expandedContainer :: Maybe Container
    }

data ExpandedTermDefinitionReverse = ExpandedTermDefinitionReverse
    { expandedReverse          :: Reverse
    , expandedContainerReverse :: Maybe ContainerReverse
    }

data ExpandedTermDefinition = ExpandedTermDefinition
    { expandedIdOrReverse ::
        Either ExpandedTermDefinitionId ExpandedTermDefinitionReverse
    , expandedType        :: Maybe Type
    , expandedLanguage    :: Maybe ContextLanguage -- just reusing bc same spec
    }

-- Reusing Id simply because same possibilities
data ContextValue
    = ContextValueId Id
    | ContextValueExpanded ExpandedTermDefinition

data ContextLanguage
    = ContextLanguageTag Text
    | ContextLanguageNull

data ContextBase
    = ContextBaseAbsolute (URI Gen)
    | ContextBaseRelative (URI Rel)
    | ContextBaseNull

data ContextVocab
    = ContextVocabAbsolute (URI Gen)
    | ContextVocabBlank RelToken -- the stuff after the _:
    | ContextVocabNull

data Context = Context
    { contextLanguage :: Maybe ContextLanguage
    , contextBase     :: Maybe ContextBase
    , contextVocab    :: Maybe ContextVocab
    , contextValues   :: HashMap Ref ContextValue
    }

data LocalContextItem
    = LocalContextObject Context
    | LocalContextString (URI U.Ref)
    | LocalContextNull

-- And finally the complete new structure:

data UnknownItem
    = UnknownItemScalar TScalar
    | UnknownItemNull
    | UnknownItemObject UnknownObject

data UnknownObject = UnknownObject
    { unknownContext :: Maybe (Multi LocalContextItem)
    , unknownMap     :: HashMap Text (ObjectKey, Multi UnknownItem)
    }

-- Now let's see how we convert 'Value' to 'UnknownItem'. And a dictionary into
-- an 'UnknownObject'. First, let's define some error types for the functions
-- to use. Note that these error types are also for later steps and may be
-- including some structures defined later below.

data SpecErrorCode
    -- | LoadingDocumentFailed
    = ListOfLists
    | InvalidIndexValue -- berenice-aeson, when @index field in a node object is not a JSON string
    | ConflictingIndexes
    | InvalidIdValue -- berenice-aeson, when @id field in a node object is not a JSON string
    -- | InvalidLocalContext
    -- | MultipleContextLinkHeaders
    -- | LoadingRemoteContextFailed
    | InvalidRemoteContext
    | RecursiveContextInclusion
    | InvalidBaseURI
    | InvalidVocabMapping
    | InvalidDefaultLanguage -- berenice-aeson should use this if it parses a @language that isn't an aeson String
    | KeywordRedefinition -- berenice-aeson should raise if parsing a Ref in the @context finds it to be a keyword
    | InvalidTermDefinition -- berenice-aeson should raise if parsing a ContextValue fails, in particular it's neither JSON string nor object
    | InvalidReverseProperty -- berenice-aeson, when expanded term def contains both @id and @reverse. Or otherwise not by the rules? :) Also if @reverse is present and @container isn't one of the values of 'ContainerReverse'
    | InvalidURIMapping -- berenice-aeson, when parsing expanded term definition and @id or @reverse isn't a JSON string, or @reverse parsing fails
    | CyclicURIMapping Ref
    | InvalidKeywordAlias -- berenice-aeson, when parsing context value or expanded term def @id and the value is @context
    | InvalidTypeMapping -- berenice-aeson, when parsing expanded term def and @type maps to a non-string. It's also used here below
    | InvalidLanguageMapping
    | CollidingKeywords
    | InvalidContainerMapping -- used below + berenice aeson when parsing @container in @context (at least when without @reverse) fails
    | InvalidTypeValue -- berenice-aeson, when parsing node object field, key is @type and value isn't JSON string or array of strings
    | InvalidValueObject
    | InvalidValueObjectValue
    | InvalidLanguageTaggedString
    | InvalidLanguageTaggedValue
    | InvalidTypedValue
    -- | InvalidSetOrListObject
    | InvalidLanguageMapValue
    | CompactionToListOfLists
    | InvalidReversePropertyMap
    | InvalidReverseValue -- berenice-aeson, if in a node object @reverse is mapped to something that isn't a JSON object
    | InvalidReversePropertyValue

data TermDefInvalidType
    = ITBlank RelToken
    | ITKeywordNC KeywordNC
    | ITWeird Weird

data Weird'
    = WKeywordU' Text
    | WEmpty'
    | WBlank' Text

data BereniceError
    = SpecError SpecErrorCode String
    | InvalidObjectKey Weird
    | ContextInvalidURI Text
    | ContextInvalidScalar (Either Scientific Bool)
    | ContextInvalidKey Weird'
    | TermDefInvalidMember
    | TermDefInvalidId Weird'
    | TermDefInvalidReverse (Either KeywordNC Weird)
    | TermDefInvalidType TermDefInvalidType
    | InvalidTaggedKey KeywordC
    | ValueInvalidType (Either KeywordNC Weird)
    | ListInvalidMember
    | NodeInvalidId (Either KeywordNC Weird)
    | NodeInvalidType (Either KeywordNC Weird)
    | NodeInvalidReverse (Either KeywordNC Weird)
    | NodeInvalidGraph
    | ENodeInvalidId (Either KeywordNC Weird)
    | ENodeInvalidType (Either KeywordC KeywordNC)

    | NoTermDefForCompactRefPrefix CompactURI
    | TermOrRelativeNotExpanded RelNoAuth
    | InvalidConcatenatedURI (URI Gen) RelNoAuth
    | InvalidConcatenatedBlank RelToken RelNoAuth
    | InvalidExpandedURI (URI Gen) CompactURI
    | KeywordAliasUsedAsPrefix CompactURI
    | NodeObjectIgnoredField NodeObject KeywordNC NodeValue
    | GraphIsntNodeObject NodeObject Ref NodeValue
    | ExpandValueSetIdToNonString ActiveContext Ref TScalar
    | BlankProperty Identifier RelToken
    | LangStringNoLanguage (Either TypedLiteralNB TypedLiteralString)
    | NonLangStringHasLanguage (Either TypedLiteralNB TypedLiteralString) Text
    | SuspiciouslyBigInteger Scientific
    | OutOfRangeOfDouble Scientific

    -- below are errors for the rdf->jsonld direction:

    | InvalidXsdBoolean Text
    | InvalidXsdInteger Text
    | InvalidXsdDouble Text
    | InvalidRdfType Identifier PlainLiteral

-- Finally, the functions for transforming our document from terms of 'Value'
-- into terms of 'UnknownItem':

uri2ac :: URI Gen -> AbsoluteOrCompact
uri2ac u =
    case parseCompactFromURI u of
        Nothing -> JustAbsolute u
        Just c  -> AbsoluteOrCompact u c

compact2ac :: CompactURI -> AbsoluteOrCompact
compact2ac c =
    case parseURIFromCompact c of
        Nothing -> JustCompact c
        Just u  -> AbsoluteOrCompact u c

parseToken :: Text -> Token
parseToken t = case T.uncons t of
    Nothing -> TWeird WEmpty
    Just ('@', r) ->
        case parseKeyword r of
            Just kw -> case kw of
                KeywordContext -> TWeird WKeywordContext
                KeywordC kwc   -> TWeird $ WKeywordC kwc
                KeywordNC kwnc -> TKeywordNC kwnc
            Nothing -> TWeird $ WKeywordU r
    _ -> case T.stripPrefix "_:" t of
            Just b ->
                case parseRelToken $ encodeUtf8 b of
                    Just rt -> TRef $ RefBlank rt
                    Nothing -> TWeird $ WBlank b
            Nothing ->
                case parseAC t of
                    Just ac -> TRef $ RefURI ac
                    Nothing ->
                        case parseRelNoAuth $ encodeUtf8 t of
                            Nothing -> TWeird $ WTerm t
                            Just r  -> TRef $ RefTerm r
    where
    parseKeyword r = case r of
        "context"   -> Just KeywordContext
        "id"        -> Just $ KeywordNC KeywordId
        "value"     -> Just $ KeywordNC KeywordValue
        "language"  -> Just $ KeywordNC KeywordLanguage
        "type"      -> Just $ KeywordNC KeywordType
        "container" -> Just $ KeywordC  KeywordContainer
        "list"      -> Just $ KeywordNC KeywordList
        "set"       -> Just $ KeywordNC KeywordSet
        "reverse"   -> Just $ KeywordNC KeywordReverse
        "index"     -> Just $ KeywordNC KeywordIndex
        "base"      -> Just $ KeywordC  KeywordBase
        "vocab"     -> Just $ KeywordC  KeywordVocab
        "graph"     -> Just $ KeywordNC KeywordGraph
        _           -> Nothing
    parseAC t =
        case parseURI b of
            Nothing -> JustCompact <$> parseCompactURI b
            Just u  -> Just $ uri2ac u
        where
        b = encodeUtf8 t

parseContextItem :: Value -> Either BereniceError LocalContextItem
parseContextItem (ValueScalar s) =
    case s of
        ScalarString t ->
            case parseURIReference $ encodeUtf8 t of
                Just u  -> Right $ LocalContextString u
                Nothing -> Left $ ContextInvalidURI t
        ScalarNumber n -> Left $ ContextInvalidScalar $ Left n
        ScalarBool b   -> Left $ ContextInvalidScalar $ Right b
parseContextItem ValueNull = Right LocalContextNull
parseContextItem (ValueDictionary m) =
    let (ml, m1) = lookupAndDelete "@language" m
        (mb, m2) = lookupAndDelete "@base"     m1
        (mv, m3) = lookupAndDelete "@vocab"    m2
    in  fmap LocalContextObject $
        Context
        <$> traverse parseLanguage ml
        <*> traverse parseBase mb
        <*> traverse parseVocab mv
        <*> fmap M.fromList (traverse parseNonKW $ M.toList m3)
    where
    w2w' :: Weird -> Either (Maybe KeywordC) Weird'
    w2w' WKeywordContext = Left Nothing
    w2w' (WKeywordC kw)  = Left $ Just kw
    w2w' (WKeywordU t)   = Right $ WKeywordU' t
    w2w' WEmpty          = Right WEmpty'
    w2w' (WBlank rt)     = Right $ WBlank' rt
    parseLanguage v = case v of
        One (ValueScalar (ScalarString t)) ->
            Right $ ContextLanguageTag t
        One ValueNull -> Right ContextLanguageNull
        _ -> Left $ SpecError InvalidDefaultLanguage ""
    parseBase v = case v of
        One (ValueScalar (ScalarString t)) ->
            let b = encodeUtf8 t
            in  case parseURI b of
                    Just u -> Right $ ContextBaseAbsolute u
                    Nothing -> case parseRelativeReference b of
                        Just u -> Right $ ContextBaseRelative u
                        Nothing -> Left $ SpecError InvalidBaseURI ""
        One ValueNull -> Right ContextBaseNull
        _ -> Left $ SpecError InvalidBaseURI ""
    parseVocab v = case v of
        One (ValueScalar (ScalarString t)) -> case parseToken t of
            TRef (RefURI (JustAbsolute u)) ->
                Right $ ContextVocabAbsolute u
            TRef (RefURI (AbsoluteOrCompact u _)) ->
                Right $ ContextVocabAbsolute u
            TRef (RefBlank b) -> Right $ ContextVocabBlank b
            _ -> Left $ SpecError InvalidVocabMapping ""
        One ValueNull -> Right ContextVocabNull
        _ -> Left $ SpecError InvalidVocabMapping ""
    parseId' t = case parseToken t of
        TWeird w ->
            case w2w' w of
                Left mkw ->
                    Right $ IdKeyword $
                        case mkw of
                            Nothing -> KeywordContext
                            Just kw -> KeywordC kw
                Right w' -> Left $ TermDefInvalidId w'
        TKeywordNC kw -> Right $ IdKeyword $ KeywordNC kw
        TRef ck -> Right $ IdRef ck
    parseId v = case v of
        One (ValueScalar (ScalarString t)) -> parseId' t
        One ValueNull                       -> Right IdNull
        _ -> Left $ SpecError InvalidURIMapping ""
    parseContainer v = case v of
        One (ValueScalar (ScalarString t)) -> case t of
            "@set" -> Right ContainerSet
            "@list" -> Right ContainerList
            "@language" -> Right ContainerLanguage
            "@index" -> Right ContainerIndex
            _ -> Left $ SpecError InvalidContainerMapping ""
        One ValueNull -> Right ContainerNull
        _ -> Left $ SpecError InvalidContainerMapping ""
    parseContainerReverse v = case v of
        One (ValueScalar (ScalarString t)) -> case t of
            "@set" -> Right ContainerReverseSet
            "@index" -> Right ContainerReverseIndex
            _ -> Left $ SpecError InvalidReverseProperty ""
        One ValueNull -> Right ContainerReverseNull
        _ -> Left $ SpecError InvalidReverseProperty ""
    parseReverse v = case v of
        One (ValueScalar (ScalarString t)) -> case parseToken t of
            TWeird w       -> Left $ TermDefInvalidReverse $ Right w
            TKeywordNC kw  -> Left $ TermDefInvalidReverse $ Left kw
            TRef ck -> Right ck
        _ -> Left $ SpecError InvalidURIMapping ""
    parseIdReverse (Just _) (Just _) _ =
        Left $ SpecError InvalidReverseProperty ""
    parseIdReverse Nothing (Just r) mc = fmap Right $
        ExpandedTermDefinitionReverse
        <$> parseReverse r
        <*> traverse parseContainerReverse mc
    parseIdReverse mi Nothing mc = fmap Left $
        ExpandedTermDefinitionId
        <$> traverse parseId mi
        <*> traverse parseContainer mc
    parseType v = case v of
        One (ValueScalar (ScalarString t)) ->
            case parseToken t of
                TWeird w ->
                    case w of
                        WKeywordC KeywordVocab -> Right TypeVocab
                        _ -> Left $ TermDefInvalidType $ ITWeird w
                TKeywordNC kw ->
                    case kw of
                        KeywordId -> Right TypeId
                        _ -> Left $ TermDefInvalidType $ ITKeywordNC kw
                TRef ck ->
                    case ck of
                        RefURI ac -> Right $ TypeURI ac
                        RefBlank b ->
                            Left $ TermDefInvalidType $ ITBlank b
                        RefTerm r -> Right $ TypeTerm r
        One ValueNull -> Right TypeNull
        _ -> Left $ SpecError InvalidTypeMapping ""
    parseLang v = case v of
        One (ValueScalar (ScalarString t)) -> Right $ ContextLanguageTag t
        One ValueNull -> Right ContextLanguageNull
        _ -> Left $ SpecError InvalidLanguageMapping ""
    parseTermDef m =
        let (mt, m1) = lookupAndDelete "@type"      m
            (mr, m2) = lookupAndDelete "@reverse"   m1
            (mi, m3) = lookupAndDelete "@id"        m2
            (mc, m4) = lookupAndDelete "@container" m3
            (ml, m5) = lookupAndDelete "@language"  m4
        in  if M.null m5
                then ExpandedTermDefinition
                    <$> parseIdReverse mi mr mc
                    <*> traverse parseType mt
                    <*> traverse parseLang ml
                else Left TermDefInvalidMember
    parseNonKW (k, vs) =
        (,)
        <$> (case parseToken k of
                TWeird w ->
                    case w2w' w of
                        Left _ -> Left $ SpecError KeywordRedefinition ""
                        Right w' -> Left $ ContextInvalidKey w'
                TKeywordNC _ -> Left $ SpecError KeywordRedefinition ""
                TRef ck -> Right ck
            )
        <*> (case vs of
                One (ValueScalar (ScalarString t)) ->
                    ContextValueId <$> parseId' t
                One ValueNull -> Right $ ContextValueId IdNull
                One (ValueDictionary m) ->
                    ContextValueExpanded <$> parseTermDef m
                _ -> Left $ SpecError InvalidTermDefinition ""
            )

parseDocument :: Dictionary -> Either BereniceError UnknownObject
parseDocument = parseDict
    where
    parseObjectKey t =
        case parseToken t of
            TWeird w       -> Left $ InvalidObjectKey w
            TKeywordNC kw  -> Right $ ObjectKeyKeyword kw
            TRef ck -> Right $ ObjectKeyOther ck
    parseDict m =
        let (mc, m') = lookupAndDelete "@context" m
        in  UnknownObject
                <$> traverse (traverse parseContextItem) mc
                <*> M.traverseWithKey
                        (\ p mv ->
                            (,) <$> parseObjectKey p <*> traverse parseValue mv
                        )
                        m'
    parseValue ValueNull = Right UnknownItemNull
    parseValue (ValueScalar s) =
        Right $ UnknownItemScalar $
        case s of
            ScalarString t -> TScalarString t $ parseToken t
            ScalarNumber n -> TScalarNumber n
            ScalarBool b   -> TScalarBool b
    parseValue (ValueDictionary m) = UnknownItemObject <$> parseDict m

-- Once we're done with the *parsing* step, producing an 'UnknownObject'
-- representing our JSON-LD document, we do the *tagging* step. In the tagging
-- step we do some of the steps required for expanding the document:
--
-- * Process contexts, attaching an active context to each object
-- * Running ref expansion on properties i.e. object keys

-- Here are some helper types we'll need, such as the ones describing an active
-- context:

data TermDefinitionType
    = TermDefinitionTypeId
    | TermDefinitionTypeVocab
    | TermDefinitionTypeAbsolute (URI Gen)

data TermDefinition = TermDefinition
    { termTarget     :: IdentKw
    , termReverse    :: Bool
    , termTypeOrLang :: Maybe (Either TermDefinitionType ContextLanguage)
    , termContainer  :: Maybe Container
    }

data ActiveContext = ActiveContext
    { activeBaseURI    :: Maybe (URI Gen)
    , activeVocabulary :: Maybe Identifier
    , activeLanguage   :: Maybe Text
    , activeTerms      :: HashMap Ref TermDefinition
    }

data Identifier
    = IdentURI (URI Gen)
    | IdentBlank RelToken
    deriving (Eq, Ord, Generic)

instance Hashable Identifier

data IdentKw
    = IdentKwURI (URI Gen)
    | IdentKwBlank RelToken
    | IdentKwC KeywordC
    | IdentKwNC KeywordNC
    deriving (Eq, Ord, Generic)

instance Hashable IdentKw

data TaggedKey
    = TaggedKeyKeyword ObjectKey KeywordNC
    | TaggedKeyOther Ref Identifier

-- Now, here's the new structure we'll be producing:

data TaggedItem
    = TaggedItemScalar TScalar
    | TaggedItemNull
    | TaggedItemObject TaggedObject (HashMap Text (Multi TaggedItem))

data TaggedObject = TaggedObject
    { taggedContext :: ActiveContext
    , taggedKwMap   :: HashMap KeywordNC (ObjectKey, Multi TaggedItem)
    , taggedIdMap   :: HashMap Identifier (NonEmpty (Ref, Multi TaggedItem))
    }

-- Now, the functions for ref expansion (what the spec calls IRI expansion,
-- except we don't handle null or keyword inputs, which are simply expanded
-- into themselves). This includes expansion functions we'll use in later
-- steps.

uriConcat'' :: URI Gen -> RelNoAuth -> Either BereniceError (URI Gen)
uriConcat'' base label =
    case uriConcat base label of
        Nothing  -> Left $ InvalidConcatenatedURI base label
        Just uri -> Right uri

uriConcat' :: URI Gen -> RelNoAuth -> Either BereniceError Identifier
uriConcat' base label = IdentURI <$> uriConcat'' base label

blankConcat :: RelToken -> RelNoAuth -> Either BereniceError RelToken
blankConcat base label =
    case relTokenFromRel label of
        Nothing -> Left $ InvalidConcatenatedBlank base label
        Just rt -> Right $ base <> rt

blankConcat' :: RelToken -> RelNoAuth -> Either BereniceError Identifier
blankConcat' base label = IdentBlank <$> blankConcat base label

resolveRel
    :: Bool
    -> ActiveContext
    -> RelNoAuth
    -> Either BereniceError Identifier
resolveRel docRel active rel =
    case (docRel, activeBaseURI active) of
        (True, Just b) ->
            Right $ IdentURI $
                resolveRelativeReference b $ relativeFromNoAuth rel
        (_, _) ->
            Left $ TermOrRelativeNotExpanded rel

expandTermOrRelative
    :: Bool
    -> Bool
    -> ActiveContext
    -> RelNoAuth
    -> Either BereniceError Identifier
expandTermOrRelative docRel vocab active rel =
    case (vocab, activeVocabulary active) of
        (True, Just v) -> case v of
            IdentURI b -> uriConcat' b rel
            IdentBlank b -> blankConcat' b rel
        _ -> resolveRel docRel active rel

expandCompact
    :: Maybe (URI Gen)
    -> CompactURI
    -> ActiveContext
    -> Either BereniceError Identifier
expandCompact muri c active =
    case M.lookup (RefTerm $ compactURIPrefix c) $ activeTerms active of
        Just td ->
            case termTarget td of
                IdentKwURI u ->
                    case expandCompactURI u c of
                        Nothing -> Left $ InvalidExpandedURI u c
                        Just v  -> Right $ IdentURI v
                IdentKwC _   -> Left $ KeywordAliasUsedAsPrefix c
        Nothing ->
            case muri of
                Just uri -> Right $ IdentURI uri
                Nothing -> Left $ NoTermDefForCompactRefPrefix c

expandRefNonVocab'
    :: Bool -> Bool -> ActiveContext -> Ref -> Either BereniceError Identifier
expandRefNonVocab' docRel vocab active ref =
    case ref of
        RefURI ac -> case ac of
            JustAbsolute u -> Right $ IdentURI u
            JustCompact c -> expandCompact Nothing c active
            AbsoluteOrCompact u c -> expandCompact (Just u) c active
        RefBlank l -> Right $ IdentBlank l
        RefTerm u -> expandTermOrRelative docRel vocab active u

-- | IRI expansion, when done not during context processing. The 'vocab'
-- parameter is assumed to be false, which means no keyword aliases.
--
-- * The null case isn't handled here (if null, just return null)
-- * The keyword case isn't handled here (if keyword, just return as is)
-- * 'vocab' is assumed to be false, so the term can't end up expanding to a
--   keyword
expandRefNonVocab :: Bool -> ActiveContext -> Ref -> Either BereniceError Identifier
expandRefNonVocab docRel = expandRefNonVocab' docRel False

-- | IRI expansion, when done not during context processing. The 'vocab'
-- parameter is assumed to be true, which means keyword aliases may be found
-- and expanded into keywords.
--
-- * The null case isn't handled here (if null, just return null)
-- * The keyword case isn't handled here (if keyword, just return as is)
-- * 'vocab' is assumed to be true, so the term may expand into a keyword
expandRefVocab :: Bool -> ActiveContext -> Ref -> Either BereniceError IdentKw
expandRefVocab docRel active ref =
    case M.lookup ref $ activeTerms active of
        Just td -> Right $ termTarget td
        Nothing -> do
            k <- expandRefNonVocab' docRel True active ref
            return $ case k of
                IdentURI u -> IdentKwURI u
                IdentBlank b    -> IdentKwBlank b

-- | IRI expansion, when done not during context processing.
--
-- * The null case isn't handled here (if null, just return null)
-- * The keyword case isn't handled here (if keyword, just return as is)
expandRef
    :: Bool -> Bool -> ActiveContext -> Ref -> Either BereniceError IdentKw
expandRef docRel vocab active ref =
    if vocab
        then expandRefVocab docRel active ref
        else do
            k <- expandRefNonVocab docRel active ref
            return $ case k of
                IdentURI u   -> IdentKwURI u
                IdentBlank b -> IdentKwBlank b

-- | IRI expansion, when done during context processing.
--
-- * The null case isn't handled here (if null, just return null)
-- * The keyword case isn't handled here (if keyword, just return as is)
expandRef'
    :: Context
    -> HashMap Ref Bool
    -> Bool
    -> Bool
    -> ActiveContext
    -> Ref
    -> Either BereniceError (IdentKw, ActiveContext, HashMap Ref Bool)
expandRef' local defined docRel vocab active ref = do
    let updated v = createTermDefinition local ref v defined active
    (a, d) <- case (M.lookup ref $ contextValues local, M.lookup ref defined) of
            (Just v, Nothing)    -> updated v
            (Just v, Just False) -> updated v
            _                    -> pure (active, defined)
    case (vocab, M.lookup ref $ activeTerms a) of
        (True, Just td) -> Right $ t3 a d $ termTarget td
        _ -> case ref of
            RefURI ac -> case ac of
                JustAbsolute u -> Right (IdentKwURI u, a, d)
                JustCompact c ->
                    useContext a d (RefTerm $ compactURIPrefix c) $
                    fmap k'2kx . expandCompact Nothing c
                AbsoluteOrCompact u c ->
                    useContext a d (RefTerm $ compactURIPrefix c) $
                    fmap k'2kx . expandCompact (Just u) c
            RefBlank l -> Right (IdentKwBlank l, a, d)
            RefTerm t ->
                t3 a d . k'2kx <$> expandTermOrRelative docRel vocab a t
    where
    t3 y z x = (x, y, z)
    k'2kx (IdentURI u)   = IdentKwURI u
    k'2kx (IdentBlank b) = IdentKwBlank b
    useContext a d k expand =
        let orig = t3 a d <$> expand a
            updated v = do
                (a', d') <- createTermDefinition local k v d a
                t3 a' d' <$> expand a'
        in  case (M.lookup k $ contextValues local, M.lookup k d) of
                (Just v, Nothing)    -> updated v
                (Just v, Just False) -> updated v
                _                    -> orig

-- Now come the functions for context processing, which is how we produce the
-- active contexts for all the objects:

createTermDefinition
    :: Context
    -> Ref
    -> ContextValue
    -> HashMap Ref Bool
    -> ActiveContext
    -> Either BereniceError (ActiveContext, HashMap Ref Bool)
createTermDefinition local key value defined active =
    case M.lookup key defined of
        Just True -> Right (active, defined)
        Just False -> Left $ SpecError (CyclicURIMapping key) ""
        Nothing ->
            let defined' = M.insert key False defined
                active' = active { activeTerms = M.delete key $ activeTerms active }
            in  case value of
                    ContextValueId i -> case i of
                        -- Algo step 6 says we should set the term definition
                        -- to null. But in the expansion algos, it seems
                        -- lookups just check whether a given term has a term
                        -- def, so no def and null def seem to mean the same
                        -- thing. So, instead of allowing some unnecessary
                        -- annoying null value in the active context, we simply
                        -- delete the term from the active context, because
                        -- that's the same result as mapping term to null.
                        IdNull -> Right (active', M.insert key True defined)
                        _ -> ctd active' defined' ExpandedTermDefinition
                                { expandedIdOrReverse =
                                    Left ExpandedTermDefinitionId
                                        { expandedId = Just i
                                        , expandedContainer = Nothing
                                        }
                                , expandedType = Nothing
                                , expandedLanguage = Nothing
                                }
                    ContextValueExpanded etd -> case expandedIdOrReverse etd of
                        Left etdi -> case expandedId etdi of
                            Just IdNull ->
                                Right (active', M.insert key True defined)
                            _ -> ctd active' defined' etd
                        _ -> ctd active' defined' etd
    where
    ctd a d etd = do
        (mtyp, a2, d2) <- case expandedType etd of
            Nothing -> Right (Nothing, a, d)
            Just t -> case t of
                TypeURI ac -> expand $ RefURI ac
                TypeTerm t -> expand $ RefTerm t
                TypeId -> Right (Just TermDefinitionTypeId, a, d)
                TypeVocab -> Right (Just TermDefinitionTypeVocab, a, d)
                TypeNull -> Left $ SpecError InvalidTypeMapping ""
        let expand2 = expandRef' local d2 False True a2
        case expandedIdOrReverse etd of
            Right etdr -> do
                (k, a3, d3) <- expand2 $ expandedReverse etdr
                tt <- case k of
                    IdentKwURI _ -> Right k
                    IdentKwBlank _ -> Right k
                    IdentKwC _ -> Left $ SpecError InvalidURIMapping ""
                    IdentKwNC _ -> Left $ SpecError InvalidURIMapping ""
                let td = TermDefinition
                        { termTarget = tt
                        , termReverse = True
                        , termTypeOrLang = Left <$> mtyp
                        , termContainer =
                            case expandedContainerReverse etdr of
                                Nothing -> Nothing
                                Just c -> Just $ case c of
                                    ContainerReverseNull -> ContainerNull
                                    ContainerReverseSet -> ContainerSet
                                    ContainerReverseIndex -> ContainerIndex
                        }
                Right
                    ( a3
                        { activeTerms =
                            M.insert key td $ activeTerms a3
                        }
                    , M.insert key True d3
                    )
            Left etdi -> do
                (tt, a3, d3) <- case (id &&& eq key) <$> expandedId etdi of
                    Just (i, False) -> do
                        (k, a3', d3') <- case i of
                            IdNull -> Left $ SpecError InvalidURIMapping ""
                            IdRef ck -> expand2 ck
                            IdKeyword kw -> case kw of
                                KeywordContext -> Left $ SpecError InvalidKeywordAlias ""
                                KeywordC kwc -> Right (IdentKwC kwc, a2, d2)
                                KeywordNC kwnc -> Right (IdentKwNC kwnc, a2, d2)
                        Right (k, a3', d3')
                    _ -> case key of
                        RefURI ac -> case ac of
                            JustAbsolute u -> Right (IdentKwURI u, a2, d2)
                            JustCompact c -> case M.lookup (RefTerm $ compactURIPrefix c) $ contextValues local of
                                Nothing -> Left $ NoTermDefForCompactRefPrefix c
                                Just v -> do
                                    (a3', d3') <- createTermDefinition local (RefTerm $ compactURIPrefix c) v d2 a2
                                    case termTarget <$> M.lookup (RefTerm $ compactURIPrefix c) (activeTerms a3') of
                                        Just tt -> case tt of
                                            IdentKwURI u -> t3 a3' d3' . IdentKwURI <$> expandCompactURI' u c
                                                where
                                                expandCompactURI' u c =
                                                    case expandCompactURI u c of
                                                        Nothing -> Left $ InvalidExpandedURI u c
                                                        Just v  -> Right v
                                            IdentKwC _ -> Left $ KeywordAliasUsedAsPrefix c
                                        Nothing -> Left $ NoTermDefForCompactRefPrefix c
                            AbsoluteOrCompact u c -> case M.lookup (RefTerm $ compactURIPrefix c) $ contextValues local of
                                Nothing -> Right (IdentKwURI u, a2, d2)
                                Just v -> do
                                    (a3', d3') <- createTermDefinition local (RefTerm $ compactURIPrefix c) v d2 a2
                                    case termTarget <$> M.lookup (RefTerm $ compactURIPrefix c) (activeTerms a3') of
                                        Just tt -> case tt of
                                            IdentKwURI w -> t3 a3' d3' . IdentKwURI <$> expandCompactURI' w c
                                                where
                                                expandCompactURI' u c =
                                                    case expandCompactURI u c of
                                                        Nothing -> Left $ InvalidExpandedURI u c
                                                        Just v  -> Right v
                                            IdentKwC _ -> Left $ KeywordAliasUsedAsPrefix c
                                        Nothing -> Left $ NoTermDefForCompactRefPrefix c
                        RefBlank b -> Right (IdentKwBlank b, a2, d2)
                        RefTerm t -> case activeVocabulary a2 of
                            Just (IdentURI u) ->
                                t3 a2 d2 . IdentKwURI <$> uriConcat'' u t
                            Just (IdentBlank b) ->
                                t3 a2 d2 . IdentKwBlank <$> blankConcat b t
                            Nothing -> Left $ SpecError InvalidURIMapping ""
                container <- case expandedContainer etdi of
                    Nothing -> Right Nothing
                    Just c -> case c of
                        ContainerNull -> Left $ SpecError InvalidContainerMapping ""
                        _ -> Right $ Just c
                let td = TermDefinition
                        { termTarget = tt
                        , termReverse = False
                        , termTypeOrLang = case (mtyp, expandedLanguage etd) of
                            (Nothing, Just cl) -> Just $ Right cl
                            (Nothing, Nothing) -> Nothing
                            (Just typ, _) -> Just $ Left typ
                        , termContainer = container
                        }
                Right
                    ( a3
                        { activeTerms =
                            M.insert key td $ activeTerms a3
                        }
                    , M.insert key True d3
                    )
        where
        t3 y z x = (x, y, z)
        expand r = do
            (k, a', d') <- expandRef' local d False True a r
            case k of
                IdentKwURI u ->
                    Right (Just $ TermDefinitionTypeAbsolute u, a', d')
                IdentKwNC KeywordId ->
                    Right (Just $ TermDefinitionTypeId, a', d')
                IdentKwC KeywordVocab ->
                    Right (Just $ TermDefinitionTypeVocab, a', d')
                _ -> Left $ SpecError InvalidTypeMapping ""
        eq ck (IdRef ck') = ck == ck'
        eq _  _          = False

updateActiveContext
    :: Monad m
    => (URI Gen -> ExceptT BereniceError m (Multi Dictionary))
    -> URI Gen
    -> Multi LocalContextItem
    -> ActiveContext
    -> ExceptT BereniceError m ActiveContext
updateActiveContext fetch base = go S.empty
    where
    liftE = ExceptT . pure

    updateBase
        :: Bool
        -> Maybe ContextBase
        -> ActiveContext
        -> Either BereniceError ActiveContext
    updateBase True (Just base) active =
        case base of
            ContextBaseNull         -> Right active { activeBaseURI = Nothing }
            ContextBaseAbsolute uri -> Right active { activeBaseURI = Just uri }
            ContextBaseRelative uri ->
                case activeBaseURI active of
                    Nothing -> Left $ SpecError InvalidBaseURI ""
                    Just bu ->
                        let uri' = resolveRelativeReference bu uri
                        in  Right active { activeBaseURI = Just uri' }
    updateBase _    _           active = Right active

    updateVocab
        :: Maybe ContextVocab
        -> ActiveContext
        -> Either BereniceError ActiveContext
    updateVocab Nothing active      = Right active
    updateVocab (Just vocab) active =
        case vocab of
            ContextVocabNull         -> Right active { activeVocabulary = Nothing }
            ContextVocabAbsolute uri -> Right active { activeVocabulary = Just $ IdentURI uri }
            ContextVocabBlank label  -> Right active { activeVocabulary = Just $ IdentBlank label }

    updateLanguage
        :: Maybe ContextLanguage
        -> ActiveContext
        -> Either BereniceError ActiveContext
    updateLanguage Nothing     active = Right active
    updateLanguage (Just lang) active =
        case lang of
            ContextLanguageNull    -> Right active { activeLanguage = Nothing }
            ContextLanguageTag tag -> Right active { activeLanguage = Just tag }
    go rs ls a = foldlM (flip $ go' rs) a ls
    go' remotes local active =
        case local of
            LocalContextNull -> pure $ active { activeBaseURI = Just base }
            LocalContextString u -> do
                let base' = fromMaybe base $ activeBaseURI active
                    uAbs = resolveURIReference base' u
                    b = renderURI uAbs
                when (b `S.member` remotes) $
                    throwE $ SpecError RecursiveContextInclusion ""
                ls <- do
                    dicts <- fetch uAbs
                    liftE $ case dicts of
                        Many _ -> Left $ SpecError InvalidRemoteContext ""
                        One dict -> case M.lookup "@context" dict of
                            Nothing -> Left $ SpecError InvalidRemoteContext ""
                            Just vals -> traverse parseContextItem vals
                go (S.insert b remotes) ls active
            LocalContextObject c -> ExceptT $ pure $
                    updateBase (S.null remotes) (contextBase c) active
                >>= updateVocab (contextVocab c)
                >>= updateLanguage (contextLanguage c)
                >>= makeTerms c
    makeTerms c a =
        fst <$> foldrM (ctd c) (a, M.empty) (M.toList $ contextValues c)
    ctd c (k, v) (a, d) = createTermDefinition c k v d a

-- Finally, the functions for the tagging step, transforming our document from
-- 'UnknownObject' to 'TaggedObject':

tagDocument
    :: Monad m
    => (URI Gen -> ExceptT BereniceError m (Multi Dictionary))
    -> URI Gen
    -> UnknownObject
    -> ExceptT BereniceError m TaggedObject
tagDocument fetch base = fmap fst . tagObject initialActiveContext
    where
    initialActiveContext = ActiveContext Nothing Nothing Nothing M.empty
    expandRefKW _  _ _ (ObjectKeyKeyword kw) =
        Right $ TaggedKeyKeyword (ObjectKeyKeyword kw) kw
    expandRefKW dr v a (ObjectKeyOther ck) = do
        k <- expandRef dr v a ck
        case k of
            IdentKwURI u     -> Right $ TaggedKeyOther ck $ IdentURI u
            IdentKwBlank t        -> Right $ TaggedKeyOther ck $ IdentBlank t
            IdentKwC kwc   -> Left $ InvalidTaggedKey kwc
            IdentKwNC kwnc ->
                Right $ TaggedKeyKeyword (ObjectKeyOther ck) kwnc
    tagItem active i = case i of
        UnknownItemScalar s -> return $ TaggedItemScalar s
        UnknownItemNull     -> return TaggedItemNull
        UnknownItemObject o -> uncurry TaggedItemObject <$> tagObject active o
    tagObject initialActive (UnknownObject mlocal initialValues) = do
        active <- case mlocal of
            Nothing    -> return initialActive
            Just local -> updateActiveContext fetch base local initialActive
        taggedValues <- for initialValues $ \ (k, v) -> do
            tk <- ExceptT . pure $ expandRefKW False True active k
            tv <- traverse (tagItem active) v
            return (tk, tv)
        let (kws, ids) =
                partitionEithers $ map (uncurry decide) $ M.elems taggedValues
        kws' <- traverse detectDup $ M.fromListWith combineKws kws
        let ids' = M.fromListWith (<>) ids
            limap = M.map snd taggedValues
        return (TaggedObject active kws' ids', limap)
        where
        decide (TaggedKeyKeyword ok kw) tis = Left (kw, (False, (ok, tis)))
        decide (TaggedKeyOther ref i)   tis = Right (i, (ref, tis) :| [])
        combineKws (_, new) (_, old) = (True, new)
        detectDup (True , _)  = throwE $ SpecError CollidingKeywords ""
        detectDup (False, tv) = pure tv

-- The next step is specialization. For each JSON object, we detect its type:
-- Node object, or value object, or list object, and so on.
--
-- First, new types we'll need:

data ValueValue
    = ValueValueScalar TScalar
    | ValueValueNull

-- | A type for use in values associated with keywords, allowing to attach
-- keyword aliases to them.
--
-- It's basically like turning type @a@ into @(Maybe Ref, a)@ where the @fst@
-- is the alias. It sounds trivial, and indeed it is. I'm just using it to make
-- it clearer that the @Maybe Ref@ is an alias. Sadly, even in this
-- type-expressive Haskell library, JSON-LD is a scary mess and horror, so I
-- feel like using some helper types makes things a little bit less scary.
data AliasAnd a = AliasAnd
    { aaAlias :: Maybe Ref
    , aaValue :: a
    }

data ValueObject = ValueObject
    { valueValue      :: AliasAnd ValueValue
    , valueTypeOrLang :: Maybe (AliasAnd (Either Ref Text))
    , valueIndex      :: Maybe (AliasAnd Text)
    , valueContext    :: ActiveContext
    }

data NodeReverseItem
    = NodeReverseId Ref
    | NodeReverseObject NodeObject

{-
-- TODO move this type elsewhere if it's used somewhere above
data RefMap a
    = RefMapEmpty Ref
    | RefMap (NonEmpty (Ref, a))
-}

data NodeReverse = NodeReverse
    { reverseContext :: ActiveContext
    , reverseMap     ::
        HashMap Identifier (NonEmpty (Ref, Multi NodeReverseItem))
    -- ^ Each NonEmpty has a unique Ref, and each Ref appears in one NonEmpty,
    -- under a single Identifier, can't appear under different Identifiers
    -- because each Ref has a single Identifier matching it via IRI expansion
    }

data Item
    = ItemScalar TScalar
    | ItemNull
    | ItemNode NodeObject
    | ItemValue ValueObject

-- These are the non expanded versions
data ListObject' = ListObject'
    { listArray'   :: AliasAnd (Multi Item)
    , listContext' :: ActiveContext
    , listIndex'   :: Maybe (AliasAnd Text)
    }

data SetObject' = SetObject'
    { setArray'   :: AliasAnd (Multi Item)
    , setContext' :: ActiveContext
    , setIndex'   :: Maybe (AliasAnd Text)
    }

data NodeItem
    = NodeItemOne Item
    | NodeItemList ListObject'
    | NodeItemSet SetObject'
    -- ^ Same as below, using Vector for now as long as no need for lookups

data LanguageItem
    = LanguageItemNull
    | LanguageItemString Text

data NodeValue
    = Items (Multi NodeItem)
    -- ^ by default arrays are unordered in JSON-LD, but I'm using Vector to
    -- avoid hashing that HashSet would need, especially since probably I won't
    -- need to do lookups. And if I do, I guess I'll switch to HashSet
    | LangMap (HashMap Text (Multi LanguageItem))
    | IndexMap (HashMap Text (Multi NodeItem))

data NodeObject = NodeObject
    { nodeContext :: ActiveContext
    , nodeId      :: Maybe (AliasAnd Ref)
    , nodeGraph   :: Maybe (AliasAnd (Multi NodeObject))
    , nodeType    :: Maybe (AliasAnd (Multi Ref))
    , nodeReverse :: Maybe (AliasAnd NodeReverse)
    , nodeIndex   :: Maybe (AliasAnd Text)
    , nodeValues  ::
        HashMap
            Identifier
            (NonEmpty (Ref, (Either (Multi NodeItem) NodeValue)))
    -- ^ Each NonEmpty has a unique Ref, I could use a HashMap but wondering if
    -- that helps anything if I won't really be doing any lookups in it, just
    -- compacting or expanding into other structures.
    --
    -- 'Left' means that the unexpanded key's container mapping is @list,
    -- otherwise 'Right'.
    --
    -- TODO perhaps change that type? Either have a dedicated datatype or just
    -- use 'NodeValue' with additional 'Bool' field in its 'Items' ctor to say
    -- whether container is '@list' or not.
    }

data DetectedObject
    = DetectedValueObject ValueObject
    | DetectedListObject ListObject'
    | DetectedSetObject SetObject'
    | DetectedNodeObject NodeObject

-- And now the functions for the specialization step:

specializeDocument :: TaggedObject -> Either BereniceError NodeObject
specializeDocument = specializeNode
    where
    alias (ObjectKeyKeyword _) = Nothing
    alias (ObjectKeyOther ref) = Just ref
    withAlias act (ok, tv) = AliasAnd (alias ok) <$> act tv
    aliasAnd ok act = AliasAnd (alias ok) <$> act
    specializeNode (TaggedObject active kws vals) =
        NodeObject
        <$> pure active
        <*> (for (M.lookup KeywordId kws) $ withAlias $ \ tv -> case tv of
                One (TaggedItemScalar (TScalarString _ token)) -> case token of
                        TWeird w -> Left $ NodeInvalidId $ Right w
                        TKeywordNC kw -> Left $ NodeInvalidId $ Left kw
                        TRef ck -> Right ck
                _ -> Left $ SpecError InvalidIdValue ""
            )
        <*> (for (M.lookup KeywordGraph kws) $ withAlias $ \ tv ->
                for tv $ \ ti -> case ti of
                    TaggedItemObject to _ -> do
                        o <- specializeObject to
                        case o of
                            DetectedNodeObject no -> Right no
                            _ -> Left NodeInvalidGraph
                    _ -> Left NodeInvalidGraph
            )
        <*> (for (M.lookup KeywordType kws) $ withAlias $ \ tv ->
                for tv $ \ ti -> case ti of
                    TaggedItemScalar (TScalarString _ token) ->
                        case token of
                            TWeird w -> Left $ NodeInvalidType $ Right w
                            TKeywordNC kw -> Left $ NodeInvalidType $ Left kw
                            TRef ck -> Right ck
                    _ -> Left $ SpecError InvalidTypeValue ""
            )
        <*> (for (M.lookup KeywordReverse kws) $ withAlias $ \ tv -> case tv of
                One (TaggedItemObject (TaggedObject a k m) _) ->
                    if M.null k
                        then fmap (NodeReverse a) $ for m $ \ ne -> for ne $ \ (ref, tv) -> fmap ((,) ref) $
                            for tv $ \ ti -> case ti of
                                TaggedItemScalar (TScalarString _ token) -> case token of
                                    TWeird w -> Left $ NodeInvalidReverse $ Right w
                                    TKeywordNC kw -> Left $ NodeInvalidReverse $ Left kw
                                    TRef ck -> Right $ NodeReverseId ck
                                TaggedItemObject to _ -> do
                                    o <- specializeObject to
                                    case o of
                                        DetectedNodeObject no -> Right $ NodeReverseObject no
                                        _ -> Left $ SpecError InvalidReversePropertyValue ""
                                _ -> Left $ SpecError InvalidReversePropertyValue ""
                        else Left $ SpecError InvalidReversePropertyMap ""
                _ -> Left $ SpecError InvalidReverseValue ""
            )
        <*> (for (M.lookup KeywordIndex kws) $ withAlias $ \ tv -> case tv of
                One (TaggedItemScalar (TScalarString t _)) -> Right t
                _ -> Left $ SpecError InvalidIndexValue ""
            )
        <*> (for vals $ \ ne -> for ne $ \ (ref, tv) -> (,) ref <$>
                let ti2ni ti = case ti of
                        TaggedItemScalar s    -> Right $ NodeItemOne $ ItemScalar s
                        TaggedItemNull        -> Right $ NodeItemOne $ ItemNull
                        TaggedItemObject to _ -> do
                            o <- specializeObject to
                            Right $ case o of
                                DetectedValueObject vo -> NodeItemOne $ ItemValue vo
                                DetectedListObject lo  -> NodeItemList lo
                                DetectedSetObject so   -> NodeItemSet so
                                DetectedNodeObject no  -> NodeItemOne $ ItemNode no
                in  case (M.lookup ref (activeTerms active) >>= termContainer, tv) of
                        (Just ContainerList, _) -> Left <$> traverse ti2ni tv
                        (Just ContainerLanguage, One (TaggedItemObject _ m)) -> fmap (Right . LangMap) $ for m $ \ mti -> for mti $ \ ti -> case ti of
                            TaggedItemScalar (TScalarString t _) -> Right $ LanguageItemString t
                            TaggedItemNull                      -> Right LanguageItemNull
                            _                                   -> Left $ SpecError InvalidLanguageMapValue ""
                        (Just ContainerIndex, One (TaggedItemObject _ m)) -> Right . IndexMap <$> traverse (traverse ti2ni) m
                        _ -> Right . Items <$> traverse ti2ni tv
            )
    specializeObject tobj@(TaggedObject active kws vals) =
        case M.lookup KeywordValue kws of
            Just (ok, tval) -> fmap DetectedValueObject $
                ValueObject
                <$> (aliasAnd ok $ case tval of
                        One ti -> case ti of
                            TaggedItemScalar s   -> Right $ ValueValueScalar s
                            TaggedItemNull       -> Right ValueValueNull
                            TaggedItemObject _ _ -> Left $ SpecError InvalidValueObjectValue ""
                        Many _ -> Left $ SpecError InvalidValueObjectValue ""
                    )
                <*> case ( M.lookup KeywordType kws
                         , M.lookup KeywordLanguage kws) of
                            (Nothing, Nothing) -> Right Nothing
                            (Just (ok, tv), Nothing) -> fmap (Just . AliasAnd (alias ok) . Left) $ tv2vt tv
                                where
                                tv2vt (One (TaggedItemScalar (TScalarString _ token))) =
                                    case token of
                                        TWeird w -> Left $ ValueInvalidType $ Right w
                                        TKeywordNC kw -> Left $ ValueInvalidType $ Left kw
                                        TRef ck -> Right ck
                                tv2vt (One _) =
                                    Left $ SpecError InvalidTypeValue ""
                                tv2vt (Many _) =
                                    Left $ SpecError InvalidTypedValue ""
                            (Nothing, Just (ok, tv)) -> case tv of
                                One (TaggedItemScalar (TScalarString t _)) ->
                                    Right $ Just $ AliasAnd (alias ok) $ Right t
                                _ ->
                                    Left $ SpecError InvalidLanguageTaggedString ""
                            (Just _, Just _) -> Left $ SpecError InvalidValueObject ""
                <*> case M.lookup KeywordIndex kws of
                        Nothing -> Right Nothing
                        Just (ok, tv) -> case tv of
                            One (TaggedItemScalar (TScalarString t _)) ->
                                Right $ Just $ AliasAnd (alias ok) t
                            _ ->
                                Left $ SpecError InvalidIndexValue ""
                <*> pure active
            Nothing -> case M.lookup KeywordList kws of
                Just p -> DetectedListObject <$> detectListSet True ListObject' p
                Nothing -> case M.lookup KeywordSet kws of
                    Just p -> DetectedSetObject <$> detectListSet False SetObject' p
                    Nothing -> DetectedNodeObject <$> specializeNode tobj
        where
        detectListSet list f (ok, tv) = f
            <$> (aliasAnd ok $ for tv $ \ ti -> case ti of
                    TaggedItemScalar s    -> Right $ ItemScalar s
                    TaggedItemNull        -> Right ItemNull
                    TaggedItemObject to _ -> do
                        o <- specializeObject to
                        case (list, o) of
                            (_, DetectedValueObject vo) ->
                                Right $ ItemValue vo
                            (_, DetectedNodeObject no) ->
                                Right $ ItemNode no
                            (True, _) -> Left $ SpecError ListOfLists ""
                            (False, _) -> Left ListInvalidMember
                )
            <*> pure active
            <*> (for (M.lookup KeywordIndex kws) $ withAlias $ \ tv -> case tv of
                    One (TaggedItemScalar (TScalarString t _)) -> Right t
                    _ -> Left $ SpecError InvalidIndexValue ""
                )

-- The next step is expansion. In the tagging step we did context processing
-- and ref expansion on properties, and now we'll do the rest of the expansion
-- algorithm.
--
-- First, some helper types:

data ExpandedScalar
    = ExpandedScalarId Identifier
    | ExpandedScalarVal ExpandedScalarValue
    deriving Eq

data ExpandedReverseObject = ExpandedReverseObject
    { expandedReverseReverse :: HashMap Identifier (Vector ExpandedNodeObject)
    , expandedReverseValues  :: HashMap Identifier (Vector ExpandedNodeObject)
    }

data ActiveProperty
    = ActivePropertyNull
    | ActivePropertyURI AbsoluteOrCompact
    | ActivePropertyBlank RelToken
    | ActivePropertyTerm RelNoAuth
    | ActivePropertyKeyword KeywordNC

-- Now, here are the types for the new structure we'll be producing:

data ExpandedStringValue = ExpandedStringValue
    { esText       :: Text
    , esToken      :: Token
    , esTypeOrLang :: Maybe (Either (URI Gen) Text)
    }
    deriving Eq

data ExpandedNBValue = ExpandedNBValue
    { enbValue :: Either Scientific Bool
    , enbType  :: Maybe (URI Gen)
    }
    deriving Eq

data ExpandedScalarValue = ExpandedScalarValue
    { scalarValue :: Either ExpandedNBValue ExpandedStringValue
    , scalarIndex :: Maybe Text
    }
    deriving Eq

data ExpandedAtom
    = ExpandedAtomScalar ExpandedScalarValue
    | ExpandedAtomNode ExpandedNodeObject
    deriving Eq

data ExpandedList = ExpandedList
    { elistIndex :: Maybe Text
    , elistArray :: Vector ExpandedAtom
    }
    deriving Eq

data ExpandedItem
    = ExpandedItemOne ExpandedAtom
    | ExpandedItemList ExpandedList
    deriving Eq

-- "This algorithm expands a JSON-LD document, such that all context
-- definitions are removed, all terms and compact IRIs are expanded to absolute
-- IRIs, blank node identifiers, or keywords and all JSON-LD values are
-- expressed in arrays in expanded form."
data ExpandedNodeObject = ExpandedNodeObject
    { enodeId      :: Maybe Identifier
    , enodeGraph   :: Maybe (Multi ExpandedNodeObject)
    -- ^ TODO do we need the distinction between one and many? If we really do,
    -- replace this Either with a Multi. Otherwise, replace with a Vector.
    , enodeType    :: Maybe (Vector Identifier)
    , enodeReverse :: Maybe (HashMap Identifier (Vector ExpandedNodeObject))
    , enodeIndex   :: Maybe Text
    , enodeValues  :: HashMap Identifier (Vector ExpandedItem)
    }
    deriving Eq

-- And now the functions:

ck2ap (RefURI ac)  = ActivePropertyURI ac
ck2ap (RefBlank t) = ActivePropertyBlank t
ck2ap (RefTerm t)  = ActivePropertyTerm t

{-
ap2ck ActivePropertyNull        = Nothing
ap2ck (ActivePropertyURI ac)    = Just $ RefURI ac
ap2ck (ActivePropertyBlank t)   = Just $ RefBlank t
ap2ck (ActivePropertyTerm t)    = Just $ RefTerm t
ap2ck (ActivePropertyKeyword _) = Nothing
-}

idOrValue
    :: ActiveContext
    -> Ref
    -> Either Bool (Maybe (Either (URI Gen) ContextLanguage))
idOrValue active property =
    let mtorl = M.lookup property (activeTerms active) >>= termTypeOrLang
    in  case mtorl of
            Just torl -> case torl of
                Left tt -> case tt of
                    TermDefinitionTypeId -> Left False
                    TermDefinitionTypeVocab -> Left True
                    TermDefinitionTypeAbsolute u -> Right $ Just $ Left u
                Right tl -> Right $ Just $ Right tl
            Nothing -> Right Nothing

expandStringToId
    :: Bool -> ActiveContext -> Ref -> Either BereniceError Identifier
expandStringToId vocab active ck = do
    k <- expandRef True vocab active ck
    case k of
        IdentKwURI u     -> Right $ IdentURI u
        IdentKwBlank b        -> Right $ IdentBlank b
        IdentKwC kwc   -> Left $ ENodeInvalidId $ Right $ WKeywordC kwc
        IdentKwNC kwnc -> Left $ ENodeInvalidId $ Left kwnc

k2eno k = ExpandedNodeObject (Just k) Nothing Nothing Nothing Nothing M.empty

expandReverseItem
    :: ActiveContext
    -> Ref
    -> NodeReverseItem
    -> Either BereniceError ExpandedNodeObject
expandReverseItem active property nri =
    case nri of
        NodeReverseId ck ->
            case idOrValue active property of
                Left vocab -> k2eno <$> expandStringToId vocab active ck
                Right _    -> Left $ SpecError InvalidReversePropertyValue ""
        NodeReverseObject n ->
            -- The active property can be neither null nor a keyword, so
            -- specifically not @graph. Therefore we can use
            -- 'expandNodeObjectNotNull' below, knowing the check that may
            -- result with null isn't supposed to happen.
            expandNodeObjectNotNull (ck2ap property) n

expandReverseObject
    :: NodeReverse
    -> Either BereniceError ExpandedReverseObject
expandReverseObject reverse = do
    -- 1-4 - It's a JSON object
    -- 5 - We already did that in tagDocument
    let active = reverseContext reverse
    -- 6-7
        initial = ExpandedReverseObject M.empty M.empty
    foldlM (processProperty' active) initial (M.toList $ reverseMap reverse)
    -- 8-11 - There are no keys that are keywords
    -- 12 - Active property is @reverse, so it's neither null nor @graph
  where
    processProperty' active obj (ep, vals) =
        foldlM (processProperty active ep) obj vals
    processProperty active ep (ExpandedReverseObject rrs rvs) (k, v) = do
        -- 7.1 - We already handled @context separately
        -- 7.2 - We already did that in tagDocument
        -- 7.3 - No such option, expandRef returns only keywords or things with
        -- a colon
        -- 7.4 - We already did this in specializeDocument
        let mtd = M.lookup k $ activeTerms active
            mc = mtd >>= termContainer
        ev <- case (mc, isObj v) of
            -- 7.5 - The value of a reverse property has to point to a
            -- node, it can't be just a scalar. Instead of waiting for
            -- later when the expansion of the containing node object
            -- discovers this, we exclude the possibility of a language map
            -- from the datatype for reverse property value, and just raise
            -- the error here.
            (Just ContainerLanguage, True) -> Left $ SpecError InvalidReversePropertyValue ""
            -- 7.6 - Same as above
            (Just ContainerIndex, True) -> Left $ SpecError InvalidReversePropertyValue ""
            -- 7.7
            _ -> traverse (expandReverseItem active k) v
        -- 7.8 - It can't be null
        case mc of
            -- 7.9 - The value of a reverse property (at least unless the
            -- reverse property is @reverse, the spec algo mentions this case,
            -- anyway this is not the case because we already raised an error
            -- on the property being a keyword) mustn't be a value object or
            -- list object. If we add it here, the expansion of the node object
            -- (that contains the reverse object we're expanding) will discover
            -- it and given an error. Instead, we're raising the error early.
            Just ContainerList -> Left $ SpecError InvalidReversePropertyValue ""
            _ -> Right $ case termReverse <$> mtd of
                -- 7.10
                Just True ->
                    case ev of
                        One n ->
                            let upd Nothing  = Just $ V.singleton n
                                upd (Just l) = Just $ V.cons n l
                            in  ExpandedReverseObject (M.alter upd ep rrs) rvs
                        Many ns ->
                            ExpandedReverseObject
                                (M.insertWith (<>) ep ns rrs)
                                rvs
                -- 7.11 - The spec is unclear, what does it mean to append?
                -- Appending a scalar to an array is clear, but what if we have
                -- an array to append to an array? Do we add it as a new single
                -- array item, or do we (++) the two arrays? It seems the JS
                -- impementation does the latter. Let's do the same.
                _ -> case ev of
                    One n ->
                        let upd Nothing  = Just $ V.singleton n
                            upd (Just v) = Just $ V.cons n v
                        in  ExpandedReverseObject rrs $ M.alter upd ep rvs
                    Many ns ->
                        ExpandedReverseObject rrs (M.insertWith (<>) ep ns rvs)

    isObj (One (NodeReverseObject _)) = True
    isObj _                           = False

nbOrString :: TScalar -> Either (Either Scientific Bool) (Text, Token)
nbOrString (TScalarString t token) = Right (t, token)
nbOrString (TScalarNumber s)       = Left $ Left s
nbOrString (TScalarBool b)         = Left $ Right b

expandValue
    :: ActiveContext -> Ref -> TScalar -> Either BereniceError ExpandedScalar
expandValue active property value =
    case idOrValue active property of
        Left vocab -> case value of
            TScalarString _ token ->
                case token of
                    TWeird w -> Left $ ENodeInvalidId $ Right w
                    TKeywordNC kw -> Left $ ENodeInvalidId $ Left kw
                    TRef ck ->
                        ExpandedScalarId <$> expandStringToId vocab active ck
            _ -> Left $ ExpandValueSetIdToNonString active property value
        Right m -> Right $ ExpandedScalarVal ExpandedScalarValue
            { scalarValue = case nbOrString value of
                Left nb -> Left $ ExpandedNBValue nb $
                    case m of
                        Just (Left u) -> Just u
                        _             -> Nothing
                Right (t, token) -> Right $ ExpandedStringValue t token $
                    case m of
                        Just uorl -> case uorl of
                            Left u -> Just $ Left u
                            Right tl -> case tl of
                                ContextLanguageTag t -> Just $ Right t
                                ContextLanguageNull  -> Nothing
                        Nothing -> Right <$> activeLanguage active
            , scalarIndex = Nothing
            }

expandValueObject
    :: ValueObject
    -> Either BereniceError (Maybe ExpandedScalarValue)
expandValueObject (ValueObject valueA mtorlA mindexA active) = do
    let value  = aaValue valueA
        mtorl  = aaValue <$> mtorlA
        mindex = aaValue <$> mindexA
    -- 1-4 - It's a JSON object
    -- 5 - We already did this in tagDocument
    -- 6-7 - No need to loop, just handle the few keys relevant to value object
    -- 7.4 - Yes, all properties are keywords
    -- 7.5-7.11 - Irrelevant, we're only handling keywords
    for (v2m value) $ \ s -> do
        mtorl' <- for mtorl $ \ torl -> case torl of
            Left typ -> do
                ik <- expandRefVocab True active typ
                case ik of
                    IdentKwURI u -> Right $ Left u
                    _            -> Left $ SpecError InvalidTypedValue ""
            Right lang -> Right $ Right lang
        value' <- case nbOrString s of
            Left nb -> Left . ExpandedNBValue nb <$>
                case mtorl' of
                    Nothing -> Right Nothing
                    Just torl -> case torl of
                        Left u -> Right $ Just u
                        Right _ -> Left $ SpecError InvalidLanguageTaggedValue ""
            Right (t, token) -> Right $ Right $ ExpandedStringValue t token mtorl'
        Right $ ExpandedScalarValue value' mindex
    where
    v2m (ValueValueScalar s) = Just s
    v2m ValueValueNull       = Nothing

expandItem
    :: ActiveContext
    -> Ref
    -> Item
    -> Either BereniceError (Maybe ExpandedAtom)
expandItem _ _ ItemNull = Right Nothing
expandItem _ property (ItemNode n) =
    fmap ExpandedAtomNode <$> expandNodeObject (ck2ap property) n
expandItem _ _  (ItemValue v) =
    fmap ExpandedAtomScalar <$> expandValueObject v
expandItem active property (ItemScalar s) = do
    es <- expandValue active property s
    return $ Just $
        case es of
            ExpandedScalarId k  -> ExpandedAtomNode $ k2eno k
            ExpandedScalarVal v -> ExpandedAtomScalar v

toArray :: Multi a -> Vector a
toArray (One x)  = V.singleton x
toArray (Many v) = v

expandListObject
    :: Ref
    -> ListObject'
    -> Either BereniceError ExpandedList
expandListObject property (ListObject' items active mindex) =
    -- 1-4 - It's a JSON object
    -- 5 - We already did context processing in the tagging step
    -- 6-7 - Handle the specific possible keywords
    ExpandedList (aaValue <$> mindex) . V.mapMaybe id <$>
        traverse (expandItem active property) (toArray $ aaValue items)

expandSetObject
    :: Ref
    -> SetObject'
    -> Either BereniceError (Vector ExpandedAtom)
expandSetObject property (SetObject' items active _mindex) =
    -- 1-4 - It's a JSON object
    -- 5 - We already did context processing in the tagging step
    -- 6-7 - Handle the specific possible keywords
    V.mapMaybe id <$> traverse (expandItem active property) (toArray $ aaValue items)

expandLangMap
    :: HashMap Text (Multi LanguageItem)
    -> Either BereniceError (Vector ExpandedAtom)
expandLangMap lm =
    let lv2t LanguageItemNull       = Nothing
        lv2t (LanguageItemString t) = Just t
        lv2v (One li) = V.singleton <$> lv2t li
        lv2v (Many v) = traverse lv2t v
    in  case traverse lv2v lm of
            Nothing  -> Left $ SpecError InvalidLanguageMapValue ""
            Just lm' ->
                let t2i tag val = ExpandedAtomScalar ExpandedScalarValue
                        { scalarValue = Right ExpandedStringValue
                            { esText       = val
                            , esToken      = parseToken val
                            , esTypeOrLang = Just $ Right tag
                            }
                        , scalarIndex = Nothing
                        }
                    p2i (tag, vals) = V.map (t2i tag) vals
                in  return $ V.concat $ map p2i $ M.toList lm'

expandIndexMap
    :: ActiveContext
    -> Ref
    -> HashMap Text (Multi NodeItem)
    -> Either BereniceError (Vector ExpandedItem)
expandIndexMap active property im = do
    let e2v (Left ei)   = V.singleton ei
        e2v (Right eas) = V.map ExpandedItemOne eas
        im' = M.map toArray im
        expand = expandNodeItem active property
    fmap V.concat $ for (M.toList im') $ \ (index, items) -> do
        -- We need to expand the items array. Let's do this
        -- according to step 3 of this algorith. We already
        -- know that the active property we'll be using, k,
        -- isn't a keyword, and that the container mapping
        -- is @index, not @list, so we can skip step 3.2.2.
        -- Let's do the rest of what it says though.
        items' <- traverse expand items
        let items'' = fold $ V.map e2v $ V.mapMaybe id items'
            -- Supposed to add @index-index mapping to the
            -- expanded node item!! If it doesn't already
            -- contain one
            addIndex ind ei = case ei of
                ExpandedItemOne a -> ExpandedItemOne $ case a of
                    ExpandedAtomScalar s -> ExpandedAtomScalar s
                        { scalarIndex =
                            Just $ fromMaybe ind $ scalarIndex s
                        }
                    ExpandedAtomNode n -> ExpandedAtomNode n
                        { enodeIndex =
                            Just $ fromMaybe ind $ enodeIndex n
                        }
                ExpandedItemList (ExpandedList mi a) ->
                    let mi' = Just $ fromMaybe ind mi
                    in  ExpandedItemList $ ExpandedList mi' a
        return $ V.map (addIndex index) items''

-- TODO since we have special handling for properties that are keywords,
-- doesn't that mean that ActiveProperty can never be a keyword? And if null
-- and @graph are always checked together, perhaps we can unite them? And if
-- the specific value isn't used, we can unite all Ref APs into a single
-- param-less ctor?

expandNodeItem
    :: ActiveContext
    -> Ref
    -> NodeItem
    -> Either BereniceError (Maybe (Either ExpandedItem (Vector ExpandedAtom)))
expandNodeItem active property (NodeItemOne i) =
    fmap (Left . ExpandedItemOne) <$> expandItem active property i
expandNodeItem _ property (NodeItemList lo) =
    Just . Left . ExpandedItemList <$> expandListObject property lo
expandNodeItem _ property (NodeItemSet so) =
    Just . Right <$> expandSetObject property so

-- | Expand a value associated with a non-keyword key of a node object. This
-- version is for the case the active property's container mapping isn't @list.
expandNodeValueNonLO
    :: ActiveContext
    -> Ref
    -> NodeValue
    -> Either BereniceError (Maybe (Multi ExpandedItem))
expandNodeValueNonLO active property nv = case nv of
    Items (One ni) -> do
        mr <- expandNodeItem active property ni
        return $ mr <&> \ r -> case r of
            Left ei   -> One ei
            Right eas -> Many $ V.map ExpandedItemOne eas
    Items (Many nis) ->
        fmap (Just . Many . fold . V.mapMaybe id) $ for nis $ \ ni -> do
            mr <- expandNodeItem active property ni
            return $ mr <&> \ r -> case r of
                Left ei -> V.singleton ei
                Right eas -> V.map ExpandedItemOne eas
    LangMap lm -> Just . Many . V.map ExpandedItemOne <$> expandLangMap lm
    IndexMap im -> Just . Many <$> expandIndexMap active property im

-- | Expand a value associated with a non-keyword key of a node object. This
-- version is for the case the active property's container mapping is @list.
expandNodeValueForLO
    :: ActiveContext
    -> Ref
    -> Multi NodeItem
    -> Either BereniceError (Maybe (Either ExpandedItem (Vector ExpandedAtom)))
expandNodeValueForLO active property nv = case nv of
    One ni -> expandNodeItem active property ni
    Many nis -> do
        fmap (Just . Right . V.mapMaybe id) $ for nis $ \ ni -> do
            mr <- expandNodeItem active property ni
            for mr $ \ r -> case r of
                Left ei -> case ei of
                    ExpandedItemOne ea -> Right ea
                    ExpandedItemList _ -> Left $ SpecError ListOfLists ""
                Right _eas -> Left $ SpecError ListOfLists ""

-- | Expand a node object, but skip the last step, 12, which may set the result
-- to null under certain conditions. If you use this function, you must do step
-- 12 manually, or guarantee that those conditions aren't met.
expandNodeObjectNotNull
    :: ActiveProperty
    -> NodeObject
    -> Either BereniceError ExpandedNodeObject
expandNodeObjectNotNull property obj = do
    -- 1-4 - It's a JSON object
    -- 5 - We already did this in tagDocument
    let active = nodeContext obj
    -- 6-7 - The spec says to go over the keys in lexicographical order.
    -- Technically we can do that if we take care to notice and maintain the
    -- textual form of all the keys, including ones we represent with albegraic
    -- datatypes. But since the order shouldn't matter, I'm wondering why the
    -- spec requires a specific order. To avoid unnecessary ugliness, let's
    -- just go over them in a convenient order: Handle each 'NodeObject' field
    -- that corresponds to a keyword, and then traverse the hashmap containing
    -- the rest of the keys.
    {-
    let emptyObj = ExpandedNodeObject
            { enodeId      = Nothing
            , enodeGraph   = Nothing
            , enodeType    = Nothing
            , enodeReverse = Nothing
            , enodeIndex   = Nothing
            , enodeValues  = M.empty
            }
    -}
    -- For each key that is a keyword, other than @context that we already
    -- handled:
    -- 7.1 - Okay, it's not @context, so keep going
    -- 7.2 - No need, keywords are expanded to themselves
    -- 7.3 - Expanded property is a keyword, so keep going
    -- 7.4 - Indeed, we're handling the keywords
    -- 7.4.1 - That's what 'checkReverse' does below for each keyword
    -- 7.4.2 - No chance for collision right now
    -- 7.4.3 - 7.4.11 - Handle the keywords below
    -- 7.4.12 - Be careful below, notice when the value ends up being null!
    -- 7.4.13 - Indeed, do them one by one
    mnid <- for (aaValue <$> nodeId obj) $ checkReverse $ expandRefNonVocab True active
    mgraph <- case aaValue <$> nodeGraph obj of
        Nothing -> return Nothing
        Just g  -> checkReverse' $
            let p = ActivePropertyKeyword KeywordGraph
                expand = expandNodeObject p
            in  case g of
                    One n -> do
                        mn <- expand n
                        return $ One <$> mn
                    Many v ->
                        Just . Many . V.mapMaybe id <$> traverse expand v
    mtype <- for (aaValue <$> nodeType obj) $ checkReverse $ \ nt ->
        let expand ck = do
                k <- expandRefVocab True active ck
                case k of
                    IdentKwURI u   -> Right $ IdentURI u
                    IdentKwBlank b      -> Right $ IdentBlank b
                    IdentKwC kw  -> Left $ ENodeInvalidType $ Left kw
                    IdentKwNC kw -> Left $ ENodeInvalidType $ Right kw
        in  case nt of
                One ti -> V.singleton <$> expand ti
                Many tis -> traverse expand tis
    mrv <- for (aaValue <$> nodeReverse obj) $ checkReverse $ \ r -> do
        -- 7.4.11 - We already parsed the value, we know it's an object
        -- 7.4.11.1
        ExpandedReverseObject rrs rvs <- expandReverseObject r
        -- 7.4.11.2 - In the double reverse map, which we got from the
        -- expansion, all the values are already arrays. The spec is
        -- unclear here: Given the existing array in the expanded node
        -- object we're building, and the array from the double reverse
        -- map, do we add the latter as an array item of the former, or do
        -- we (++) the latter to the former? The JS implementation and the
        -- Racket implementation (by cwebber) seem to do (++), and it makes
        -- more sense to me, so let's do it here too.
        -- Since we're just making initial values for our expanded node
        -- object, there's nothing to do: The initial map is going to be
        -- simply 'rrs' itself.
        -- 7.4.11.3 - We're making the initial value and we already handled
        -- value and list objects early, so we can just use the value map
        -- as is.
        let rvs' = if M.null rvs then Nothing else Just rvs
            rrs' = M.map (V.map $ ExpandedItemOne . ExpandedAtomNode) rrs
        return (rvs', rrs')
    let (mreverse, values) = fromMaybe (Nothing, M.empty) mrv
    mindex <- for (aaValue <$> nodeIndex obj) $ checkReverse pure
    -- Keywords @value, @language, @list and @set aren't allowed in a node
    -- object, so we're done with keywords.
    let initialEnode = ExpandedNodeObject
            { enodeId      = mnid
            , enodeGraph   = mgraph
            , enodeType    = mtype
            , enodeReverse = mreverse
            , enodeIndex   = mindex
            , enodeValues  = values
            }
    -- Now do 7 on the rest of the keys in the node object
    enode <-
        foldlM
            (processProperty' active)
            initialEnode
            (M.toList $ nodeValues obj)
    -- 8 - This is a node object, it doesn't have @value
    -- 9 - We already made sure earlier that @type maps to an array
    -- 10 - This is a node object, it doesn't have @list or @set
    -- 11 - This is a node object, it doesn't have @language
    -- 12 - Skipping, we do this step in 'expandNodeObject'
    return enode
  where
    processProperty' active n (ep, vals) =
        foldlM (processProperty active ep) n vals
    processProperty active ep n (k, v) = do
        -- 7.1 - Nope, it's not @context
        -- 7.2 - We already did this in tagDocument
        -- 7.3 - ep can't be null (not sure if because the spec makes sure
        -- it never happens, or because my code dropped the nulls
        -- somewhere), and it has to be either a keyword or stuff that has
        -- a colon, because its type guarantees that. So, nothing to check
        -- here.
        let setKW = setKeyword n
            nonKW = processPropertyNonKW active k v n
        case ep of
            -- 7.4
            -- 7.4.1
            {-
            KeyKeyword kw -> checkReverseM' $ case kw of
                -- 7.4.2
                KeywordId -> setKW enodeId setEnodeId $ case v of
                    -- 7.4.3
                    -- 7.4.12 - can't be null, or we raised error on nulls?
                    -- 7.4.13
                    Items (One (NodeItemOne (ItemScalar (ScalarString _ ck)))) -> Just <$> expandRef True False active ck
                    _                                                          -> Left InvalidIdValue
                -- 7.4.2
                KeywordType -> setKW enodeType setEnodeType $ case v of
                    -- 7.4.4
                    -- 7.4.12 - can't be null, or we raised error on nulls?
                    -- 7.4.13
                    Items (One (NodeItemOne (ItemScalar (ScalarString _ ck)))) -> Just . V.singleton <$> expandRef True True active ck
                    Items (Many nis)   -> fmap Just $ for nis $ \ ni -> case ni of
                        One (ItemScalar (ScalarString _ ck)) -> expandRef True True active ck
                        _                                    -> Left InvalidTypeValue
                    _           -> Left InvalidTypeValue
                -- 7.4.2
                KeywordGraph -> setKWM enodeGraph setEnodeGraph $ do
                    -- 7.4.5
                    -- 7.4.12 - Return Nothing on null so that setKWM drops it
                    -- 7.4.13
                    let p = ActivePropertyKeyword KeywordGraph
                        expand = expandNodeObject fetch base active p
                        err = GraphIsntNodeObject obj k v
                    case v of
                        Items (One (NodeItemOne (ItemNode o))) -> fmap Left <$> expand o
                        Items (Many nis) -> do
                            let decide (One (ItemNode o)) = return o
                                decide _                  = throwE err
                                catMaybesV = V.mapMaybe id
                            Just . Right . catMaybesV <$>
                                traverse (decide >=> expand) nis
                        _ -> throwE err
                -- The algo just says to handle it, but node objects aren't
                -- supposed to have a @value and the spec says to ignore it
                -- when processing. At least for now, just to avoid missing
                -- bugs, let's make this cause an error.
                KeywordValue -> throwE $ NodeObjectIgnoredField obj kw v
                -- Same as above
                KeywordLanguage -> throwE $ NodeObjectIgnoredField obj kw v
                -- 7.4.2
                KeywordIndex -> setKW enodeIndex setEnodeIndex $ case v of
                    -- 7.4.8
                    -- 7.4.12 - can't be null, has to be a string
                    -- 7.4.13
                    Items (One (NodeItemOne (ItemScalar (ScalarString t _)))) -> Right $ Just t
                    _                                          -> Left InvalidIndexValue
                -- Same as above
                KeywordList -> throwE $ NodeObjectIgnoredField obj kw v
                -- Same as above
                KeywordSet -> throwE $ NodeObjectIgnoredField obj kw v
                -- 7.4.2
                KeywordReverse -> case enodeReverse n of
                    Just _  -> throwE $ SpecError CollidingKeywords ""
                    Nothing -> case v of
                    -- 7.4.11
                        Items (One (NodeItemOne (ItemNode o))) -> do
                            r <- liftE $ node2reverse o
                            -- 7.4.11.1
                            ExpandedReverseObject rrs rvs <-
                                expandReverseObject fetch base active r
                            -- 7.4.11.2
                            let rrs' = M.map (V.map $ ExpandedItemOne . ExpandedAtomNode) rrs
                                vs = M.unionWith (V.++) (enodeValues n) rrs'
                            -- 7.4.11.3
                                rs = if M.null rvs
                                        then Nothing
                                        -- result cannot already have a
                                        -- @reverse member, the spec algo
                                        -- already checked for colliding
                                        -- keywords, and now unnecessarily
                                        -- wants us to check again. No need for
                                        -- that.
                                        else Just rvs
                            return n { enodeValues = vs, enodeReverse = rs }
                        _      -> throwE $ SpecError InvalidReverseValue ""
                -- 7.4.12
                -- Spec implies we skip, haven't checked playground, let's
                -- just raise an error here
                KeywordContainer -> throwE $ NodeObjectIgnoredField obj kw v
                KeywordBase -> throwE $ NodeObjectIgnoredField obj kw v
                KeywordVocab -> throwE $ NodeObjectIgnoredField obj kw v
            -}
            IdentURI u -> nonKW $ IdentURI u
            IdentBlank t -> nonKW $ IdentBlank t

    processPropertyNonKW active k v n erp =
        -- 7.5-7.11
        case v of
            Left nis -> do
                mev <- expandNodeValueForLO active k nis
                return $ case mev of
                    Nothing -> n
                    Just ev ->
                        let lo = case ev of
                                Left ei -> case ei of
                                    ExpandedItemOne ea ->
                                        ExpandedList Nothing $ V.singleton ea
                                    ExpandedItemList lo' -> lo'
                                Right eas -> ExpandedList Nothing eas
                        in  n   { enodeValues =
                                    M.insertWith
                                        (flip (V.++))
                                        erp
                                        (V.singleton $ ExpandedItemList lo) $
                                        enodeValues n
                                }
            Right nv -> case M.lookup k $ activeTerms active of
                Just TermDefinition { termReverse = True } -> do
                    mev <- expandNodeValueNonLO active k nv
                    case mev of
                        Nothing -> return n
                        Just ev -> do
                            ev' <- case ev of
                                One i  -> return $ V.singleton i
                                Many v -> return v
                            eris <- for ev' $ \ i -> case i of
                                ExpandedItemOne a -> case a of
                                    ExpandedAtomScalar _ -> Left $ SpecError InvalidReversePropertyValue ""
                                    ExpandedAtomNode m   -> return m
                                ExpandedItemList _ -> Left $ SpecError InvalidReversePropertyValue ""
                            return n
                                { enodeReverse = Just $ case enodeReverse n of
                                    Nothing -> M.singleton erp eris
                                    Just m  -> M.insertWith (flip (V.++)) erp eris m
                                }
                _ -> do
                    mev <- expandNodeValueNonLO active k nv
                    case mev of
                        Nothing -> return n
                        Just ev -> do
                            eis <- case ev of
                                One i  -> return $ V.singleton i
                                Many v -> return v
                            return n
                                { enodeValues =
                                    M.insertWith (flip (V.++)) erp eis $ enodeValues n
                                }

    isReverse (ActivePropertyKeyword KeywordReverse) = True
    isReverse _                                      = False

    checkReverse' a =
        if isReverse property
            then Left $ SpecError InvalidReversePropertyMap ""
            else a

    checkReverse f = checkReverse' . f

    setKeyword n g s a =
        case g n of
            Just _  -> Left $ SpecError CollidingKeywords ""
            Nothing -> maybe n (s n . Just) <$> a

    checkCollision n f a =
        case f n of
            Just _ -> Left $ SpecError CollidingKeywords ""
            Nothing -> a

    setEnodeId      n v = n { enodeId      = v }
    setEnodeType    n v = n { enodeType    = v }
    setEnodeGraph   n v = n { enodeGraph   = v }
    setEnodeIndex   n v = n { enodeIndex   = v }
    setEnodeReverse n v = n { enodeReverse = v }

    joinReverseValues = Many . V.concatMap toVector
        where
        toVector (One i)  = V.singleton i
        toVector (Many v) = v

expandNodeObject
    :: ActiveProperty
    -> NodeObject
    -> Either BereniceError (Maybe ExpandedNodeObject)
expandNodeObject property obj = do
    enode <- expandNodeObjectNotNull property obj
    -- 12 - Can't contain @value or @list, but check for the other conditions
    return $
        if nullOrGraph property && emptyOrOnlyId enode
            then Nothing
            else Just enode
  where
    nullOrGraph ActivePropertyNull                   = True
    nullOrGraph (ActivePropertyKeyword KeywordGraph) = True
    nullOrGraph _                                    = False

    emptyOrOnlyId (ExpandedNodeObject _id Nothing Nothing Nothing Nothing m) =
        M.null m
    emptyOrOnlyId _ = False

-- | Expand a JSON-LD document.
expandDocument
    :: Multi NodeObject -> Either BereniceError (Vector ExpandedNodeObject)
expandDocument (One no) = do
    meno <- expandNodeObject ActivePropertyNull no
    Right $ case meno of
        Nothing -> V.empty
        Just eno -> case eno of
            ExpandedNodeObject Nothing (Just g) Nothing Nothing Nothing m ->
                if M.null m
                    then toArray g
                    else V.singleton eno
            _ -> V.singleton eno
expandDocument (Many nos) =
    V.mapMaybe id <$> traverse (expandNodeObject ActivePropertyNull) nos

-- We're done with the expansion step. The next step in our process of parsing
-- JSON-LD into RDF is flattening. In this step we don't have to do the actual
-- flattening algorithm described in the JSON-LD API spec though. We just do
-- the part where we produce a node map.
--
-- The types for the structure we'll be producing:

data MappedAtom
    = MappedAtomScalar ExpandedScalarValue
    | MappedAtomNode Identifier
    deriving Eq

data MappedNodeObject = MappedNodeObject
    { mnodeId      :: Identifier
    , mnodeType    :: Maybe (Vector Identifier)
    , mnodeIndex   :: Maybe Text
    , mnodeValues  :: HashMap Identifier (Vector (Multi MappedAtom))
    -- ^ In the @Multi MappedAtom@, a @Many@ means a list object, and a @One@
    --   means single plain atom
    }

data NodeMap = NodeMap
    { nodeMapDefault :: Maybe (HashMap Identifier MappedNodeObject)
    , nodeMapNamed   :: HashMap Identifier (HashMap Identifier MappedNodeObject)
    }

-- And now the functions:

int2blank :: Int -> RelToken
int2blank counter =
    case parseRelToken $ BC.pack label of
        Nothing ->
            error $
                "berenice: int2blank: parseRelToken failed to parse: " ++ label
        Just rt -> rt
    where
    label = 'b' : show counter

newBlank :: Monad m => StateT (HashMap RelToken RelToken, Int) m RelToken
newBlank = do
    counter <- gets snd
    modify $ second (+ 1)
    return $ int2blank counter

replaceBlank
    :: Monad m
    => RelToken
    -> StateT (HashMap RelToken RelToken, Int) m RelToken
replaceBlank label = do
    (idmap, counter) <- get
    case M.lookup label idmap of
        Just entry -> return entry
        Nothing -> do
            let new = int2blank counter
            put (M.insert label new idmap, counter + 1)
            return new

generateNodeMap
    :: Monad m
    => Vector ExpandedNodeObject
    -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) NodeMap
generateNodeMap =
    foldlM (flip $ gnmNode activeGraphOpsDef Nothing) $ NodeMap Nothing M.empty
    where
    --newBlankK' :: Monad m => StateT (HashMap RelToken RelToken, Int) m Key'
    newBlankK' = IdentBlank <$> newBlank
    replaceBlankK' (IdentBlank b) = IdentBlank <$> replaceBlank b
    replaceBlankK' k              = return k
    idObject i = MappedNodeObject i Nothing Nothing M.empty
    {-
    initNode
        :: Monad m
        => ( NodeMap -> HashMap Key' MappedNodeObject
           , HashMap Key' MappedNodeObject -> NodeMap -> NodeMap
           )
        -> NodeMap
        -> ExpandedNodeObject
        -> StateT
            (HashMap Text Text, Int)
            m
            ( HashMap Key' MappedNodeObject
            , Key'
            , MappedNodeObject
            )
    -}
    initNode ops nodeMap object = do
        let (getGraph, _) = ops
            graph = getGraph nodeMap
        id_ <- maybe newBlankK' replaceBlankK' $ enodeId object
        let idObj = idObject id_
            node = M.lookupDefault idObj id_ graph
        return (graph, id_, node)
    insertSubject ap node s =
        let ins p v n = n { mnodeValues = M.insert p v $ mnodeValues n }
        in  case M.lookup ap $ mnodeValues node of
                    Nothing -> ins ap (V.singleton s) node
                    Just eis -> if s `elem` eis
                        then node
                        else ins ap (eis `V.snoc` s) node
    insertSubjectValue ap node =
        insertSubject ap node . One . MappedAtomScalar
    insertSubjectNode ap node =
        insertSubject ap node . One . MappedAtomNode
    insertSubjectList ap node =
        insertSubject ap node . Many
    activeGraphOpsDef =
        ( fromMaybe M.empty . nodeMapDefault
        , \ g nm -> nm { nodeMapDefault = Just g }
        )
    activeGraphOpsNamed gid =
        ( M.lookupDefault M.empty gid . nodeMapNamed
        , \ g nm -> nm { nodeMapNamed = M.insert gid g $ nodeMapNamed nm }
        )
    {-
    processNode
        :: Monad m
        => NodeMap
        -> ( NodeMap -> HashMap Key' MappedNodeObject
           , HashMap Key' MappedNodeObject -> NodeMap -> NodeMap
           )
        -> HashMap Key' MappedNodeObject
        -> MappedNodeObject
        -> ExpandedNodeObject
        -> Key'
        -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) NodeMap
    -}
    processNode nodeMap ops graph node object id_ = do
        mtypes <- lift $ traverse (traverse replaceBlankK') $ enodeType object
        let (_getGraph, setGraph) = ops
            node' = case mtypes of
                Nothing -> node
                Just ks -> case mnodeType node of
                    Nothing -> node { mnodeType = Just ks }
                    Just ks' -> node { mnodeType = Just $ ks' V.++ (V.filter (`notElem` ks') ks) }
        node'' <- case enodeIndex object of
            Nothing -> return node'
            Just i -> case mnodeIndex node' of
                Nothing -> return node' { mnodeIndex = Just i }
                Just i' -> if i == i'
                    then return node'
                    else throwE $ SpecError ConflictingIndexes ""
        let nodeMap' = setGraph (M.insert id_ node'' graph) nodeMap
        nodeMap'' <- case enodeReverse object of
            Nothing -> return nodeMap'
            Just r ->
                let f p nm eno = gnmNode ops (Just (p, Just id_)) eno nm
                    g nm (p, enos) = foldlM (f p) nm enos
                in  foldlM g nodeMap' $ M.toList r
        nodeMap''' <- case enodeGraph object of
            Nothing -> return nodeMap''
            Just gs ->
                let f nm g = gnmNode (activeGraphOpsNamed id_) Nothing g nm
                in  foldlM f nodeMap'' gs
        let f p nm v = case v of
                ExpandedItemOne a -> case a of
                    ExpandedAtomScalar vo -> gnmValue ops id_ p vo nm
                    ExpandedAtomNode no -> gnmNode ops (Just (p, Nothing)) no nm
                ExpandedItemList l -> gnmList ops id_ p (elistArray l) nm
            g nm (p, vs) = do
                p' <- lift $ replaceBlankK' p
                foldlM (f p') nm vs
        foldlM g nodeMap''' $ M.toList $ enodeValues object
    gnmValue ops as ap value nodeMap = do
        let (getGraph, setGraph) = ops
            graph = getGraph nodeMap
        node <- case M.lookup as graph of
            Just n -> return n
            -- TODO here and in gnmList below, if it's proven that the key does
            -- exist, maybe we can somehow change the code such that we never
            -- have to deal with the Nothing? If changing the code as is
            -- doesn't work, try the justified-containers package, see if it
            -- can be used here
            Nothing -> throwE $ error "Oops, active subject not found!!!"
        let node' = insertSubjectValue ap node value
        return $ setGraph (M.insert as node' graph) nodeMap
    gnmValueWithList list value nodeMap =
        return (nodeMap, list `V.snoc` MappedAtomScalar value)
    {-
    gnmList
        :: Monad m
        => ( NodeMap -> HashMap Key' MappedNodeObject
           , HashMap Key' MappedNodeObject -> NodeMap -> NodeMap
           )
        -> Key'
        -> Key'
        -> Vector ExpandedAtom
        -> NodeMap
        -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) NodeMap
    -}
    gnmList ops as ap arr nodeMap = do
        -- TODO 5.2 says to pass the active subject, is there a reason? Where
        -- does it get used? for value objects it isn't used, and for node
        -- objects only the object form is used (for @reverse), while here it
        -- seems rquired the active subject is a string. Below I'm simply not
        -- passing it for this reason; is it possible I missed something? Or
        -- the algo is being silly? Because unless I missed something, the algo
        -- could have said to pass 'null' for active subject, and behavior
        -- would be the same, beside the seemingly unnecessary lookup in step 2
        let f (nm, l) (ExpandedAtomScalar vo) = gnmValueWithList l vo nm
            f (nm, l) (ExpandedAtomNode no) = gnmNodeWithList ops ap l no nm
        (nodeMap', list) <- foldlM f (nodeMap, V.empty) arr
        let (getGraph, setGraph) = ops
            graph = getGraph nodeMap'
        node <- case M.lookup as graph of
            Just n -> return n
            Nothing -> throwE $ error "Oops, active subject not found!!!"
        let node' = insertSubjectList ap node list
        return $ setGraph (M.insert as node' graph) nodeMap'
    {-
    gnmNode
        :: Monad m
        => ( NodeMap -> HashMap Key' MappedNodeObject
           , HashMap Key' MappedNodeObject -> NodeMap -> NodeMap
           )
        -> Maybe (Key', Maybe Key')
        -> ExpandedNodeObject
        -> NodeMap
        -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) NodeMap
    -}
    gnmNode ops activeSubjectAndProperty object nodeMap = do
        (graph, id_, node) <- lift $ initNode ops nodeMap object
        let node' = case activeSubjectAndProperty of
                Nothing -> node
                Just (ap, mas) -> insertSubjectNode ap node $ case mas of
                    Just as -> as
                    Nothing -> id_
        processNode nodeMap ops graph node' object id_
    {-
    gnmNodeWithList
        :: Monad m
        => ( NodeMap -> HashMap Key' MappedNodeObject
           , HashMap Key' MappedNodeObject -> NodeMap -> NodeMap
           )
        -> Key'
        -> Vector MappedAtom
        -> ExpandedNodeObject
        -> NodeMap
        -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) (NodeMap, Vector MappedAtom)
    -}
    gnmNodeWithList ops ap l object nodeMap = do
        (graph, id_, node) <- lift $ initNode ops nodeMap object
        let list = l `V.snoc` MappedAtomNode id_
        flip (,) list <$> processNode nodeMap ops graph node object id_

-- Finally, now we do the deserialization step (which could enjoy a better
-- name), converting the node map into RDF triples.
--
-- Some helper types:

data TypedLiteralString = TypedLiteralString
    { lsText :: Text
    , lsLang :: Maybe Text
    }

data TypedLiteralNB = TypedLiteralNumber Scientific | TypedLiteralBool Bool

data TypedLiteral = TypedLiteral
    { tlitValue :: Either TypedLiteralNB TypedLiteralString
    , tlitType  :: URI Gen
    }

-- Now the types for the structure we'll produce:

data PlainLiteral = PlainLiteral
    { literalLexical  :: Text
    , literalTypeLang :: Either (URI Gen) Text
    }

data Node
    = NodeIdent Identifier
    | NodeLiteral PlainLiteral

data Triple = Triple
    { tripleSubject  :: Identifier
    , tripleProperty :: URI Gen
    , tripleObject   :: Node
    }

data RdfDataset = RdfDataset
    { rdfDefault :: [Triple]
    , rdfNamed   :: HashMap Identifier [Triple]
    }

-- And the functions:

u_langString, u_string, u_boolean, u_integer, u_double, u_first, u_rest, u_nil,
    u_type, u_List :: URI Gen
u_langString = $(rdf "langString")
u_string     = $(xsd "string")
u_boolean    = $(xsd "boolean")
u_integer    = $(xsd "integer")
u_double     = $(xsd "double")
u_first      = $(rdf "first")
u_rest       = $(rdf "rest")
u_nil        = $(rdf "nil")
u_type       = $(rdf "type")
u_List       = $(rdf "List")

-- | Serialize a Haskell typed literal into a plain textual one. The textual
-- literal can then be used when serializing RDF data for storage, or for
-- sending over the network, or for rendering a query, and so on. The plain
-- literal is the canonical representation, while the typed one is for
-- convenience of manipulating and using data in Haskell.
typed2plain :: TypedLiteral -> Either BereniceError PlainLiteral
typed2plain (TypedLiteral vl typ) =
    case (typ == u_langString, mlang) of
        (True, Nothing) -> Left $ LangStringNoLanguage vl
        (False, Just lang) -> Left $ NonLangStringHasLanguage vl lang
        _ -> case vl of
            Left nb -> flip PlainLiteral (Left typ) <$>
                case nb of
                    TypedLiteralBool b -> Right $ if b then "true" else "false"
                    TypedLiteralNumber s ->
                        if isInteger s && typ /= u_double
                            then case toInt64 s of
                                Nothing -> Left $ SuspiciouslyBigInteger s
                                Just i  -> Right $ T.pack $ show i
                            else case toDouble s of
                                Nothing -> Left $ OutOfRangeOfDouble s
                                Just d ->
                                    Right $ T.pack $ showEFloat Nothing d ""
            Right (TypedLiteralString t ml) ->
                Right $ PlainLiteral t $
                    case mlang of
                        Nothing -> Left typ
                        Just l  -> Right l
    where
    mlang = case vl of
        Left _ -> Nothing
        Right s -> lsLang s
    toInt64 :: Scientific -> Maybe Int64
    toInt64 = toBoundedInteger
    toDouble :: Scientific -> Maybe Double
    toDouble = either (const Nothing) Just . toBoundedRealFloat

value2resource :: ExpandedScalarValue -> TypedLiteral
value2resource (ExpandedScalarValue value _index) =
    case value of
        Left (ExpandedNBValue v mt) ->
            case v of
                Left s -> TypedLiteral
                    { tlitValue = Left $ TypedLiteralNumber s
                    , tlitType  =
                        case mt of
                            Just u -> u
                            Nothing ->
                                if isInteger s
                                    then u_integer
                                    else u_double
                    }
                Right b -> TypedLiteral
                    { tlitValue = Left $ TypedLiteralBool b
                    , tlitType  = fromMaybe u_boolean mt
                    }
        Right (ExpandedStringValue text _token mtorl) -> TypedLiteral
            { tlitValue = Right TypedLiteralString
                { lsText = text
                , lsLang =
                    case mtorl of
                        Just (Right l) -> Just l
                        _              -> Nothing
                }
            , tlitType =
                case mtorl of
                    Just (Left u)  -> u
                    Just (Right _) -> u_langString
                    Nothing        -> u_string
            }

object2rdf :: MappedAtom -> Either BereniceError Node
object2rdf (MappedAtomScalar s) =
    fmap NodeLiteral $ typed2plain $ value2resource s
object2rdf (MappedAtomNode i) = Right $ NodeIdent i

list2rdf
    :: Monad m
    => Vector MappedAtom
    -> ExceptT BereniceError (StateT (HashMap RelToken RelToken, Int) m) [Triple]
list2rdf =
    ((foldr mkTriples [] . foldr mkRest []) <$>) .
    traverse (\ a -> (,) <$> lift newBlank <*> liftE (object2rdf a))
    where
    liftE = ExceptT . pure
    rest []            = IdentURI u_nil
    rest ((s, _, _):_) = IdentBlank s
    mkRest (s, o) l = (s, o, NodeIdent $ rest l) : l
    mkTriples (s, o, r) l =
        Triple (IdentBlank s) u_first o : Triple (IdentBlank s) u_rest r : l

deserializeToRDF
    :: Vector ExpandedNodeObject -> Either BereniceError RdfDataset
deserializeToRDF = flip evalState (M.empty, 0) . runExceptT . doc2triples
    where
    liftE :: Monad m => Either a b -> ExceptT a m b
    liftE = ExceptT . pure
    eno2triples subject node = do
        nonkw <- fmap concat $ for (M.toList $ mnodeValues node) $
            \ (p, mis) -> case p of
                IdentBlank b -> throwE $ BlankProperty subject b
                IdentURI u -> fmap fold $ for mis $ \ mi -> case mi of
                    One ma -> do
                        object <- liftE $ object2rdf ma
                        return [Triple subject u object]
                    Many ml -> do
                        ts <- list2rdf ml
                        return $ case ts of
                            [] ->
                                [Triple
                                    subject
                                    u $
                                    NodeIdent $ IdentURI u_nil
                                ]
                            (t:_) ->
                                let triple =
                                        Triple
                                            subject
                                            u
                                            (NodeIdent $ tripleSubject t)
                                in  triple : ts
        let typ2triple = Triple subject u_type . NodeIdent
            typ = maybe [] (V.toList . V.map typ2triple) $ mnodeType node
        return $ typ ++ nonkw
    graph2triples = fmap concat . traverse (uncurry eno2triples) . M.toList
    doc2triples enos = do
        NodeMap mdef named <- generateNodeMap enos
        RdfDataset
            <$> maybe (pure []) graph2triples mdef
            <*> traverse graph2triples named

-- Finally, we define a function that does the whole process, from plain JSON
-- all the way to RDF triples.

jsonld2rdf
    :: Monad m
    => (URI Gen -> ExceptT BereniceError m (Multi Dictionary))
    -> URI Gen
    -> Multi Dictionary
    -> ExceptT BereniceError m RdfDataset
jsonld2rdf fetch base
    =   ExceptT . pure . traverse parseDocument
    >=> traverse
            (tagDocument fetch base >=> ExceptT . pure . specializeDocument)
    >=> ExceptT . pure . (expandDocument >=> deserializeToRDF)

-- TODO after expansion, drop the esToken field? Do we ever need it? I mean, if
-- expansion produces ExpandedStringValue etc. perhaps remove the esToken field
-- because we use it *during* expansion, and after that iirc it's never really
-- used?

-- We're done with the code for converting from JSON to RDF. Below comes the
-- other direction, serializing an RDF dataset into a JSON-LD document.
--
-- The first step in our process of serializing RDF to JSON-LD is to build a
-- node map. In other words, we apply the RDF to JSON-LD serialization
-- algorithm, but for each graph separately, not combining them yet into a
-- single JSON-LD document.
--
-- We're converting between existing types, 'RdfDataset' and 'NodeMap', but we
-- still define some helper types:

-- | A type for tracking references to a node. Given a node with identifier
-- /i/, are there triples in which /i/ is used as the object? For each such
-- occurence we keep a 'Usage' value. It specifies the node object that makes
-- use of /i/, and in which property. In other words, it means that node object
-- /n/ has a property /p/ and the value associated with it is /i/.
data Usage = Usage
    { usageNode     :: Identifier
    , usageProperty :: URI Gen
    -- , usageValue    :: Identifier
    }

data Single a = None | Single a | More deriving Functor

data UseNativeTypes = UseNativeTypes | DontUseNativeTypes

data UseRdfType = UseRdfType | UseTypeKeyword

-- And now the functions for building the node map:

-- | Convert the object of an RDF triple into an object suitable for use as a
-- value in a node object's key-value map.
--
-- The conversion into native types is stricter than required by the spec:
--
-- * For xsd:boolean, the spec converts @true@ and @false@ into boolean
--   literals and anything else remains as a string literal. But in this
--   implementation, @true@, @false@, 0 and 1 are converted into boolean
--   literals (because that's the standard lexical space for xsd:boolean) and
--   anything else raises an error.
-- * For xsd:double and xsd:integer, the spec converts a valid lexical form
--   into a numeric literal, and otherwise keeps it as a string literal. But in
--   this implementation, an invalid lexical form results with an error.
rdf2object :: UseNativeTypes -> Node -> Either BereniceError MappedAtom
rdf2object _ (NodeIdent i) = Right $ MappedAtomNode i
rdf2object native (NodeLiteral (PlainLiteral lexical torl)) =
    MappedAtomScalar . flip ExpandedScalarValue Nothing <$>
        case native of
            UseNativeTypes ->
                case torl of
                    Left typ
                        | typ == u_boolean ->
                            case lexical of
                                "true"  -> Right $ Left $ boolean True
                                "false" -> Right $ Left $ boolean False
                                "1"     -> Right $ Left $ boolean True
                                "0"     -> Right $ Left $ boolean False
                                _       -> Left $ InvalidXsdBoolean lexical
                        | typ == u_integer ->
                            case readMaybe $ T.unpack lexical of
                                Nothing -> Left $ InvalidXsdInteger lexical
                                Just i ->
                                    Right $ Left $ number $ scientific i 0
                        | typ == u_double ->
                            case readMaybe $ T.unpack lexical of
                                Nothing -> Left $ InvalidXsdDouble lexical
                                Just s  -> Right $ Left $ number s
                        | otherwise -> Right $ Right string
                    Right _ -> Right $ Right string
            DontUseNativeTypes -> Right $ Right string
    where
    string = ExpandedStringValue
        { esText       = lexical
        , esToken      = parseToken lexical
        , esTypeOrLang =
            case torl of
                Left typ ->
                    if typ == u_string
                        then Nothing
                        else Just $ Left typ
                Right lang -> Just $ Right lang
        }
    boolean b = ExpandedNBValue
        { enbValue = Right b
        , enbType  = Nothing
        }
    number s = ExpandedNBValue
        { enbValue = Left s
        , enbType  = Nothing
        }

-- TODO in the property-objects map below we use Vector but we really mean
-- NonEmpty i.e. assume it can't be an empty Vector, no need to use V.null
-- because we assume it's guaranteed to be False

-- | Build a node object from the RDF triples that describe it.
--
-- This function takes RDF triples as input, all of which share the same
-- subject. The triples are passed in the form of 3 parameters:
--
-- * The 'Identifier' is the shared subject of the triples.
-- * The 'Vector' is a list of types the subject is a member of. For each type
--   identifier /i/, the triple *s - rdf:type - i* is represented, where *s* is
--   the shared subject. Note that the 'Vector' must be non-empty! If there are
--   no triples with the rdf:type property, pass 'Nothing'.
-- * The 'HashMap' represents the rest of the triples, i.e. all the ones whose
--   property isn't rdf:type. For each key *k* in the map, for each node *n* in
--   the 'Vector' associated with it, the triple @s - k - n@ is represented.
--   Note that all these 'Vector' must be non-empty! If some property isn't
--   used, simply don't insert it into the 'HashMap' at all.
mappedNodeObject
    :: UseNativeTypes
    -- ^ Whether to try converting literals to native JSON literals, or
    --   serialize all literals as JSON strings
    -> UseRdfType
    -- ^ Whether to serialize the rdf:type property as rdf:type or as @type in
    --   the produced JSON-LD document
    -> Identifier
    -- ^ The shared subject of all the triples
    -> Maybe (Vector Identifier)
    -- ^ A list of nodes for rdf:type, i.e. each node /i/ represents the triple
    --   @s - rdf:type - i@ where /s/ is the shared subject
    -> HashMap (URI Gen) (Vector Node)
    -- ^ The rest of the triples, i.e. everything except for rdf:type. The map
    --   keys are properties and each property maps to a 'Vector' of triple
    --   objects. For each property /p/ and a node /n/ from the vector it maps
    --   to, the triple @s - p - n@ is expressed, where /s/ is the shared
    --   subject.
    -> Either BereniceError MappedNodeObject
mappedNodeObject native rdftype subject mtypes properties =
    let mno vs = MappedNodeObject
            { mnodeId     = subject
            , mnodeType   =
                case UseRdfType of
                    UseRdfType     -> Nothing
                    UseTypeKeyword -> mtypes
            , mnodeIndex  = Nothing
            , mnodeValues = vs
            }
        prop2value property nodes =
            (,) (IdentURI property) . V.map One <$>
                traverse (rdf2object native) nodes
        insertTypes =
            case (UseRdfType, mtypes) of
                (UseRdfType, Just types) ->
                    M.insert
                        (IdentURI u_type)
                        (V.map (One . MappedAtomNode) types)
                _ -> id
    in  mno . insertTypes . M.fromList <$>
            traverse (uncurry prop2value) (M.toList properties)

nodeObjectUsageOf
    :: Identifier
    -> HashMap (URI Gen) (Vector Node)
    -> [URI Gen]
nodeObjectUsageOf ident =
    M.keys . M.filter (V.elem ident . V.mapMaybe node2ident)
    where
    node2ident (NodeIdent i)   = Just i
    node2ident (NodeLiteral _) = Nothing

-- | This function takes RDF triples as input, all of which share the same
-- subject. That shared subject isn't passed because it isn't used here. And
-- the 'HashMap' maps from properties to objects. So each 'Node' in the vector
-- represents a separate triple.
--
-- The output is a mapping containing all the references it makes to other node
-- objects (or to itself), i.e. triples in which the object is an IRI or a
-- blank node. The mapping is organized by referred object, i.e. for each
-- referred object there's a non-empty list of the properties through which it
-- is referred to.
--
-- NOTE: Since for each referred object we'll only need at most a single usage
-- (because when there's more than one, we don't build a list object), we're
-- only keeping one usage per object, via the 'Single' type. To be more
-- precise, we need to generate all the usages that target rdf:nil, and just
-- one usage targetting each blank node identifier, and for URIs which aren't
-- rdf:nil we don't need to generate usages at all.
--
-- So, here we just generate a usage for each blank node identifier. We'll
-- separately generate the usages for rdf:nil.
nodeObjectBlankUsage
    :: HashMap (URI Gen) (Vector Node)
    -> HashMap RelToken (Single (URI Gen))
nodeObjectBlankUsage =
    M.fromList .
    -- ^ Turn into a 'HashMap', the identifiers are unique so we don't lose any
    --   data here
    --   Result: HashMap Text (Single (URI Gen))
    map (second $ fmap snd) .
    -- -- ^ Since each 'NonEmpty' shares the identifier, extract it from there to
    --   be attached just once, to a 'NonEmpty' of properties
    --   Result: [(Text, Single (URI Gen))]
    groupAllWith fst .
    -- ^ Sort and group by identifier i.e. the referred node
    --   Result: [(Text, Single (Text, URI Gen))]
    concat .
    -- ^ Each list is for one property, concatenate them all together now
    --   Result: [(Text, URI Gen)]
    map (NE.toList . (\ (prop, idents) -> flip (,) prop <$> idents)) .
    -- ^ Attach the property to all identifiers
    --   Result: [[(Text, URI Gen)]]
    M.toList .
    -- ^ Result: [URI Gen, NonEmpty Text]
    M.mapMaybe (nonEmpty . V.toList . V.mapMaybe node2blank)
    -- ^ Filter out nodes that are literals or URIs, keep only blanks
    --   Result: HashMap (URI Gen) (NonEmpty Text)
    where
    node2blank (NodeIdent (IdentBlank b)) = Just b
    node2blank _                          = Nothing

    groupWith :: Eq b => (a -> b) -> [a] -> [(b, Single a)]
    groupWith f = go . map (\ x -> (x, f x))
        where
        go []            = []
        go ((x, y) : ps) = go' x y ps
        go' x y ps =
            case ps of
                []            -> [(y, Single x)]
                ((u, v) : qs) ->
                    if y == v
                        then (y, More)     : go (dropWhile ((== y) . snd) qs)
                        else (y, Single x) : go' u v qs

    groupAllWith :: Ord b => (a -> b) -> [a] -> [(b, Single a)]
    groupAllWith f = groupWith f . sortOn f

-- | This function combines 'mappedNodeObject', 'nodeObjectBlank Usage' and
-- 'nodeObjectUsageOf' for rdf:nil. It extracts the rdf:type triples, applies
-- those 3 functions and returns a tuple containing their results.
--
-- NOTE 1: In the specification's algorithm, if use-rdf-type is set to false,
-- we place the type(s) under a @type property only if their values are URIs or
-- blank nodes. If one of the types is found to be a literal, we keep it
-- silently under rdf:type. The implementation here, however, *always* checks
-- the types, regardless of the use-rdf-type option, and if any of them are
-- found to be literals, it raises an error instead of quietly accepting them.
--
-- NOTE 2: In the specification's algorithm, if use-rdf-type is set to false,
-- i.e. we use @type, it's excluded from the list of usages. In other words,
-- the URIs associated with rdf:type are assumed not to be RDF lists and aren't
-- checked for that. The implementation here follows that, but it excludes
-- rdf:type even in the case use-rdf-type is true, i.e. regardless of whether
-- we encode it as @type or as rdf:type, we assume here that the type of
-- something can't be a list (a resource can be of more than one type, but, we
-- assume none of those types can be lists).
--
-- By the way, the RDF schema spec says the range of the rdf:type property is
-- rdfs:Class.
nodeAndUsage
    :: UseNativeTypes
    -> UseRdfType
    -> Identifier
    -> HashMap (URI Gen) (Vector Node)
    -> Either
        BereniceError
        (MappedNodeObject, ([URI Gen], HashMap RelToken (Single (URI Gen))))
nodeAndUsage native rdftype subject properties = do
    let (mtypes, properties') = lookupAndDelete u_type properties
    mtypes' <- traverse (traverse $ node2type subject) mtypes
    let result mno =
            ( mno
            , ( nodeObjectUsageOf (IdentURI u_nil) properties'
              , nodeObjectBlankUsage properties'
              )
            )
    result <$> mappedNodeObject native rdftype subject mtypes' properties'
    where
    node2type _ (NodeIdent id_)  = Right id_
    node2type i (NodeLiteral pl) = Left $ InvalidRdfType i pl

-- | For each node object /n/ in the graph, attach its usages, i.e. node
-- objects that have a property associated with the @id of /n/. The input is a
-- graph in which each node object specifies its usage of other node objects:
-- It's a map from such an object's identifier to the list of properties by
-- which it's referred to.
attachUsages
    :: HashMap
        Identifier
        (MappedNodeObject, ([URI Gen], HashMap RelToken (Single (URI Gen))))
    -> (HashMap Identifier (MappedNodeObject, Single Usage), [Usage])
attachUsages g =
    let initial = M.map (second $ const None) g
        mkUsages (mno, um) = M.map (fmap $ Usage $ mnodeId mno) $ snd um
        glist = M.toList g
        blankUsages = map (mkUsages . snd) glist
        nilUsages =
            concatMap (\ (i, (_, (props, _))) -> map (Usage i) props) glist
        midObj i = MappedNodeObject i Nothing Nothing M.empty
        combine (_, new) (mno, old) = (mno, old `add` new)
        f = M.foldlWithKey' $ \ m b su ->
                let i = IdentBlank b
                in  M.insertWith combine i (midObj i, su) m
    in  (foldl' f initial blankUsages, nilUsages)
    where
    add None       s    = s
    add (Single a) None = Single a
    add _          _    = More

gatherListObjectItems
    :: HashMap Identifier (MappedNodeObject, Single Usage)
    -> Usage
    -> [(Identifier, MappedAtom)]
    -> (Usage, Identifier, [(Identifier, MappedAtom)])
gatherListObjectItems graph (Usage i p) = go (graph M.! i) p $ IdentURI u_nil
    where
    oneMaybe v =
        if V.length v == 1
            then Nothing
            else Just $ V.head v
    optionalMaybe v =
        case V.length v of
            0 -> Just Nothing
            1 -> Just $ Just $ V.head v
            _ -> Nothing
    rdfList Nothing   = False
    rdfList (Just mi) =
        case mi of
            Nothing -> True
            Just i  -> i /= IdentURI u_List
    listNode (MappedNodeObject _ mtypes mi vals) su p =
        let (firsts, vals1) = lookupAndDelete (IdentURI u_first) vals
            (rests, vals2) = lookupAndDelete (IdentURI u_rest) vals1
        in  case ( p == u_rest
                 , su
                 , oneMaybe =<< firsts
                 , oneMaybe =<< rests
                 , M.null vals2
                 , mi
                 , rdfList $ optionalMaybe =<< mtypes
                 ) of
                (True, Single u, Just (One first), Just _, True, Nothing, True)
                    -> Just (u, first)
                _ -> Nothing
    go (mno, su) property value items =
        let ident = mnodeId mno
        in  case listNode mno su property of
                Nothing -> (Usage ident property, value, items)
                Just (u'@(Usage ident' property'), first) ->
                    let items' = (ident, first) : items
                    in  case ident' of
                            IdentURI _ -> (u', ident, items')
                            IdentBlank _ ->
                                go (graph M.! ident') property' ident items'

buildListObjects
    :: HashMap Identifier (MappedNodeObject, Single Usage)
    -> Usage
    -> HashMap Identifier (MappedNodeObject, Single Usage)
buildListObjects graph usage =
    let (Usage nodeIdent property, headId, items) =
            gatherListObjectItems graph usage []
        canConvert =
            if property == u_first
                then case items of
                    []            -> Nothing
                    ((s, _) : is) ->
                        Just $ case is of
                            []           -> (headId, u_rest, s, is)
                            ((h, _) : _) -> (s     , u_rest, h, is)
                else Just (nodeIdent, property, headId, items)
    in  case canConvert of
            Nothing                    -> graph
            Just (subj, prop, hid, is) ->
                let (subjects, array) = unzip is
                    adjustProp vals =
                        case V.elemIndex (One $ MappedAtomNode hid) vals of
                            Nothing -> error "Impossible!"
                            Just i  -> vals V.// [(i, Many $ V.fromList array)]
                    adjustMNO (mno, us) =
                        ( mno
                            { mnodeValues =
                                M.adjust adjustProp (IdentURI prop) $
                                    mnodeValues mno
                            }
                        , us
                        )
                in  foldl'
                        (flip M.delete)
                        (M.adjust adjustMNO subj graph)
                        subjects

serializeGraph
    :: UseNativeTypes
    -> UseRdfType
    -> HashMap Identifier (HashMap (URI Gen) (Vector Node))
    -> Either BereniceError (HashMap Identifier MappedNodeObject)
serializeGraph native rdftype graph = do
    nodesUsages <- M.traverseWithKey (nodeAndUsage native rdftype) graph
    let (graphWithUsage, nilUsages) = attachUsages nodesUsages
    return $ M.map fst $ foldl' buildListObjects graphWithUsage nilUsages

-- TODO somewhere above there's a usage of groupAllWith iirc? Maybe I can
-- replace it with the groupAllExtract defined below?

triples2map :: [Triple] -> HashMap Identifier (HashMap (URI Gen) (Vector Node))
triples2map = recordMap3 tripleSubject tripleProperty tripleObject

rdf2nm
    :: UseNativeTypes
    -> UseRdfType
    -> RdfDataset
    -> Either BereniceError NodeMap
rdf2nm native rdftype (RdfDataset def named) =
    NodeMap
        <$> (Just <$> serialize def)
        <*> traverse serialize named
    where
    serialize = serializeGraph native rdftype . triples2map

-- Once we've built the node map, the next step is to produce a JSON-LD
-- document from it. Let's call it render, we render the node map. It's the
-- opposite of generating a node map.
--
-- Building the node map and then rendering it, these two steps together,
-- correspond to the RDF-to-JSONLD serialization algorithm in the
-- specification.

renderNodeMap :: NodeMap -> Vector ExpandedNodeObject
renderNodeMap (NodeMap mdef named) =
    V.fromList $
    map (uncurry named2eno) (M.toList named) ++ maybe [] graph2enos mdef
    where
    onlyId (MappedNodeObject _ Nothing Nothing m) = M.null m
    onlyId _                                      = False
    ma2ea (MappedAtomScalar esv) = ExpandedAtomScalar esv
    ma2ea (MappedAtomNode i)     = ExpandedAtomNode ExpandedNodeObject
        { enodeId      = Just i
        , enodeGraph   = Nothing
        , enodeType    = Nothing
        , enodeReverse = Nothing
        , enodeIndex   = Nothing
        , enodeValues  = M.empty
        }
    mma2ei (One a)   = ExpandedItemOne $ ma2ea a
    mma2ei (Many as) = ExpandedItemList $ ExpandedList Nothing $ V.map ma2ea as
    mno2eno (MappedNodeObject id_ mtypes mindex vals) = ExpandedNodeObject
        { enodeId      = Just id_
        , enodeGraph   = Nothing
        , enodeType    = mtypes
        , enodeReverse = Nothing
        , enodeIndex   = mindex
        , enodeValues  = M.map (V.map mma2ei) vals
        }
    graph2enos = map mno2eno . filter (not . onlyId) . M.elems
    named2eno i g = ExpandedNodeObject
        { enodeId      = Just i
        , enodeGraph   = Just $ Many $ V.fromList $ graph2enos g
        , enodeType    = Nothing
        , enodeReverse = Nothing
        , enodeIndex   = Nothing
        , enodeValues  = M.empty
        }

-- After rendering the node map, we've obtained a valid JSON-LD document.
-- However, we may wish to compact it, transform it into compacted form.
-- JSON-LD compaction is done here in three steps. Much like the expansion
-- algorithm occurs in three steps here, tagging and specialization and
-- expansion, the compaction algorithm occurs in three steps as well:
-- Compaction, generalization and untagging.
--
-- Let's start with the compaction step. In this step we tag properties with
-- their compacted versions (determined by the IRI compaction algorithm) and do
-- some transformations on the values associated by them. The rest of the
-- process, the actual reorganizing of the objects to be mapped by compacted
-- properties, will happen during generalization and untagging.
--
-- Here are some helper types for the compaction step:

data InverseTerm = InverseTerm
    { itTerm       :: Ref
    , itReverse    :: Bool
    , itTypeOrLang :: Maybe (Either TermDefinitionType ContextLanguage)
    }

data ByContainer i = ByContainer
    { bcNone  :: i
    , bcNull  :: i
    , bcSet   :: i
    , bcList  :: i
    , bcLang  :: i
    , bcIndex :: i
    }
    deriving Functor

data TypeMap = TypeMap
    { tmNone    :: Maybe Ref
    , tmId      :: Maybe Ref
    , tmVocab   :: Maybe Ref
    , tmReverse :: Maybe Ref
    , tmValues  :: HashMap (URI Gen) Ref
    }

data LanguageMap = LanguageMap
    { lmNone    :: Maybe Ref
    , lmNull    :: Maybe Ref
    , lmValues  :: HashMap Text Ref
    }

type ContainerMap = ByContainer (LanguageMap, TypeMap)

type InverseContext = HashMap IdentKw ContainerMap

-- And here are the functions for compacting an expanded document:

renderAC :: AbsoluteOrCompact -> ByteString
renderAC (JustAbsolute u)        = renderURI u
renderAC (JustCompact c)         = renderCompactURI c
renderAC (AbsoluteOrCompact _ c) = renderCompactURI c

showRef :: Ref -> Text
showRef = decodeUtf8 . showRef'
    where
    showRef' (RefURI ac)   = renderAC ac
    showRef' (RefBlank rt) = "_:" <> renderRelToken rt
    showRef' (RefTerm rel) = renderRelNoAuth rel

inverseContext :: ActiveContext -> InverseContext
inverseContext (ActiveContext _mbase _mvocab mlang terms) =
    M.fromList $
    -- ^ Result: HashMap IdentKw (ByContainer (LanguageMap, TypeMap))
    map (second $
            fmap (foldl' update emptyLT . sortBy (order `on` itTerm)) .
            -- ^ Result: ByContainer (LanguageMap, TypeMap)
            foldr collect emptyITM
            -- ^ Result: ByContainer [InverseTerm]
            --   Input:  NonEmpty (Ref, TermDefinition)
        ) $
    -- ^ Result: [(IdentKw, ByContainer (LanguageMap, TypeMap))]
    groupAllExtract (termTarget . snd) id $
    -- ^ Result: [(IdentKw, NonEmpty (Ref, TermDefinition))]
    M.toList terms
    -- ^ Result: [(Ref, TermDefinition)]
    where
    emptyITM :: ByContainer [InverseTerm]
    emptyITM = ByContainer [] [] [] [] [] []
    collect :: (Ref, TermDefinition) -> ByContainer [InverseTerm] -> ByContainer [InverseTerm]
    collect (term, TermDefinition _ reverse mtorl mcontainer) itm =
        let it = InverseTerm term reverse mtorl
        in  case mcontainer of
                Nothing        -> itm { bcNone = it : bcNone itm }
                Just container -> case container of
                    ContainerNull     -> itm { bcNull  = it : bcNull itm  }
                    ContainerSet      -> itm { bcSet   = it : bcSet itm   }
                    ContainerList     -> itm { bcList  = it : bcList itm  }
                    ContainerLanguage -> itm { bcLang  = it : bcLang itm  }
                    ContainerIndex    -> itm { bcIndex = it : bcIndex itm }
    order :: Ref -> Ref -> Ordering
    order s t =
        case s' `T.compareLength` T.length t' of
            LT -> LT
            GT -> GT
            EQ -> compare s' t'
        where
        s' = showRef s
        t' = showRef t
    emptyLT =
        ( LanguageMap Nothing Nothing M.empty
        , TypeMap Nothing Nothing Nothing Nothing M.empty
        )
    update :: (LanguageMap, TypeMap) -> InverseTerm -> (LanguageMap, TypeMap)
    update lt@(lm, tm) (InverseTerm term reverse mtorl) =
        if reverse
            then case tmReverse tm of
                Just _  -> lt
                Nothing -> (lm, tm { tmReverse = Just term })
            else case mtorl of
                Just torl -> case torl of
                    Left typ -> case typ of
                        TermDefinitionTypeId -> case tmId tm of
                            Just _  -> lt
                            Nothing -> (lm, tm { tmId = Just term })
                        TermDefinitionTypeVocab -> case tmVocab tm of
                            Just _  -> lt
                            Nothing -> (lm, tm { tmVocab = Just term })
                        TermDefinitionTypeAbsolute u -> case M.lookup u $ tmValues tm of
                            Just _  -> lt
                            Nothing -> (lm, tm { tmValues = M.insert u term $ tmValues tm })
                    Right lang -> case lang of
                        ContextLanguageNull -> case lmNull lm of
                            Just _  -> lt
                            Nothing -> (lm { lmNull = Just term }, tm)
                        ContextLanguageTag t -> case M.lookup t $ lmValues lm of
                            Just _  -> lt
                            Nothing -> (lm { lmValues = M.insert t term $ lmValues lm }, tm)
                Nothing -> case (lmNone lm, maybe (lmNone lm) (flip M.lookup $ lmValues lm) mlang, tmNone tm) of
                    (Just _, Just _, Just _) -> lt
                    _ -> ( lm { lmNone   = lmNone lm <|> Just term
                              , lmValues = case mlang of
                                    Nothing   -> lmValues lm
                                    Just lang -> M.insertWith (const id) lang term $ lmValues lm
                              }
                         , tm { tmNone = tmNone tm <|> Just term }
                         )

selectTerm
    :: ContainerMap
    -> [ContainerMap -> (LanguageMap, TypeMap)]
    -> Either [TypeMap -> Maybe Ref] [LanguageMap -> Maybe Ref]
    -> Maybe Ref
selectTerm cm containers preferred =
    let select (lm, tm) = case preferred of
            Left types  -> asum $ map ($ tm) types
            Right langs -> asum $ map ($ lm) langs
    in  asum $ map (select . ($ cm)) containers

data LanguageMapField
    = LMNone
    | LMNull
    | LMValue Text
    deriving Eq

data CommonLanguage = CommonLanguage
    { clGet :: LanguageMap -> Maybe Ref
    , clTag :: LanguageMapField
    }

data TypeMapField
    = TMNone
    | TMId
    | TMVocab
    | TMReverse
    | TMValue (URI Gen)
    deriving Eq

data CommonType = CommonType
    { ctGet :: TypeMap -> Maybe Ref
    , ctTag :: TypeMapField
    }

updateCommon
    :: (Maybe CommonType, Maybe CommonLanguage)
    -> ExpandedAtom
    -> (Maybe CommonType, Maybe CommonLanguage)
updateCommon (mct, mcl) item =
    let il = clNone
        it = ctNone
        (il', it') = case item of
            ExpandedAtomScalar esv -> case scalarValue esv of
                Left enb -> case enbType enb of
                    Just u -> (il, ctValue u)
                    Nothing -> (clNull, it)
                Right es -> case esTypeOrLang es of
                    Just torl -> case torl of
                        Left u -> (il, ctValue u)
                        Right l -> (clValue l, it)
                    Nothing -> (clNull, it)
            ExpandedAtomNode _ -> (il, ctId)
        cl' = case mcl of
            Nothing -> Just il
            Just cl -> Just $
                case (clTag cl /= clTag il, item) of
                    (True, ExpandedAtomScalar _) -> clNone
                    _                            -> cl
        ct' = case mct of
            Nothing -> Just it
            Just ct -> Just $
                if ctTag ct /= ctTag it
                    then ctNone
                    else ct
    in  (ct', cl')
    where
    clNone = CommonLanguage lmNone LMNone
    clNull = CommonLanguage lmNull LMNull
    clValue l = CommonLanguage (M.lookup l . lmValues) $ LMValue l
    ctNone = CommonType tmNone TMNone
    ctId = CommonType tmId TMId
    ctValue u = CommonType (M.lookup u . tmValues) $ TMValue u

-- TODO since we're building containers array by consing, remember to reverse
-- it before passing it to 'selectTerm'

handleList
    :: CommonLanguage
    -> [ContainerMap -> (LanguageMap, TypeMap)]
    -> ExpandedList
    -> ( Either CommonType CommonLanguage
       , [ContainerMap -> (LanguageMap, TypeMap)]
       )
handleList defaultLanguage containers (ExpandedList mindex items) =
    let containers' = case mindex of
            Nothing -> bcList : containers
            Just _  -> containers
        -- list = items
        commonType = Nothing
        commonLanguage =
            if V.null items
                then Just defaultLanguage
                else Nothing
        bothNone (ct, cl) = case (ctTag <$> ct, clTag <$> cl) of
            (Just TMNone, Just LMNone) -> True
            _                          -> False
        (commonType', commonLanguage') = foldlUntil' bothNone updateCommon (commonType, commonLanguage) items
        cl = fromMaybe clNone commonLanguage'
        ct = fromMaybe ctNone commonType'
    in  ( if ctTag ct /= TMNone
            then Left ct
            else Right cl
        , containers'
        )
    where
    clNone = CommonLanguage lmNone LMNone
    ctNone = CommonType tmNone TMNone

data AssociatedValue
    = AssocItem ExpandedItem
    | AssocArray

compactToTerm
    :: Maybe AssociatedValue
    -> Bool
    -> ActiveContext
    -> InverseContext
    -> ContainerMap
    -> Maybe Ref
compactToTerm mvalue reverze active inverse cm =
    let defLang = case activeLanguage active of
            Nothing   -> clNone
            Just lang -> clValue lang
        containers =
            case mvalue of
                Just (AssocItem (ExpandedItemOne (ExpandedAtomScalar (ExpandedScalarValue _ (Just _))))) -> [bcIndex]
                Just (AssocItem (ExpandedItemOne (ExpandedAtomNode (ExpandedNodeObject { enodeIndex = Just _ })))) -> [bcIndex]
                Just (AssocItem (ExpandedItemList (ExpandedList (Just _) _))) -> [bcIndex]
                _ -> []
        -- Initialize type/language to @language
        -- and type/language value to @null
        -- In other words, our default is Right clNull
        (pref, containers') =
            if reverze
                then (Left ctReverse, bcSet : containers)
                else case mvalue of
                    Just (AssocItem (ExpandedItemList el)) ->
                        handleList defLang containers el
                    Just (AssocItem (ExpandedItemOne (ExpandedAtomScalar esv))) ->
                        second (bcSet :) $
                        case scalarValue esv of
                            Left enb -> case enbType enb of
                                Just u -> (Left $ ctValue u, containers)
                                Nothing -> (Right clNull, containers)
                            Right es -> case esTypeOrLang es of
                                Nothing -> (Right clNull, containers)
                                Just torl -> case torl of
                                    Left u -> (Left $ ctValue u, containers)
                                    Right l -> case scalarIndex esv of
                                        Nothing -> (Right $ clValue l, bcLang : containers)
                                        Just _ -> (Right clNull, containers)
                    _ -> (Left ctId, bcSet : containers)
        containers'' = bcNone : containers'
        preferred :: Either [TypeMap -> Maybe Ref] [LanguageMap -> Maybe Ref]
        preferred = case pref of
            Left ct ->
                let addReverse = case ctTag ct of
                        TMId -> Just id
                        TMReverse -> Just (tmReverse :)
                        _  -> Nothing
                in  case addReverse of
                        Just rev -> Left $ rev $ case mvalue of
                            Just (AssocItem (ExpandedItemOne (ExpandedAtomNode (ExpandedNodeObject { enodeId = Just i })))) ->
                                let i' = case i of
                                        IdentURI u -> IdentKwURI u
                                        IdentBlank b -> IdentKwBlank b
                                    --t2r (TRef r) = Just r
                                    --t2r _        = Nothing
                                    mref = compactIdentKw Nothing True False active inverse i'
                                in  case mref >>= flip M.lookup (activeTerms active) of
                                        Just tdef | termTarget tdef == i' ->
                                            [tmVocab, tmId, tmNone]
                                        Nothing ->
                                            [tmId, tmVocab, tmNone]
                            _ -> [ctGet ct, tmNone]
                        Nothing -> Left [ctGet ct, tmNone]
            Right cl -> Right [clGet cl, lmNone]
    in  selectTerm cm containers'' preferred
    where
    clNone = CommonLanguage lmNone LMNone
    clNull = CommonLanguage lmNull LMNull
    clValue l = CommonLanguage (M.lookup l . lmValues) $ LMValue l
    ctNone = CommonType tmNone TMNone
    ctId = CommonType tmId TMId
    ctValue u = CommonType (M.lookup u . tmValues) $ TMValue u
    ctReverse = CommonType tmReverse TMReverse

compactIdentKwAsTerm
    :: Maybe AssociatedValue
    -> Bool
    -> Bool
    -> ActiveContext
    -> InverseContext
    -> IdentKw
    -> Maybe Ref
compactIdentKwAsTerm mvalue vocab reverze active inverse target = do
    guard vocab
    cm <- M.lookup target inverse
    compactToTerm mvalue reverze active inverse cm

compactIdentKwNotTerm
    :: Bool
    -> Bool
    -> ActiveContext
    -> IdentKw
    -> Maybe Ref
compactIdentKwNotTerm valueNull vocab active target =
    asVocab <|> asCompact <|> asRelative
    where
    asVocab = do
        guard vocab
        ident <- activeVocabulary active
        case (target, ident) of
            (IdentKwURI u, IdentURI v) -> asSuffixU u v
            (IdentKwBlank b, IdentBlank v) -> asSuffixB b v
            _ -> Nothing
        where
        asSuffixU u v = do
            ref <- RefTerm <$> splitURI v u
            guard $ isNothing $ M.lookup ref $ activeTerms active
            Just ref
        asSuffixB b v = do
            ref <- RefTerm . relFromRelToken <$> splitRelToken v b
            guard $ isNothing $ M.lookup ref $ activeTerms active
            Just ref
    asCompact = do
        candidate <-
            case target of
                IdentKwURI u -> Just $ candidateU u
                IdentKwBlank b -> Just $ candidateB b
                -- TODO
                -- There are weird cases in JSON-LD in which a compact URI can get
                -- expanded into a keyword. These weird cases aren't supported in
                -- this library. So if we have a keyword here, we shouldn't compact
                -- it into a compact URI. One thing we could do is, check if it
                -- works, and if yes, raise an error because we don't want to
                -- produce that sort of compact URI. For now, we're just assuming
                -- here that compaction into compact URI didn't succeed. Perhaps
                -- later if test results suggest, update the code here to detect
                -- such weird cases and raise an error.
                _ -> Nothing
        let candidates = M.mapMaybeWithKey candidate $ activeTerms active
        if M.null candidates
            then Nothing
            else Just $ snd $ minimumBy (order `on` fst) $ M.elems candidates
        where
        candidateCheck compact =
            let ref = RefURI $ compact2ac compact
            in  case M.lookup ref $ activeTerms active of
                    Just tdef
                        | termTarget tdef /= target || not valueNull -> Nothing
                    _ -> Just (compact, ref)
        candidateU u (RefTerm t) tdef = do
            p <- case termTarget tdef of
                IdentKwURI q -> Just q
                _            -> Nothing
            c <- compactURI (renderRelNoAuth t) p u
            guard $ p /= u
            candidateCheck c
        candidateU _ _           _    = Nothing
        candidateB b (RefTerm t) tdef = do
            p <- case termTarget tdef of
                IdentKwBlank q -> Just q
                _              -> Nothing
            rt <- splitRelToken p b
            c <- parseCompactFromRel (renderRelNoAuth t) (relFromRelToken rt)
            candidateCheck c
        candidateB _ _           _    = Nothing
        order s t =
            case B.length s' `compare` B.length t' of
                LT -> LT
                GT -> GT
                EQ -> compare s' t'
            where
            s' = renderCompactURI s
            t' = renderCompactURI t
    asRelative = do
        guard $ not vocab
        case (target, activeBaseURI active) of
            (IdentKwURI u, Just b) ->
                RefTerm <$> (relNoAuthFromRelative =<< makeRelative b u)
            _ -> Nothing

ident2ikw :: Identifier -> IdentKw
ident2ikw (IdentURI u)   = IdentKwURI u
ident2ikw (IdentBlank b) = IdentKwBlank b

ident2ref :: Identifier -> Ref
ident2ref (IdentBlank b) = RefBlank b
ident2ref (IdentURI u)   = RefURI $ uri2ac u

-- | This function tries to compact a URI, a blank node identifier or a keyword
-- into a 'Ref'. It implements the IRI compaction algorithm.
compactIdentKw
    :: Maybe AssociatedValue
    -> Bool
    -> Bool
    -> ActiveContext
    -> InverseContext
    -> IdentKw
    -> Maybe Ref
compactIdentKw mvalue vocab reverze active inverse target =
    compactIdentKwAsTerm mvalue vocab reverze active inverse target <|>
    compactIdentKwNotTerm (isNothing mvalue) vocab active target

compactLoneId :: Bool -> ActiveContext -> InverseContext -> Identifier -> Ref
compactLoneId vocab active inverse ident =
    case compactIdentKw Nothing vocab False active inverse $ ident2ikw ident of
        Just ref -> ref
        Nothing  -> ident2ref ident

-- Compact a value given it's a node object (and not a value object)
compactValueNode :: ActiveContext -> InverseContext -> Ref -> ExpandedNodeObject -> Maybe Ref
compactValueNode active inverse property eno = do
    ident <- onlyId eno
    torl <- termTypeOrLang =<< mtd
    case torl of
        Left TermDefinitionTypeId    -> Just $ loneId False ident
        Left TermDefinitionTypeVocab -> Just $ loneId True ident
        _                            -> Nothing
    where
    mtd = M.lookup property $ activeTerms active
    ignoreIndex Nothing = True
    ignoreIndex (Just i) =
        case termContainer =<< mtd of
            Just ContainerIndex -> True
            _                   -> False
    onlyId (ExpandedNodeObject (Just id_) Nothing Nothing Nothing mi vals) =
        if M.null vals && ignoreIndex mi
            then Just id_
            else Nothing
    onlyId _ = Nothing
    loneId vocab = compactLoneId vocab active inverse

-- Nothing means we couldn't compact, just use the value as-is
compactValue :: ActiveContext -> InverseContext -> Ref -> ExpandedAtom -> Maybe TScalar
compactValue active inverse property ea =
    case ea of
        ExpandedAtomNode eno ->
            ref2scalar <$> compactValueNode active inverse property eno
        ExpandedAtomScalar (ExpandedScalarValue v mi) -> do
            guard $ ignoreIndex mi
            case v of
                Left (ExpandedNBValue enb mt) ->
                    case (mt, termTypeOrLang =<< mtd) of
                        (Just u, Just (Left (TermDefinitionTypeAbsolute v)))
                            | u == v -> Just scalar
                        (Nothing, _) -> Just scalar
                        _            -> Nothing
                    where
                    scalar = enb2scalar enb
                Right (ExpandedStringValue t tok mtorl) ->
                    case (mtorl, termTypeOrLang =<< mtd) of
                        (Just (Left u), Just (Left (TermDefinitionTypeAbsolute v)))
                            | u == v -> Just scalar
                        (Just (Right l), Just (Right (ContextLanguageTag l')))
                            | l == l' -> Just scalar
                        (Nothing, Just (Right ContextLanguageNull)) ->
                            Just scalar
                        (Nothing, _)
                            | isNothing $ activeLanguage active -> Just scalar
                        _ -> Nothing
                    where
                    scalar = TScalarString t tok
    where
    mtd = M.lookup property $ activeTerms active
    ignoreIndex Nothing = True
    ignoreIndex (Just i) =
        case termContainer =<< mtd of
            Just ContainerIndex -> True
            _                   -> False
    ref2scalar ref = TScalarString (showRef ref) (TRef ref)
    enb2scalar (Left s) = TScalarNumber s
    enb2scalar (Right b) = TScalarBool b

compactDocument
    :: Bool
    -> ActiveContext
    -> Vector ExpandedNodeObject
    -> Either BereniceError NodeObject
compactDocument compactArrays active enos = do
    nos <- traverse (compactNodeObject $ Left False) enos
    let mno =
            if compactArrays && V.length nos == 1
                then Just $ V.head nos
                else Nothing
        mref = compactIdentKw' Nothing False False $ IdentKwNC KeywordGraph
    Right $ case mno of
        Just no -> no
        Nothing -> NodeObject
            { nodeContext = active
            , nodeId      = Nothing
            , nodeGraph   = Just $ AliasAnd mref $ Many nos
            , nodeType    = Nothing
            , nodeReverse = Nothing
            , nodeIndex   = Nothing
            , nodeValues  = M.empty
            }
    where
    inverse = inverseContext active

    compactIdentKw' mv v r = compactIdentKw mv v r active inverse

    ne2multi iap (x :| []) =
        if compactArrays && not (containerSetOrList iap)
            then One x
            else Many $ V.singleton x
        where
        containerSetOrList iap =
            case termContainer =<< M.lookup iap (activeTerms active) of
                Just ContainerSet  -> True
                Just ContainerList -> True
                _                  -> False
    ne2multi _ (x :| xs) = Many $ V.fromList $ x : xs

    compactReverseObject
        :: HashMap Identifier (Vector ExpandedNodeObject)
        -> Either
            BereniceError
            (HashMap Identifier (NonEmpty (Ref, (Bool, Multi NodeReverseItem))))
    compactReverseObject = M.traverseWithKey compact
        where
        compactIdentKwAsTerm' mv v r = compactIdentKwAsTerm mv v r active inverse
        compactIdentKwNotTerm' vn v = compactIdentKwNotTerm vn v active
        n2ai = AssocItem . ExpandedItemOne . ExpandedAtomNode
        compactAsTerm value =
            compactIdentKwAsTerm' (Just $ n2ai value) True True . ident2ikw
        compactNotTerm =
            compactIdentKwNotTerm' False True . ident2ikw
        iapNotTerm ep =
            case compactNotTerm ep of
                Just ref -> ref
                Nothing  -> ident2ref ep
        compactENO iap eno =
            case compactValueNode active inverse iap eno of
                Nothing ->
                    NodeReverseObject <$> compactNodeObject (Right iap) eno
                Just ref ->
                    Right $ NodeReverseId ref
        isReverse iap =
            case termReverse <$> M.lookup iap (activeTerms active) of
                Just True -> True
                _         -> False
        ne2container iap ne =
            case termContainer =<< M.lookup iap (activeTerms active) of
                -- TODO we need to support language and index maps! When
                -- container is @language or @index. Similarly, support them
                -- when parsing and expanding a document. The idea is that when
                -- we have a NonEmpty NRI, instead of making a Multi out of it,
                -- we make an index map.  Language maps don't make sense here;
                -- the playground can tell me which error to give in that case.
                Just ContainerLanguage -> error "TODO"
                Just ContainerIndex -> error "TODO"
                _ -> ne2multi iap ne
        compactE ep =
            let iap =
                    case compactIdentKw' (Just AssocArray) True True $
                            ident2ikw ep of
                        Just ref -> ref
                        Nothing  -> ident2ref ep
            in  (iap, (isReverse iap, Many V.empty)) :| []
        compactNE ep =
            traverse
                (\ (iap, enos) ->
                    (,) iap . (,) (isReverse iap) . ne2container iap <$>
                    traverse (compactENO iap) enos
                ) .
            groupAllExtractDefault1 (iapNotTerm ep) (flip compactAsTerm ep) id
        compact ep = maybe (pure $ compactE ep) (compactNE ep) . nonEmpty . V.toList
    -- property: Either Bool Ref; Bool says whether it's @reverse
    compactNodeObject property eno = do
        let id_ =
                enodeId eno <&> \ i -> (findAlias KeywordId, typeOrId False i)
            typ =
                enodeType eno <&> \ is ->
                    ( findAlias KeywordType
                    , vec2multi $ V.map (typeOrId True) is
                    )
        reverze' <- for (enodeReverse eno) $ \ m -> do
            revmap <- compactReverseObject m
            Right
                ( ( findAlias KeywordReverse
                  , filterReverse False revmap
                  )
                , M.map (NE.map $ second $ Left . fmap nri2ni) $ filterReverse True revmap
                )
        let reverze = do
                p <- fst <$> reverze'
                if M.null $ snd p
                    then Nothing
                    else Just $ second (NodeReverse active) p
            rrs = maybe M.empty snd reverze'
            index =
                if apContainerIndex property
                    then Nothing
                    else enodeIndex eno <&> \ t -> (findAlias KeywordIndex, t)
        graph <- for (enodeGraph eno) $ \ gs -> do
            gs' <- traverse (compactNodeObject $ Left False) gs
            Right (findAlias KeywordGraph, gs')
        values <- M.traverseWithKey compact $ enodeValues eno
        Right NodeObject
            { nodeContext = active
            , nodeId      = uncurry AliasAnd <$> id_
            , nodeGraph   = uncurry AliasAnd <$> graph
            , nodeType    = uncurry AliasAnd <$> typ
            , nodeReverse = uncurry AliasAnd <$> reverze
            , nodeIndex   = uncurry AliasAnd <$> index
            , nodeValues  = M.unionWith (error "TODO") values rrs
            }
        where
        vec2multi v =
            if V.length v == 1
                then One $ V.unsafeHead v
                else Many v
        typeOrId typ i =
            case compactIdentKw' Nothing typ False $ ident2ikw i of
                Just ref -> ref
                Nothing  -> ident2ref i
        findAlias = compactIdentKw' Nothing True False . IdentKwNC
        filterReverse rev = M.mapMaybe $ \ ne ->
            let filt (ref, (r, nris)) =
                    if r == rev
                        then Just (ref, nris)
                        else Nothing
            in  nonEmpty $ mapMaybe filt $ NE.toList ne
        nri2ni (NodeReverseId ref)   = NodeItemOne $ ItemScalar $ TScalarString (showRef ref) (TRef ref)
        nri2ni (NodeReverseObject n) = NodeItemOne $ ItemNode n
        apContainerIndex (Left _)   = False
        apContainerIndex (Right ap) =
            case termContainer =<< M.lookup ap (activeTerms active) of
                Just ContainerIndex -> True
                _                   -> False
        compactIdentKwAsTerm' mv v r = compactIdentKwAsTerm mv v r active inverse
        compactIdentKwNotTerm' vn v = compactIdentKwNotTerm vn v active
        compactAsTerm value =
            compactIdentKwAsTerm' (Just $ AssocItem value) True True . ident2ikw
        compactNotTerm =
            compactIdentKwNotTerm' False True . ident2ikw
        iapNotTerm ep =
            case compactNotTerm ep of
                Just ref -> ref
                Nothing  -> ident2ref ep
        compactEA iap ea =
            case compactValue active inverse iap ea of
                Just scalar -> Right $ ItemScalar scalar
                Nothing -> case ea of
                    ExpandedAtomScalar esv ->
                        Right $ ItemValue ValueObject
                            { valueValue =
                                AliasAnd (findAlias KeywordValue) $
                                ValueValueScalar $
                                case scalarValue esv of
                                    Left enb ->
                                        case enbValue enb of
                                            Left s -> TScalarNumber s
                                            Right b -> TScalarBool b
                                    Right es ->
                                        TScalarString (esText es) (esToken es)
                            , valueTypeOrLang =
                                case scalarValue esv of
                                    Left enb -> AliasAnd (findAlias KeywordType) . Left . compactType <$> enbType enb
                                    Right es -> uncurry AliasAnd . first findAlias . either ((,) KeywordType . Left . compactType) ((,) KeywordLanguage . Right) <$> esTypeOrLang es
                            , valueIndex =
                                if apContainerIndex $ Right iap
                                    then Nothing
                                    else AliasAnd (findAlias KeywordIndex) <$> scalarIndex esv
                            , valueContext = active
                            }
                    ExpandedAtomNode eno ->
                        ItemNode <$> compactNodeObject (Right iap) eno
            where
            compactType u =
                case compactIdentKw' Nothing True False $ IdentKwURI u of
                    Just ref -> ref
                    Nothing  -> ident2ref $ IdentURI u
        ne2container iap nis =
            case termContainer =<< M.lookup iap (activeTerms active) of
                Just ContainerList ->
                    case mapMaybe loArr $ NE.toList nis of
                        [] -> Right $ Right $ Items $ Many $ ne2v nis
                        [items] -> Right $ Left $ NodeItemOne <$> items
                        _ -> Left $ SpecError CompactionToListOfLists ""
                    where
                    loArr (NodeItemList lo) = Just $ aaValue $ listArray' lo
                    loArr _                 = Nothing
                -- TODO it seems that the IRI compaction algo is supposed to
                -- guarantee that all the 'NodeItem' in nis are valid for
                -- language map / index map. But here this is not expressed in
                -- the type. So for now, I'm using 'error' for these cases. If
                -- they arise at run time, it probably means I have a bug. But
                -- ideally, express those cases through the type. Perhaps
                -- instead of a general (Ref, value) type, have a sum type with
                -- ctors based on the container mapping of the Ref.
                Just ContainerLanguage -> Right $ Right $ LangMap $ M.fromList $ map (second $ vec2multi . ne2v) $ groupAllExtract fst snd $ map langVal $ NE.toList nis
                    where
                    langVal (NodeItemOne (ItemValue (ValueObject (AliasAnd _ (ValueValueScalar (TScalarString t _))) (Just (AliasAnd _ (Right l))) _ _))) = (l, LanguageItemString t)
                    langVal _ = error "Hmmm should be impossible, do I have a bug?"
                -- TODO we're supposed to extract the niIndex from the expanded
                -- item, not from the compacted one, because the latter already
                -- had it removed. Instead, something we can do is to keep the
                -- indexes when compacting the node items, and *now* when we
                -- build this index map, remove index values.
                --
                -- In the current situations, there are going to be errors
                -- because the compacted items already have index removed.
                Just ContainerIndex -> Right $ Right $ IndexMap $ M.fromList $ map (second $ vec2multi . ne2v) $ groupAllExtract fst snd $ map (niIndex &&& id) $ NE.toList nis
                    where
                    niIndex (NodeItemOne (ItemNode (NodeObject { nodeIndex = Just (AliasAnd _ i) }))) = i
                    niIndex (NodeItemList (ListObject' { listIndex' = Just (AliasAnd _ i) })) = i
                    niIndex (NodeItemSet (SetObject' { setIndex' = Just (AliasAnd _ i) })) = i
                    niIndex _ = error "Hmmm should be impossible, do I have a bug?"
                _ -> Right $ Right $ Items $ ne2multi iap nis
            where
            ne2v = V.fromList . NE.toList
        compactEI iap (ExpandedItemOne ea) = NodeItemOne <$> compactEA iap ea
        compactEI iap (ExpandedItemList (ExpandedList mi v)) =
            nilo <$> traverse (compactEA iap) v
            where
            nilo items = NodeItemList ListObject'
                { listArray'   = AliasAnd (findAlias KeywordList) $ vec2multi items
                , listContext' = active
                , listIndex'   = AliasAnd (findAlias KeywordIndex) <$> mi
                }
        compactE ep =
            let iap =
                    case compactIdentKw' (Just AssocArray) True True $
                            ident2ikw ep of
                        Just ref -> ref
                        Nothing  -> ident2ref ep
            in  (iap, Right $ Items $ Many V.empty) :| []
        compactNE ep =
            traverse
                (\ (iap, eis) ->
                        (,) iap <$> (ne2container iap =<< (traverse (compactEI iap) eis))
                ) .
            groupAllExtractDefault1 (iapNotTerm ep) (flip compactAsTerm ep) id
        compact ep = maybe (pure $ compactE ep) (compactNE ep) . nonEmpty . V.toList

-- The code for the expansion algorithm used to look scary to me for most of
-- the period of time I was writing it. Eventually I started feeling
-- comfortable with it. Now, the compaction code seems scary to me. I wonder if
-- this feeling will pass too.
--
-- We're done compacting! The next step is generalization. We convert the
-- various object types (node object, value object, etc.) info a uniform
-- representation. We're getting a step closer to something that looks like
-- plain JSON.

-- | Take a representation that is aware of specific object types (such as node
-- object, value object, etc.) and produce a general object representation.
--
-- NOTE: The 'TaggedItemObject' constructor of the 'TaggedItem' has 2
-- parameters. When expanding, one is used for language maps and index maps,
-- and the other for everything else. Here, when compacting. we produce only
-- one of these two values, and leave the other empty: When compacting a
-- language map or index map, we produce the same map used for expanding them.
-- Otherwise, we produce the other value.
--
-- When untagging the produced 'TaggedObject', simply check which one of the
-- two values in an empty map, and use the other for the actual untagging.
generalizeDocument :: NodeObject -> TaggedObject
generalizeDocument = generalizeNode
    where
    generalizeNode (NodeObject active mid mg mt mr mi vs) = TaggedObject
        { taggedContext = active
        , taggedKwMap = M.fromList $ catMaybes
            [ kw mid KeywordId      $ One . ref2ti
            , kw mg  KeywordGraph   $ fmap node2ti
            , kw mt  KeywordType    $ fmap ref2ti
            , kw mr  KeywordReverse $ One . flip TaggedItemObject M.empty . reverse2ti
            , kw mi  KeywordIndex   $ One . text2ti
            ]
        , taggedIdMap = M.map (NE.map $ second $ nv2tv active) vs
        }
        where
        okey kw Nothing    = ObjectKeyKeyword kw
        okey _  (Just ref) = ObjectKeyOther ref
        kw' (AliasAnd ma v) kwnc f = (kwnc, (okey kwnc ma, f v))
        kw Nothing   _    _ = Nothing
        kw (Just aa) kwnc f = Just $ kw' aa kwnc f
        ref2ti ref = TaggedItemScalar $ TScalarString (showRef ref) (TRef ref)
        text2ti t = TaggedItemScalar $ TScalarString t $ parseToken t
        node2ti n = TaggedItemObject (generalizeNode n) M.empty
        reverse2ti (NodeReverse c m) = TaggedObject
            { taggedContext = c
            , taggedKwMap   = M.empty
            , taggedIdMap   = M.map (NE.map $ second $ fmap nri2ti) m
            }
            where
            nri2ti (NodeReverseId ref)   = ref2ti ref
            nri2ti (NodeReverseObject n) = node2ti n
        nv2tv a v =
            case v of
                Left nis -> ni2ti <$> nis
                Right nv ->
                    case nv of
                        Items nis -> ni2ti <$> nis
                        LangMap lm -> One $ TaggedItemObject (emptyTO a) $ M.map (fmap li2ti) lm
                        IndexMap im -> One $ TaggedItemObject (emptyTO a) $ M.map (fmap ni2ti) im
            where
            emptyTO a = TaggedObject a M.empty M.empty
            loso2to ais c mi = TaggedObject
                { taggedContext = c
                , taggedKwMap   = M.fromList $ catMaybes
                    [ kw (Just ais) KeywordList  $ fmap i2ti
                    , kw mi         KeywordIndex $ One . text2ti
                    ]
                , taggedIdMap   = M.empty
                }
            lo2to (ListObject' ais c mi) = loso2to ais c mi
            so2to (SetObject' ais c mi)  = loso2to ais c mi
            vo2to (ValueObject valueA mtorlA mindexA active) = TaggedObject
                { taggedContext = active
                , taggedKwMap   = M.fromList $ catMaybes
                    [ kw (Just valueA) KeywordValue $ One . vv2ti
                    , kw mindexA       KeywordIndex $ One . text2ti
                    , mtorlA <&> \ (AliasAnd aa torl) ->
                        case torl of
                            Left typ   -> kw' (AliasAnd aa typ)  KeywordType     $ One . ref2ti
                            Right lang -> kw' (AliasAnd aa lang) KeywordLanguage $ One . text2ti
                    ]
                , taggedIdMap   = M.empty
                }
                where
                vv2ti (ValueValueScalar s) = TaggedItemScalar s
                vv2ti ValueValueNull       = TaggedItemNull
            i2ti (ItemScalar s) = TaggedItemScalar s
            i2ti ItemNull       = TaggedItemNull
            i2ti (ItemNode n)   = node2ti n
            i2ti (ItemValue vo) = TaggedItemObject (vo2to vo) M.empty
            ni2ti (NodeItemOne i)   = i2ti i
            ni2ti (NodeItemList lo) = TaggedItemObject (lo2to lo) M.empty
            ni2ti (NodeItemSet so)  = TaggedItemObject (so2to so) M.empty
            li2ti (LanguageItemNull)     = TaggedItemNull
            li2ti (LanguageItemString t) = text2ti t

-- Now comes the untagging step, in which we drop the expanded properties and
-- organize values under their compacted properties.

renderKwNC :: KeywordNC -> Text
renderKwNC KeywordId       = "@id"
renderKwNC KeywordValue    = "@value"
renderKwNC KeywordLanguage = "@language"
renderKwNC KeywordType     = "@type"
renderKwNC KeywordList     = "@list"
renderKwNC KeywordSet      = "@set"
renderKwNC KeywordReverse  = "@reverse"
renderKwNC KeywordIndex    = "@index"
renderKwNC KeywordGraph    = "@graph"

untagDocument :: Multi LocalContextItem -> TaggedObject -> UnknownObject
untagDocument c o = UnknownObject (Just c) (untagObject o)
    where
    untagObject (TaggedObject _ kws vals) =
        let kws' = M.elems kws
            vals' = map (first ObjectKeyOther) $ concatMap NE.toList $ M.elems vals
        in  M.fromList $ map ((renderObjectKey . fst) &&& second (fmap untagItem)) $ kws' ++ vals'
        where
        renderObjectKey (ObjectKeyKeyword kw) = renderKwNC kw
        renderObjectKey (ObjectKeyOther ref)  = showRef ref
    untagItem (TaggedItemScalar s)    = UnknownItemScalar s
    untagItem TaggedItemNull          = UnknownItemNull
    untagItem (TaggedItemObject to m) =
        UnknownItemObject $ UnknownObject Nothing $
        if nullTO to
            then M.map ((,) okey . fmap untagItem) m
            else untagObject to
        where
        nullTO (TaggedObject _ kws vals) = M.null kws && M.null vals
        okey = error "BUG: ObjectKey in compacted unknownMap used"

-- Finally comes the rendering step, which produces a JSON-like structure you
-- can serialize with a JSON library such as @aeson@.

renderDocument :: UnknownObject -> Dictionary
renderDocument = renderObject
    where
    uri2scalar = ScalarString . decodeUtf8 . renderURI
    renderContextItem LocalContextNull = ValueNull
    renderContextItem (LocalContextString u) = ValueScalar $ uri2scalar u
    renderContextItem (LocalContextObject (Context ml mb mv vs)) =
        ValueDictionary $ M.fromList $
        consField "@language" ml renderLang $
        consField "@base"     mb renderBase $
        consField "@vocab"    mv renderVocab $
        map (bimap showRef $ One . renderContextValue) $ M.toList vs
        where
        consField _ Nothing  _ = id
        consField t (Just v) f = (:) (t, One $ f v)
        renderLang (ContextLanguageTag t) = ValueScalar $ ScalarString t
        renderLang ContextLanguageNull    = ValueNull
        renderBase (ContextBaseAbsolute u) = ValueScalar $ uri2scalar u
        renderBase (ContextBaseRelative u) = ValueScalar $ uri2scalar u
        renderBase ContextBaseNull         = ValueNull
        renderVocab (ContextVocabAbsolute u) = ValueScalar $ uri2scalar u
        renderVocab ContextVocabNull         = ValueNull
        renderVocab (ContextVocabBlank rt)   =
            ValueScalar $ ScalarString $ decodeUtf8 $ "_:" <> renderRelToken rt
        renderId IdNull         = ValueNull
        renderId (IdRef ref)    = ValueScalar $ ScalarString $ showRef ref
        renderId (IdKeyword kw) = ValueScalar $ ScalarString $ renderKw kw
            where
            renderKw KeywordContext = "@context"
            renderKw (KeywordNC kw) = renderKwNC kw
            renderKw (KeywordC kw)  = renderKwC kw
                where
                renderKwC KeywordContainer = "@container"
                renderKwC KeywordBase      = "@base"
                renderKwC KeywordVocab     = "@vocab"
        renderETD (ExpandedTermDefinition idr mt ml) =
            ValueDictionary $ M.fromList $ consIdReverse idr $ catMaybes
                [ field "@type"     mt renderType
                , field "@language" ml renderLang
                ]
            where
            field _ Nothing  _ = Nothing
            field t (Just v) f = Just (t, One $ f v)
            bs2value = ValueScalar . ScalarString . decodeUtf8
            renderType (TypeURI ac)   = bs2value $ renderAC ac
            renderType (TypeTerm rna) = bs2value $ renderRelNoAuth rna
            renderType TypeId         = ValueScalar $ ScalarString "@id"
            renderType TypeVocab      = ValueScalar $ ScalarString "@vocab"
            renderType TypeNull       = ValueNull
            t2v = ValueScalar . ScalarString
            consIdReverse (Left (ExpandedTermDefinitionId mid mc)) =
                consField "@id"        mid renderId .
                consField "@container" mc  renderContainer
                where
                renderContainer ContainerNull     = ValueNull
                renderContainer ContainerSet      = t2v "@set"
                renderContainer ContainerList     = t2v "@list"
                renderContainer ContainerLanguage = t2v "@language"
                renderContainer ContainerIndex    = t2v "@index"
            consIdReverse (Right (ExpandedTermDefinitionReverse r mc)) =
                consField "@reverse"   (Just r) (t2v . showRef) .
                consField "@container" mc       renderContainerReverse
                where
                renderContainerReverse ContainerReverseNull  = ValueNull
                renderContainerReverse ContainerReverseSet   = t2v "@set"
                renderContainerReverse ContainerReverseIndex = t2v "@index"
        renderContextValue (ContextValueId id_)       = renderId id_
        renderContextValue (ContextValueExpanded etd) = renderETD etd
    renderObject (UnknownObject mc m) =
        maybe id (M.insert "@context" . fmap renderContextItem) mc $
        M.map (fmap renderItem . snd) m
    renderItem UnknownItemNull        = ValueNull
    renderItem (UnknownItemObject uo) = ValueDictionary $ renderObject uo
    renderItem (UnknownItemScalar s)  =
        ValueScalar $
        case s of
            TScalarString t _ -> ScalarString t
            TScalarNumber n   -> ScalarNumber n
            TScalarBool b     -> ScalarBool b

-- Now we can define a function that does the whole process, from RDF to JSON:

rdf2jsonld
    :: UseNativeTypes
    -> UseRdfType
    -> Bool
    -> Multi LocalContextItem
    -> ActiveContext
    -> RdfDataset
    -> Either BereniceError Dictionary
rdf2jsonld native rdftype compactArrays context active rdf = do
    nm <- rdf2nm native rdftype rdf
    let enos = renderNodeMap nm
    no <- compactDocument compactArrays active enos
    let to = generalizeDocument no
        uo = untagDocument context to
    Right $ renderDocument uo