{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

{- | This module implements comparasion of Org contents, using multiwalk. You
 should use this instead of the default Ord instances when you want to compare
 Org content semantically.
-}
module Org.Compare (compareContent, compareContents, toAtoms, Atom) where

import Data.Text qualified as T
import Org.Types
import Org.Walk

data Atom
  = Separator
  | Word Text
  | Literal Text
  | Time DateTime
  deriving (Atom -> Atom -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, Eq Atom
Atom -> Atom -> Bool
Atom -> Atom -> Ordering
Atom -> Atom -> Atom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Atom -> Atom -> Atom
$cmin :: Atom -> Atom -> Atom
max :: Atom -> Atom -> Atom
$cmax :: Atom -> Atom -> Atom
>= :: Atom -> Atom -> Bool
$c>= :: Atom -> Atom -> Bool
> :: Atom -> Atom -> Bool
$c> :: Atom -> Atom -> Bool
<= :: Atom -> Atom -> Bool
$c<= :: Atom -> Atom -> Bool
< :: Atom -> Atom -> Bool
$c< :: Atom -> Atom -> Bool
compare :: Atom -> Atom -> Ordering
$ccompare :: Atom -> Atom -> Ordering
Ord)

compareContent :: MultiWalk MWTag a => a -> a -> Ordering
compareContent :: forall a. MultiWalk MWTag a => a -> a -> Ordering
compareContent = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms

compareContents :: MultiWalk MWTag a => [a] -> [a] -> Ordering
compareContents :: forall a. MultiWalk MWTag a => [a] -> [a] -> Ordering
compareContents = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms)

toAtoms :: MultiWalk MWTag a => a -> [Atom]
toAtoms :: forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms = forall a m.
(MultiWalk MWTag a, Monoid m) =>
(Query m
 -> QList m (MultiTypes MWTag) -> QList m (MultiTypes MWTag))
-> a -> m
buildMultiQ \forall a. MultiWalk MWTag a => a -> [Atom]
f QList [Atom] (MultiTypes MWTag)
l ->
  QList [Atom] (MultiTypes MWTag)
l forall (ls :: [*]) t m.
QContains ls t =>
QList m ls -> (t -> m) -> QList m ls
?> (forall a. MultiWalk MWTag a => a -> [Atom]) -> OrgObject -> [Atom]
objToAtoms forall a. MultiWalk MWTag a => a -> [Atom]
f forall (ls :: [*]) t m.
QContains ls t =>
QList m ls -> (t -> m) -> QList m ls
?> (forall a. MultiWalk MWTag a => a -> [Atom])
-> OrgElementData -> [Atom]
elmToAtoms forall a. MultiWalk MWTag a => a -> [Atom]
f

elmToAtoms :: Query [Atom] -> OrgElementData -> [Atom]
elmToAtoms :: (forall a. MultiWalk MWTag a => a -> [Atom])
-> OrgElementData -> [Atom]
elmToAtoms forall a. MultiWalk MWTag a => a -> [Atom]
f = (Atom
Separator forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  ExportBlock Text
_ Text
t -> [Text -> Atom
Literal Text
t]
  ExampleBlock Map Text Text
_ [SrcLine]
t -> [Text -> Atom
Literal forall a b. (a -> b) -> a -> b
$ [SrcLine] -> Text
srcLinesToText [SrcLine]
t]
  SrcBlock {[(Text, Text)]
[SrcLine]
Text
Map Text Text
srcBlkLines :: OrgElementData -> [SrcLine]
srcBlkArguments :: OrgElementData -> [(Text, Text)]
srcBlkSwitches :: OrgElementData -> Map Text Text
srcBlkLang :: OrgElementData -> Text
srcBlkLines :: [SrcLine]
srcBlkArguments :: [(Text, Text)]
srcBlkSwitches :: Map Text Text
srcBlkLang :: Text
..} -> [Text -> Atom
Literal forall a b. (a -> b) -> a -> b
$ [SrcLine] -> Text
srcLinesToText [SrcLine]
srcBlkLines]
  LaTeXEnvironment Text
_ Text
t -> [Text -> Atom
Literal Text
t]
  OrgElementData
x -> forall a. MultiWalk MWTag a => a -> [Atom]
f OrgElementData
x

objToAtoms :: Query [Atom] -> OrgObject -> [Atom]
objToAtoms :: (forall a. MultiWalk MWTag a => a -> [Atom]) -> OrgObject -> [Atom]
objToAtoms forall a. MultiWalk MWTag a => a -> [Atom]
f = \case
  Plain Text
t -> Text -> Atom
Word forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
t
  Code Text
t -> [Text -> Atom
Literal Text
t]
  Verbatim Text
t -> [Text -> Atom
Literal Text
t]
  Timestamp (TimestampData Bool
_ DateTime
t) -> [DateTime -> Atom
Time DateTime
t]
  Timestamp (TimestampRange Bool
_ DateTime
t DateTime
s) -> [DateTime -> Atom
Time DateTime
t, DateTime -> Atom
Time DateTime
s]
  Entity Text
t -> [Text -> Atom
Literal Text
t]
  LaTeXFragment FragmentType
_ Text
t -> [Text -> Atom
Literal Text
t]
  ExportSnippet Text
_ Text
t -> [Text -> Atom
Literal Text
t]
  FootnoteRef {} -> []
  Cite (Citation {[CiteReference]
[OrgObject]
Text
citationReferences :: Citation -> [CiteReference]
citationSuffix :: Citation -> [OrgObject]
citationPrefix :: Citation -> [OrgObject]
citationVariant :: Citation -> Text
citationStyle :: Citation -> Text
citationReferences :: [CiteReference]
citationSuffix :: [OrgObject]
citationPrefix :: [OrgObject]
citationVariant :: Text
citationStyle :: Text
..}) ->
    ([OrgObject]
citationPrefix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms)
      forall a. [a] -> [a] -> [a]
++ ( [CiteReference]
citationReferences forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CiteReference {[OrgObject]
Text
refSuffix :: CiteReference -> [OrgObject]
refPrefix :: CiteReference -> [OrgObject]
refId :: CiteReference -> Text
refSuffix :: [OrgObject]
refPrefix :: [OrgObject]
refId :: Text
..} ->
            ([OrgObject]
refPrefix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms)
              forall a. [a] -> [a] -> [a]
++ [Text -> Atom
Literal Text
refId]
              forall a. [a] -> [a] -> [a]
++ ([OrgObject]
refSuffix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms)
         )
      forall a. [a] -> [a] -> [a]
++ ([OrgObject]
citationSuffix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. MultiWalk MWTag a => a -> [Atom]
toAtoms)
  Src Text
_ Text
_ Text
t -> [Text -> Atom
Literal Text
t]
  OrgObject
x -> forall a. MultiWalk MWTag a => a -> [Atom]
f OrgObject
x