-- |

{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE TypeFamilies      #-}
{-# OPTIONS -fno-warn-orphans #-}

module Gargantext.API.Ngrams.Types where

import Codec.Serialise (Serialise())
import Control.Category ((>>>))
import Control.DeepSeq (NFData)
import Control.Lens (makeLenses, makePrisms, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^?), (%~), (.~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~))
import Control.Monad.State
import Data.Aeson hiding ((.=))
import Data.Aeson.TH (deriveJSON)
import Data.Either (Either(..))
import Data.Foldable
import Data.Hashable (Hashable)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..), PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace, MaybePatch(Mod), unMod, old, new)
import Data.Set (Set)
import Data.String (IsString, fromString)
import Data.Swagger hiding (version, patch)
import Data.Text (Text, pack, strip)
import Data.Validity
import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError)
import GHC.Generics (Generic)
import Gargantext.Core.Text (size)
import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig, CmdM')
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Protolude (maybeToEither)
import Servant hiding (Patch)
import Servant.Job.Utils (jsonOptions)
-- import System.FileLock (FileLock)
import Test.QuickCheck (elements, frequency)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
import qualified Data.List                              as List
import qualified Data.Map.Strict                        as Map
import qualified Data.Map.Strict.Patch                  as PM
import qualified Data.Set                               as Set
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams

------------------------------------------------------------------------

type QueryParamR = QueryParam' '[Required, Strict]

------------------------------------------------------------------------
--data FacetFormat = Table | Chart
data TabType   = Docs   | Trash   | MoreFav | MoreTrash
               | Terms  | Sources | Authors | Institutes
               | Contacts
  deriving (TabType
TabType -> TabType -> Bounded TabType
forall a. a -> a -> Bounded a
maxBound :: TabType
$cmaxBound :: TabType
minBound :: TabType
$cminBound :: TabType
Bounded, Int -> TabType
TabType -> Int
TabType -> [TabType]
TabType -> TabType
TabType -> TabType -> [TabType]
TabType -> TabType -> TabType -> [TabType]
(TabType -> TabType)
-> (TabType -> TabType)
-> (Int -> TabType)
-> (TabType -> Int)
-> (TabType -> [TabType])
-> (TabType -> TabType -> [TabType])
-> (TabType -> TabType -> [TabType])
-> (TabType -> TabType -> TabType -> [TabType])
-> Enum TabType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TabType -> TabType -> TabType -> [TabType]
$cenumFromThenTo :: TabType -> TabType -> TabType -> [TabType]
enumFromTo :: TabType -> TabType -> [TabType]
$cenumFromTo :: TabType -> TabType -> [TabType]
enumFromThen :: TabType -> TabType -> [TabType]
$cenumFromThen :: TabType -> TabType -> [TabType]
enumFrom :: TabType -> [TabType]
$cenumFrom :: TabType -> [TabType]
fromEnum :: TabType -> Int
$cfromEnum :: TabType -> Int
toEnum :: Int -> TabType
$ctoEnum :: Int -> TabType
pred :: TabType -> TabType
$cpred :: TabType -> TabType
succ :: TabType -> TabType
$csucc :: TabType -> TabType
Enum, TabType -> TabType -> Bool
(TabType -> TabType -> Bool)
-> (TabType -> TabType -> Bool) -> Eq TabType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TabType -> TabType -> Bool
$c/= :: TabType -> TabType -> Bool
== :: TabType -> TabType -> Bool
$c== :: TabType -> TabType -> Bool
Eq, (forall x. TabType -> Rep TabType x)
-> (forall x. Rep TabType x -> TabType) -> Generic TabType
forall x. Rep TabType x -> TabType
forall x. TabType -> Rep TabType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TabType x -> TabType
$cfrom :: forall x. TabType -> Rep TabType x
Generic, Eq TabType
Eq TabType
-> (TabType -> TabType -> Ordering)
-> (TabType -> TabType -> Bool)
-> (TabType -> TabType -> Bool)
-> (TabType -> TabType -> Bool)
-> (TabType -> TabType -> Bool)
-> (TabType -> TabType -> TabType)
-> (TabType -> TabType -> TabType)
-> Ord TabType
TabType -> TabType -> Bool
TabType -> TabType -> Ordering
TabType -> TabType -> TabType
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 :: TabType -> TabType -> TabType
$cmin :: TabType -> TabType -> TabType
max :: TabType -> TabType -> TabType
$cmax :: TabType -> TabType -> TabType
>= :: TabType -> TabType -> Bool
$c>= :: TabType -> TabType -> Bool
> :: TabType -> TabType -> Bool
$c> :: TabType -> TabType -> Bool
<= :: TabType -> TabType -> Bool
$c<= :: TabType -> TabType -> Bool
< :: TabType -> TabType -> Bool
$c< :: TabType -> TabType -> Bool
compare :: TabType -> TabType -> Ordering
$ccompare :: TabType -> TabType -> Ordering
$cp1Ord :: Eq TabType
Ord, Int -> TabType -> ShowS
[TabType] -> ShowS
TabType -> String
(Int -> TabType -> ShowS)
-> (TabType -> String) -> ([TabType] -> ShowS) -> Show TabType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabType] -> ShowS
$cshowList :: [TabType] -> ShowS
show :: TabType -> String
$cshow :: TabType -> String
showsPrec :: Int -> TabType -> ShowS
$cshowsPrec :: Int -> TabType -> ShowS
Show)


instance Hashable TabType

instance FromHttpApiData TabType
   where
    parseUrlPiece :: Text -> Either Text TabType
parseUrlPiece Text
"Docs"       = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Docs
    parseUrlPiece Text
"Trash"      = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Trash
    parseUrlPiece Text
"MoreFav"    = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
MoreFav
    parseUrlPiece Text
"MoreTrash"  = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
MoreTrash

    parseUrlPiece Text
"Terms"      = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Terms
    parseUrlPiece Text
"Sources"    = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Sources
    parseUrlPiece Text
"Institutes" = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Institutes
    parseUrlPiece Text
"Authors"    = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Authors

    parseUrlPiece Text
"Contacts"   = TabType -> Either Text TabType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TabType
Contacts

    parseUrlPiece Text
_            = Text -> Either Text TabType
forall a b. a -> Either a b
Left Text
"Unexpected value of TabType"
instance ToParamSchema TabType
instance ToJSON        TabType
instance FromJSON      TabType
instance ToSchema      TabType
instance Arbitrary     TabType where
  arbitrary :: Gen TabType
arbitrary = [TabType] -> Gen TabType
forall a. [a] -> Gen a
elements [TabType
forall a. Bounded a => a
minBound .. TabType
forall a. Bounded a => a
maxBound]
instance FromJSONKey TabType where
  fromJSONKey :: FromJSONKeyFunction TabType
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction TabType
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions
instance ToJSONKey TabType where
  toJSONKey :: ToJSONKeyFunction TabType
toJSONKey = JSONKeyOptions -> ToJSONKeyFunction TabType
forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
defaultJSONKeyOptions

newtype MSet a = MSet (Map a ())
  deriving (MSet a -> MSet a -> Bool
(MSet a -> MSet a -> Bool)
-> (MSet a -> MSet a -> Bool) -> Eq (MSet a)
forall a. Eq a => MSet a -> MSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSet a -> MSet a -> Bool
$c/= :: forall a. Eq a => MSet a -> MSet a -> Bool
== :: MSet a -> MSet a -> Bool
$c== :: forall a. Eq a => MSet a -> MSet a -> Bool
Eq, Eq (MSet a)
Eq (MSet a)
-> (MSet a -> MSet a -> Ordering)
-> (MSet a -> MSet a -> Bool)
-> (MSet a -> MSet a -> Bool)
-> (MSet a -> MSet a -> Bool)
-> (MSet a -> MSet a -> Bool)
-> (MSet a -> MSet a -> MSet a)
-> (MSet a -> MSet a -> MSet a)
-> Ord (MSet a)
MSet a -> MSet a -> Bool
MSet a -> MSet a -> Ordering
MSet a -> MSet a -> MSet a
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
forall a. Ord a => Eq (MSet a)
forall a. Ord a => MSet a -> MSet a -> Bool
forall a. Ord a => MSet a -> MSet a -> Ordering
forall a. Ord a => MSet a -> MSet a -> MSet a
min :: MSet a -> MSet a -> MSet a
$cmin :: forall a. Ord a => MSet a -> MSet a -> MSet a
max :: MSet a -> MSet a -> MSet a
$cmax :: forall a. Ord a => MSet a -> MSet a -> MSet a
>= :: MSet a -> MSet a -> Bool
$c>= :: forall a. Ord a => MSet a -> MSet a -> Bool
> :: MSet a -> MSet a -> Bool
$c> :: forall a. Ord a => MSet a -> MSet a -> Bool
<= :: MSet a -> MSet a -> Bool
$c<= :: forall a. Ord a => MSet a -> MSet a -> Bool
< :: MSet a -> MSet a -> Bool
$c< :: forall a. Ord a => MSet a -> MSet a -> Bool
compare :: MSet a -> MSet a -> Ordering
$ccompare :: forall a. Ord a => MSet a -> MSet a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (MSet a)
Ord, Int -> MSet a -> ShowS
[MSet a] -> ShowS
MSet a -> String
(Int -> MSet a -> ShowS)
-> (MSet a -> String) -> ([MSet a] -> ShowS) -> Show (MSet a)
forall a. Show a => Int -> MSet a -> ShowS
forall a. Show a => [MSet a] -> ShowS
forall a. Show a => MSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSet a] -> ShowS
$cshowList :: forall a. Show a => [MSet a] -> ShowS
show :: MSet a -> String
$cshow :: forall a. Show a => MSet a -> String
showsPrec :: Int -> MSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MSet a -> ShowS
Show, (forall x. MSet a -> Rep (MSet a) x)
-> (forall x. Rep (MSet a) x -> MSet a) -> Generic (MSet a)
forall x. Rep (MSet a) x -> MSet a
forall x. MSet a -> Rep (MSet a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MSet a) x -> MSet a
forall a x. MSet a -> Rep (MSet a) x
$cto :: forall a x. Rep (MSet a) x -> MSet a
$cfrom :: forall a x. MSet a -> Rep (MSet a) x
Generic, Gen (MSet a)
Gen (MSet a) -> (MSet a -> [MSet a]) -> Arbitrary (MSet a)
MSet a -> [MSet a]
forall a. (Ord a, Arbitrary a) => Gen (MSet a)
forall a. (Ord a, Arbitrary a) => MSet a -> [MSet a]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: MSet a -> [MSet a]
$cshrink :: forall a. (Ord a, Arbitrary a) => MSet a -> [MSet a]
arbitrary :: Gen (MSet a)
$carbitrary :: forall a. (Ord a, Arbitrary a) => Gen (MSet a)
Arbitrary, b -> MSet a -> MSet a
NonEmpty (MSet a) -> MSet a
MSet a -> MSet a -> MSet a
(MSet a -> MSet a -> MSet a)
-> (NonEmpty (MSet a) -> MSet a)
-> (forall b. Integral b => b -> MSet a -> MSet a)
-> Semigroup (MSet a)
forall b. Integral b => b -> MSet a -> MSet a
forall a. Ord a => NonEmpty (MSet a) -> MSet a
forall a. Ord a => MSet a -> MSet a -> MSet a
forall a b. (Ord a, Integral b) => b -> MSet a -> MSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> MSet a -> MSet a
$cstimes :: forall a b. (Ord a, Integral b) => b -> MSet a -> MSet a
sconcat :: NonEmpty (MSet a) -> MSet a
$csconcat :: forall a. Ord a => NonEmpty (MSet a) -> MSet a
<> :: MSet a -> MSet a -> MSet a
$c<> :: forall a. Ord a => MSet a -> MSet a -> MSet a
Semigroup, Semigroup (MSet a)
MSet a
Semigroup (MSet a)
-> MSet a
-> (MSet a -> MSet a -> MSet a)
-> ([MSet a] -> MSet a)
-> Monoid (MSet a)
[MSet a] -> MSet a
MSet a -> MSet a -> MSet a
forall a. Ord a => Semigroup (MSet a)
forall a. Ord a => MSet a
forall a. Ord a => [MSet a] -> MSet a
forall a. Ord a => MSet a -> MSet a -> MSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MSet a] -> MSet a
$cmconcat :: forall a. Ord a => [MSet a] -> MSet a
mappend :: MSet a -> MSet a -> MSet a
$cmappend :: forall a. Ord a => MSet a -> MSet a -> MSet a
mempty :: MSet a
$cmempty :: forall a. Ord a => MSet a
$cp1Monoid :: forall a. Ord a => Semigroup (MSet a)
Monoid)

instance ToJSON a => ToJSON (MSet a) where
  toJSON :: MSet a -> Value
toJSON     (MSet Map a ()
m) = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON     (Map a () -> [a]
forall k a. Map k a -> [k]
Map.keys Map a ()
m)
  toEncoding :: MSet a -> Encoding
toEncoding (MSet Map a ()
m) = [a] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Map a () -> [a]
forall k a. Map k a -> [k]
Map.keys Map a ()
m)

mSetFromSet :: Set a -> MSet a
mSetFromSet :: Set a -> MSet a
mSetFromSet = Map a () -> MSet a
forall a. Map a () -> MSet a
MSet (Map a () -> MSet a) -> (Set a -> Map a ()) -> Set a -> MSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ()) -> Set a -> Map a ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> a -> ()
forall a b. a -> b -> a
const ())

mSetFromList :: Ord a => [a] -> MSet a
mSetFromList :: [a] -> MSet a
mSetFromList = Map a () -> MSet a
forall a. Map a () -> MSet a
MSet (Map a () -> MSet a) -> ([a] -> Map a ()) -> [a] -> MSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, ())] -> Map a ()
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, ())] -> Map a ()) -> ([a] -> [(a, ())]) -> [a] -> Map a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, ())) -> [a] -> [(a, ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\a
x -> (a
x, ()))

-- mSetToSet :: Ord a => MSet a -> Set a
-- mSetToSet (MSet a) = Set.fromList ( Map.keys a)
mSetToSet :: Ord a => MSet a -> Set a
mSetToSet :: MSet a -> Set a
mSetToSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> (MSet a -> [a]) -> MSet a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSet a -> [a]
forall a. MSet a -> [a]
mSetToList

mSetToList :: MSet a -> [a]
mSetToList :: MSet a -> [a]
mSetToList (MSet Map a ()
a) = Map a () -> [a]
forall k a. Map k a -> [k]
Map.keys Map a ()
a

instance Foldable MSet where
  foldMap :: (a -> m) -> MSet a -> m
foldMap a -> m
f (MSet Map a ()
m) = (a -> () -> m) -> Map a () -> m
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\a
k ()
_ -> a -> m
f a
k) Map a ()
m

instance (Ord a, FromJSON a) => FromJSON (MSet a) where
  parseJSON :: Value -> Parser (MSet a)
parseJSON = ([a] -> MSet a) -> Parser [a] -> Parser (MSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> MSet a
forall a. Ord a => [a] -> MSet a
mSetFromList (Parser [a] -> Parser (MSet a))
-> (Value -> Parser [a]) -> Value -> Parser (MSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
  -- TODO
  declareNamedSchema :: Proxy (MSet a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (MSet a)
_ = Text -> Proxy TODO -> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, Generic a, GToSchema (Rep a),
 GenericHasSimpleShape
   a
   "genericDeclareNamedSchemaUnrestricted"
   (GenericShape (Rep a))) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
wellNamedSchema Text
"" (Proxy TODO
forall k (t :: k). Proxy t
Proxy :: Proxy TODO)

------------------------------------------------------------------------
newtype NgramsTerm = NgramsTerm { NgramsTerm -> Text
unNgramsTerm :: Text }
  deriving (Eq NgramsTerm
Eq NgramsTerm
-> (NgramsTerm -> NgramsTerm -> Ordering)
-> (NgramsTerm -> NgramsTerm -> Bool)
-> (NgramsTerm -> NgramsTerm -> Bool)
-> (NgramsTerm -> NgramsTerm -> Bool)
-> (NgramsTerm -> NgramsTerm -> Bool)
-> (NgramsTerm -> NgramsTerm -> NgramsTerm)
-> (NgramsTerm -> NgramsTerm -> NgramsTerm)
-> Ord NgramsTerm
NgramsTerm -> NgramsTerm -> Bool
NgramsTerm -> NgramsTerm -> Ordering
NgramsTerm -> NgramsTerm -> NgramsTerm
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 :: NgramsTerm -> NgramsTerm -> NgramsTerm
$cmin :: NgramsTerm -> NgramsTerm -> NgramsTerm
max :: NgramsTerm -> NgramsTerm -> NgramsTerm
$cmax :: NgramsTerm -> NgramsTerm -> NgramsTerm
>= :: NgramsTerm -> NgramsTerm -> Bool
$c>= :: NgramsTerm -> NgramsTerm -> Bool
> :: NgramsTerm -> NgramsTerm -> Bool
$c> :: NgramsTerm -> NgramsTerm -> Bool
<= :: NgramsTerm -> NgramsTerm -> Bool
$c<= :: NgramsTerm -> NgramsTerm -> Bool
< :: NgramsTerm -> NgramsTerm -> Bool
$c< :: NgramsTerm -> NgramsTerm -> Bool
compare :: NgramsTerm -> NgramsTerm -> Ordering
$ccompare :: NgramsTerm -> NgramsTerm -> Ordering
$cp1Ord :: Eq NgramsTerm
Ord, NgramsTerm -> NgramsTerm -> Bool
(NgramsTerm -> NgramsTerm -> Bool)
-> (NgramsTerm -> NgramsTerm -> Bool) -> Eq NgramsTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsTerm -> NgramsTerm -> Bool
$c/= :: NgramsTerm -> NgramsTerm -> Bool
== :: NgramsTerm -> NgramsTerm -> Bool
$c== :: NgramsTerm -> NgramsTerm -> Bool
Eq, Int -> NgramsTerm -> ShowS
[NgramsTerm] -> ShowS
NgramsTerm -> String
(Int -> NgramsTerm -> ShowS)
-> (NgramsTerm -> String)
-> ([NgramsTerm] -> ShowS)
-> Show NgramsTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsTerm] -> ShowS
$cshowList :: [NgramsTerm] -> ShowS
show :: NgramsTerm -> String
$cshow :: NgramsTerm -> String
showsPrec :: Int -> NgramsTerm -> ShowS
$cshowsPrec :: Int -> NgramsTerm -> ShowS
Show, (forall x. NgramsTerm -> Rep NgramsTerm x)
-> (forall x. Rep NgramsTerm x -> NgramsTerm) -> Generic NgramsTerm
forall x. Rep NgramsTerm x -> NgramsTerm
forall x. NgramsTerm -> Rep NgramsTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsTerm x -> NgramsTerm
$cfrom :: forall x. NgramsTerm -> Rep NgramsTerm x
Generic, ToJSONKeyFunction [NgramsTerm]
ToJSONKeyFunction NgramsTerm
ToJSONKeyFunction NgramsTerm
-> ToJSONKeyFunction [NgramsTerm] -> ToJSONKey NgramsTerm
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [NgramsTerm]
$ctoJSONKeyList :: ToJSONKeyFunction [NgramsTerm]
toJSONKey :: ToJSONKeyFunction NgramsTerm
$ctoJSONKey :: ToJSONKeyFunction NgramsTerm
ToJSONKey, [NgramsTerm] -> Encoding
[NgramsTerm] -> Value
NgramsTerm -> Encoding
NgramsTerm -> Value
(NgramsTerm -> Value)
-> (NgramsTerm -> Encoding)
-> ([NgramsTerm] -> Value)
-> ([NgramsTerm] -> Encoding)
-> ToJSON NgramsTerm
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NgramsTerm] -> Encoding
$ctoEncodingList :: [NgramsTerm] -> Encoding
toJSONList :: [NgramsTerm] -> Value
$ctoJSONList :: [NgramsTerm] -> Value
toEncoding :: NgramsTerm -> Encoding
$ctoEncoding :: NgramsTerm -> Encoding
toJSON :: NgramsTerm -> Value
$ctoJSON :: NgramsTerm -> Value
ToJSON, Value -> Parser [NgramsTerm]
Value -> Parser NgramsTerm
(Value -> Parser NgramsTerm)
-> (Value -> Parser [NgramsTerm]) -> FromJSON NgramsTerm
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NgramsTerm]
$cparseJSONList :: Value -> Parser [NgramsTerm]
parseJSON :: Value -> Parser NgramsTerm
$cparseJSON :: Value -> Parser NgramsTerm
FromJSON, b -> NgramsTerm -> NgramsTerm
NonEmpty NgramsTerm -> NgramsTerm
NgramsTerm -> NgramsTerm -> NgramsTerm
(NgramsTerm -> NgramsTerm -> NgramsTerm)
-> (NonEmpty NgramsTerm -> NgramsTerm)
-> (forall b. Integral b => b -> NgramsTerm -> NgramsTerm)
-> Semigroup NgramsTerm
forall b. Integral b => b -> NgramsTerm -> NgramsTerm
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> NgramsTerm -> NgramsTerm
$cstimes :: forall b. Integral b => b -> NgramsTerm -> NgramsTerm
sconcat :: NonEmpty NgramsTerm -> NgramsTerm
$csconcat :: NonEmpty NgramsTerm -> NgramsTerm
<> :: NgramsTerm -> NgramsTerm -> NgramsTerm
$c<> :: NgramsTerm -> NgramsTerm -> NgramsTerm
Semigroup, Gen NgramsTerm
Gen NgramsTerm
-> (NgramsTerm -> [NgramsTerm]) -> Arbitrary NgramsTerm
NgramsTerm -> [NgramsTerm]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: NgramsTerm -> [NgramsTerm]
$cshrink :: NgramsTerm -> [NgramsTerm]
arbitrary :: Gen NgramsTerm
$carbitrary :: Gen NgramsTerm
Arbitrary, Decoder s NgramsTerm
Decoder s [NgramsTerm]
[NgramsTerm] -> Encoding
NgramsTerm -> Encoding
(NgramsTerm -> Encoding)
-> (forall s. Decoder s NgramsTerm)
-> ([NgramsTerm] -> Encoding)
-> (forall s. Decoder s [NgramsTerm])
-> Serialise NgramsTerm
forall s. Decoder s [NgramsTerm]
forall s. Decoder s NgramsTerm
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [NgramsTerm]
$cdecodeList :: forall s. Decoder s [NgramsTerm]
encodeList :: [NgramsTerm] -> Encoding
$cencodeList :: [NgramsTerm] -> Encoding
decode :: Decoder s NgramsTerm
$cdecode :: forall s. Decoder s NgramsTerm
encode :: NgramsTerm -> Encoding
$cencode :: NgramsTerm -> Encoding
Serialise, Proxy NgramsTerm -> Declare (Definitions Schema) NamedSchema
(Proxy NgramsTerm -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NgramsTerm
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy NgramsTerm -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy NgramsTerm -> Declare (Definitions Schema) NamedSchema
ToSchema, Int -> NgramsTerm -> Int
NgramsTerm -> Int
(Int -> NgramsTerm -> Int)
-> (NgramsTerm -> Int) -> Hashable NgramsTerm
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: NgramsTerm -> Int
$chash :: NgramsTerm -> Int
hashWithSalt :: Int -> NgramsTerm -> Int
$chashWithSalt :: Int -> NgramsTerm -> Int
Hashable, NgramsTerm -> ()
(NgramsTerm -> ()) -> NFData NgramsTerm
forall a. (a -> ()) -> NFData a
rnf :: NgramsTerm -> ()
$crnf :: NgramsTerm -> ()
NFData)

instance IsHashable NgramsTerm where
  hash :: NgramsTerm -> Text
hash (NgramsTerm Text
t) = Text -> Text
forall a. IsHashable a => a -> Text
hash Text
t

instance Monoid NgramsTerm where
  mempty :: NgramsTerm
mempty = Text -> NgramsTerm
NgramsTerm Text
""

instance FromJSONKey NgramsTerm where
  fromJSONKey :: FromJSONKeyFunction NgramsTerm
fromJSONKey = (Text -> Parser NgramsTerm) -> FromJSONKeyFunction NgramsTerm
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser NgramsTerm) -> FromJSONKeyFunction NgramsTerm)
-> (Text -> Parser NgramsTerm) -> FromJSONKeyFunction NgramsTerm
forall a b. (a -> b) -> a -> b
$ \Text
t -> NgramsTerm -> Parser NgramsTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NgramsTerm -> Parser NgramsTerm)
-> NgramsTerm -> Parser NgramsTerm
forall a b. (a -> b) -> a -> b
$ Text -> NgramsTerm
NgramsTerm (Text -> NgramsTerm) -> Text -> NgramsTerm
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip Text
t

instance IsString NgramsTerm where
  fromString :: String -> NgramsTerm
fromString String
s = Text -> NgramsTerm
NgramsTerm (Text -> NgramsTerm) -> Text -> NgramsTerm
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s

instance FromField NgramsTerm
  where
    fromField :: FieldParser NgramsTerm
fromField Field
field Maybe ByteString
mb = do
      Value
v <- FieldParser Value
forall a. FromField a => FieldParser a
fromField Field
field Maybe ByteString
mb
      case Value -> Result Text
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
        Success Text
a -> NgramsTerm -> Conversion NgramsTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NgramsTerm -> Conversion NgramsTerm)
-> NgramsTerm -> Conversion NgramsTerm
forall a b. (a -> b) -> a -> b
$ Text -> NgramsTerm
NgramsTerm (Text -> NgramsTerm) -> Text -> NgramsTerm
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip Text
a
        Error String
_err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion NgramsTerm
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
field
                      (String -> Conversion NgramsTerm)
-> String -> Conversion NgramsTerm
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
" " [ String
"cannot parse hyperdata for JSON: "
                                             , Value -> String
forall a. Show a => a -> String
show Value
v
                                             ]

data RootParent = RootParent
  { RootParent -> NgramsTerm
_rp_root   :: NgramsTerm
  , RootParent -> NgramsTerm
_rp_parent :: NgramsTerm
  }
  deriving (Eq RootParent
Eq RootParent
-> (RootParent -> RootParent -> Ordering)
-> (RootParent -> RootParent -> Bool)
-> (RootParent -> RootParent -> Bool)
-> (RootParent -> RootParent -> Bool)
-> (RootParent -> RootParent -> Bool)
-> (RootParent -> RootParent -> RootParent)
-> (RootParent -> RootParent -> RootParent)
-> Ord RootParent
RootParent -> RootParent -> Bool
RootParent -> RootParent -> Ordering
RootParent -> RootParent -> RootParent
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 :: RootParent -> RootParent -> RootParent
$cmin :: RootParent -> RootParent -> RootParent
max :: RootParent -> RootParent -> RootParent
$cmax :: RootParent -> RootParent -> RootParent
>= :: RootParent -> RootParent -> Bool
$c>= :: RootParent -> RootParent -> Bool
> :: RootParent -> RootParent -> Bool
$c> :: RootParent -> RootParent -> Bool
<= :: RootParent -> RootParent -> Bool
$c<= :: RootParent -> RootParent -> Bool
< :: RootParent -> RootParent -> Bool
$c< :: RootParent -> RootParent -> Bool
compare :: RootParent -> RootParent -> Ordering
$ccompare :: RootParent -> RootParent -> Ordering
$cp1Ord :: Eq RootParent
Ord, RootParent -> RootParent -> Bool
(RootParent -> RootParent -> Bool)
-> (RootParent -> RootParent -> Bool) -> Eq RootParent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootParent -> RootParent -> Bool
$c/= :: RootParent -> RootParent -> Bool
== :: RootParent -> RootParent -> Bool
$c== :: RootParent -> RootParent -> Bool
Eq, Int -> RootParent -> ShowS
[RootParent] -> ShowS
RootParent -> String
(Int -> RootParent -> ShowS)
-> (RootParent -> String)
-> ([RootParent] -> ShowS)
-> Show RootParent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootParent] -> ShowS
$cshowList :: [RootParent] -> ShowS
show :: RootParent -> String
$cshow :: RootParent -> String
showsPrec :: Int -> RootParent -> ShowS
$cshowsPrec :: Int -> RootParent -> ShowS
Show, (forall x. RootParent -> Rep RootParent x)
-> (forall x. Rep RootParent x -> RootParent) -> Generic RootParent
forall x. Rep RootParent x -> RootParent
forall x. RootParent -> Rep RootParent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RootParent x -> RootParent
$cfrom :: forall x. RootParent -> Rep RootParent x
Generic)

deriveJSON (unPrefix "_rp_") ''RootParent
makeLenses ''RootParent

data NgramsRepoElement = NgramsRepoElement
  { NgramsRepoElement -> Int
_nre_size        :: !Int
  , NgramsRepoElement -> ListType
_nre_list        :: !ListType
  , NgramsRepoElement -> Maybe NgramsTerm
_nre_root        :: !(Maybe NgramsTerm)
  , NgramsRepoElement -> Maybe NgramsTerm
_nre_parent      :: !(Maybe NgramsTerm)
  , NgramsRepoElement -> MSet NgramsTerm
_nre_children    :: !(MSet NgramsTerm)
  }
  deriving (Eq NgramsRepoElement
Eq NgramsRepoElement
-> (NgramsRepoElement -> NgramsRepoElement -> Ordering)
-> (NgramsRepoElement -> NgramsRepoElement -> Bool)
-> (NgramsRepoElement -> NgramsRepoElement -> Bool)
-> (NgramsRepoElement -> NgramsRepoElement -> Bool)
-> (NgramsRepoElement -> NgramsRepoElement -> Bool)
-> (NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement)
-> (NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement)
-> Ord NgramsRepoElement
NgramsRepoElement -> NgramsRepoElement -> Bool
NgramsRepoElement -> NgramsRepoElement -> Ordering
NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
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 :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
$cmin :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
max :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
$cmax :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
>= :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c>= :: NgramsRepoElement -> NgramsRepoElement -> Bool
> :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c> :: NgramsRepoElement -> NgramsRepoElement -> Bool
<= :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c<= :: NgramsRepoElement -> NgramsRepoElement -> Bool
< :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c< :: NgramsRepoElement -> NgramsRepoElement -> Bool
compare :: NgramsRepoElement -> NgramsRepoElement -> Ordering
$ccompare :: NgramsRepoElement -> NgramsRepoElement -> Ordering
$cp1Ord :: Eq NgramsRepoElement
Ord, NgramsRepoElement -> NgramsRepoElement -> Bool
(NgramsRepoElement -> NgramsRepoElement -> Bool)
-> (NgramsRepoElement -> NgramsRepoElement -> Bool)
-> Eq NgramsRepoElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c/= :: NgramsRepoElement -> NgramsRepoElement -> Bool
== :: NgramsRepoElement -> NgramsRepoElement -> Bool
$c== :: NgramsRepoElement -> NgramsRepoElement -> Bool
Eq, Int -> NgramsRepoElement -> ShowS
[NgramsRepoElement] -> ShowS
NgramsRepoElement -> String
(Int -> NgramsRepoElement -> ShowS)
-> (NgramsRepoElement -> String)
-> ([NgramsRepoElement] -> ShowS)
-> Show NgramsRepoElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsRepoElement] -> ShowS
$cshowList :: [NgramsRepoElement] -> ShowS
show :: NgramsRepoElement -> String
$cshow :: NgramsRepoElement -> String
showsPrec :: Int -> NgramsRepoElement -> ShowS
$cshowsPrec :: Int -> NgramsRepoElement -> ShowS
Show, (forall x. NgramsRepoElement -> Rep NgramsRepoElement x)
-> (forall x. Rep NgramsRepoElement x -> NgramsRepoElement)
-> Generic NgramsRepoElement
forall x. Rep NgramsRepoElement x -> NgramsRepoElement
forall x. NgramsRepoElement -> Rep NgramsRepoElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsRepoElement x -> NgramsRepoElement
$cfrom :: forall x. NgramsRepoElement -> Rep NgramsRepoElement x
Generic)

deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
-- TODO
-- if ngrams & not size => size
-- drop occurrences

makeLenses ''NgramsRepoElement

instance ToSchema NgramsRepoElement where
  declareNamedSchema :: Proxy NgramsRepoElement -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy NgramsRepoElement
-> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_nre_")

instance Serialise (MSet NgramsTerm)
instance Serialise NgramsRepoElement

data NgramsElement =
     NgramsElement { NgramsElement -> NgramsTerm
_ne_ngrams      :: NgramsTerm
                   , NgramsElement -> Int
_ne_size        :: Int
                   , NgramsElement -> ListType
_ne_list        :: ListType
                   , NgramsElement -> Int
_ne_occurrences :: Int
                   , NgramsElement -> Maybe NgramsTerm
_ne_root        :: Maybe NgramsTerm
                   , NgramsElement -> Maybe NgramsTerm
_ne_parent      :: Maybe NgramsTerm
                   , NgramsElement -> MSet NgramsTerm
_ne_children    :: MSet  NgramsTerm
                   }
      deriving (Eq NgramsElement
Eq NgramsElement
-> (NgramsElement -> NgramsElement -> Ordering)
-> (NgramsElement -> NgramsElement -> Bool)
-> (NgramsElement -> NgramsElement -> Bool)
-> (NgramsElement -> NgramsElement -> Bool)
-> (NgramsElement -> NgramsElement -> Bool)
-> (NgramsElement -> NgramsElement -> NgramsElement)
-> (NgramsElement -> NgramsElement -> NgramsElement)
-> Ord NgramsElement
NgramsElement -> NgramsElement -> Bool
NgramsElement -> NgramsElement -> Ordering
NgramsElement -> NgramsElement -> NgramsElement
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 :: NgramsElement -> NgramsElement -> NgramsElement
$cmin :: NgramsElement -> NgramsElement -> NgramsElement
max :: NgramsElement -> NgramsElement -> NgramsElement
$cmax :: NgramsElement -> NgramsElement -> NgramsElement
>= :: NgramsElement -> NgramsElement -> Bool
$c>= :: NgramsElement -> NgramsElement -> Bool
> :: NgramsElement -> NgramsElement -> Bool
$c> :: NgramsElement -> NgramsElement -> Bool
<= :: NgramsElement -> NgramsElement -> Bool
$c<= :: NgramsElement -> NgramsElement -> Bool
< :: NgramsElement -> NgramsElement -> Bool
$c< :: NgramsElement -> NgramsElement -> Bool
compare :: NgramsElement -> NgramsElement -> Ordering
$ccompare :: NgramsElement -> NgramsElement -> Ordering
$cp1Ord :: Eq NgramsElement
Ord, NgramsElement -> NgramsElement -> Bool
(NgramsElement -> NgramsElement -> Bool)
-> (NgramsElement -> NgramsElement -> Bool) -> Eq NgramsElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsElement -> NgramsElement -> Bool
$c/= :: NgramsElement -> NgramsElement -> Bool
== :: NgramsElement -> NgramsElement -> Bool
$c== :: NgramsElement -> NgramsElement -> Bool
Eq, Int -> NgramsElement -> ShowS
[NgramsElement] -> ShowS
NgramsElement -> String
(Int -> NgramsElement -> ShowS)
-> (NgramsElement -> String)
-> ([NgramsElement] -> ShowS)
-> Show NgramsElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsElement] -> ShowS
$cshowList :: [NgramsElement] -> ShowS
show :: NgramsElement -> String
$cshow :: NgramsElement -> String
showsPrec :: Int -> NgramsElement -> ShowS
$cshowsPrec :: Int -> NgramsElement -> ShowS
Show, (forall x. NgramsElement -> Rep NgramsElement x)
-> (forall x. Rep NgramsElement x -> NgramsElement)
-> Generic NgramsElement
forall x. Rep NgramsElement x -> NgramsElement
forall x. NgramsElement -> Rep NgramsElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsElement x -> NgramsElement
$cfrom :: forall x. NgramsElement -> Rep NgramsElement x
Generic)

deriveJSON (unPrefix "_ne_") ''NgramsElement
makeLenses ''NgramsElement

mkNgramsElement :: NgramsTerm
                -> ListType
                -> Maybe RootParent
                -> MSet NgramsTerm
                -> NgramsElement
mkNgramsElement :: NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
ngrams ListType
list Maybe RootParent
rp MSet NgramsTerm
children =
  NgramsTerm
-> Int
-> ListType
-> Int
-> Maybe NgramsTerm
-> Maybe NgramsTerm
-> MSet NgramsTerm
-> NgramsElement
NgramsElement NgramsTerm
ngrams (Text -> Int
size (NgramsTerm -> Text
unNgramsTerm NgramsTerm
ngrams)) ListType
list Int
1 (RootParent -> NgramsTerm
_rp_root (RootParent -> NgramsTerm) -> Maybe RootParent -> Maybe NgramsTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RootParent
rp) (RootParent -> NgramsTerm
_rp_parent (RootParent -> NgramsTerm) -> Maybe RootParent -> Maybe NgramsTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RootParent
rp) MSet NgramsTerm
children

newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
newNgramsElement Maybe ListType
mayList NgramsTerm
ngrams =
  NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
ngrams (ListType -> Maybe ListType -> ListType
forall a. a -> Maybe a -> a
fromMaybe ListType
MapTerm Maybe ListType
mayList) Maybe RootParent
forall a. Maybe a
Nothing MSet NgramsTerm
forall a. Monoid a => a
mempty

instance ToSchema NgramsElement where
  declareNamedSchema :: Proxy NgramsElement -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy NgramsElement -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_ne_")
instance Arbitrary NgramsElement where
  arbitrary :: Gen NgramsElement
arbitrary = [NgramsElement] -> Gen NgramsElement
forall a. [a] -> Gen a
elements [Maybe ListType -> NgramsTerm -> NgramsElement
newNgramsElement Maybe ListType
forall a. Maybe a
Nothing NgramsTerm
"sport"]


------------------------------------------------------------------------
newtype NgramsTable = NgramsTable [NgramsElement]
  deriving (Eq NgramsTable
Eq NgramsTable
-> (NgramsTable -> NgramsTable -> Ordering)
-> (NgramsTable -> NgramsTable -> Bool)
-> (NgramsTable -> NgramsTable -> Bool)
-> (NgramsTable -> NgramsTable -> Bool)
-> (NgramsTable -> NgramsTable -> Bool)
-> (NgramsTable -> NgramsTable -> NgramsTable)
-> (NgramsTable -> NgramsTable -> NgramsTable)
-> Ord NgramsTable
NgramsTable -> NgramsTable -> Bool
NgramsTable -> NgramsTable -> Ordering
NgramsTable -> NgramsTable -> NgramsTable
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 :: NgramsTable -> NgramsTable -> NgramsTable
$cmin :: NgramsTable -> NgramsTable -> NgramsTable
max :: NgramsTable -> NgramsTable -> NgramsTable
$cmax :: NgramsTable -> NgramsTable -> NgramsTable
>= :: NgramsTable -> NgramsTable -> Bool
$c>= :: NgramsTable -> NgramsTable -> Bool
> :: NgramsTable -> NgramsTable -> Bool
$c> :: NgramsTable -> NgramsTable -> Bool
<= :: NgramsTable -> NgramsTable -> Bool
$c<= :: NgramsTable -> NgramsTable -> Bool
< :: NgramsTable -> NgramsTable -> Bool
$c< :: NgramsTable -> NgramsTable -> Bool
compare :: NgramsTable -> NgramsTable -> Ordering
$ccompare :: NgramsTable -> NgramsTable -> Ordering
$cp1Ord :: Eq NgramsTable
Ord, NgramsTable -> NgramsTable -> Bool
(NgramsTable -> NgramsTable -> Bool)
-> (NgramsTable -> NgramsTable -> Bool) -> Eq NgramsTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsTable -> NgramsTable -> Bool
$c/= :: NgramsTable -> NgramsTable -> Bool
== :: NgramsTable -> NgramsTable -> Bool
$c== :: NgramsTable -> NgramsTable -> Bool
Eq, (forall x. NgramsTable -> Rep NgramsTable x)
-> (forall x. Rep NgramsTable x -> NgramsTable)
-> Generic NgramsTable
forall x. Rep NgramsTable x -> NgramsTable
forall x. NgramsTable -> Rep NgramsTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsTable x -> NgramsTable
$cfrom :: forall x. NgramsTable -> Rep NgramsTable x
Generic, [NgramsTable] -> Encoding
[NgramsTable] -> Value
NgramsTable -> Encoding
NgramsTable -> Value
(NgramsTable -> Value)
-> (NgramsTable -> Encoding)
-> ([NgramsTable] -> Value)
-> ([NgramsTable] -> Encoding)
-> ToJSON NgramsTable
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NgramsTable] -> Encoding
$ctoEncodingList :: [NgramsTable] -> Encoding
toJSONList :: [NgramsTable] -> Value
$ctoJSONList :: [NgramsTable] -> Value
toEncoding :: NgramsTable -> Encoding
$ctoEncoding :: NgramsTable -> Encoding
toJSON :: NgramsTable -> Value
$ctoJSON :: NgramsTable -> Value
ToJSON, Value -> Parser [NgramsTable]
Value -> Parser NgramsTable
(Value -> Parser NgramsTable)
-> (Value -> Parser [NgramsTable]) -> FromJSON NgramsTable
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NgramsTable]
$cparseJSONList :: Value -> Parser [NgramsTable]
parseJSON :: Value -> Parser NgramsTable
$cparseJSON :: Value -> Parser NgramsTable
FromJSON, Int -> NgramsTable -> ShowS
[NgramsTable] -> ShowS
NgramsTable -> String
(Int -> NgramsTable -> ShowS)
-> (NgramsTable -> String)
-> ([NgramsTable] -> ShowS)
-> Show NgramsTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsTable] -> ShowS
$cshowList :: [NgramsTable] -> ShowS
show :: NgramsTable -> String
$cshow :: NgramsTable -> String
showsPrec :: Int -> NgramsTable -> ShowS
$cshowsPrec :: Int -> NgramsTable -> ShowS
Show)

-- type NgramsList = NgramsTable

makePrisms ''NgramsTable

-- | Question: why these repetition of Type in this instance
-- may you document it please ?
instance Each NgramsTable NgramsTable NgramsElement NgramsElement where
  each :: (NgramsElement -> f NgramsElement) -> NgramsTable -> f NgramsTable
each = ([NgramsElement] -> f [NgramsElement])
-> NgramsTable -> f NgramsTable
Iso' NgramsTable [NgramsElement]
_NgramsTable (([NgramsElement] -> f [NgramsElement])
 -> NgramsTable -> f NgramsTable)
-> ((NgramsElement -> f NgramsElement)
    -> [NgramsElement] -> f [NgramsElement])
-> (NgramsElement -> f NgramsElement)
-> NgramsTable
-> f NgramsTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsElement -> f NgramsElement)
-> [NgramsElement] -> f [NgramsElement]
forall s t a b. Each s t a b => Traversal s t a b
each

-- TODO discuss
-- | TODO Check N and Weight
{-
toNgramsElement :: [NgramsTableData] -> [NgramsElement]
toNgramsElement ns = map toNgramsElement' ns
    where
      toNgramsElement' (NgramsTableData _ p t _ lt w) = NgramsElement t lt' (round w) p' c'
        where
          p' = case p of
                 Nothing -> Nothing
                 Just x  -> lookup x mapParent
          c' = maybe mempty identity $ lookup t mapChildren
          lt' = maybe (panic "API.Ngrams: listypeId") identity lt

      mapParent :: Map Int Text
      mapParent   = Map.fromListWith (<>) $ map (\(NgramsTableData i _ t _ _ _) -> (i,t)) ns

      mapChildren :: Map Text (Set Text)
      mapChildren = Map.mapKeys (\i -> (maybe (panic "API.Ngrams.mapChildren: ParentId with no Terms: Impossible") identity $ lookup i mapParent))
                  $ Map.fromListWith (<>)
                  $ map (first fromJust)
                  $ filter (isJust . fst)
                  $ map (\(NgramsTableData _ p t _ _ _) -> (p, Set.singleton t)) ns
-}

mockTable :: NgramsTable
mockTable :: NgramsTable
mockTable = [NgramsElement] -> NgramsTable
NgramsTable
  [ NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"animal"  ListType
MapTerm        Maybe RootParent
forall a. Maybe a
Nothing       ([NgramsTerm] -> MSet NgramsTerm
forall a. Ord a => [a] -> MSet a
mSetFromList [NgramsTerm
"dog", NgramsTerm
"cat"])
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"cat"     ListType
MapTerm       (NgramsTerm -> Maybe RootParent
rp NgramsTerm
"animal")  MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"cats"    ListType
StopTerm       Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"dog"     ListType
MapTerm       (NgramsTerm -> Maybe RootParent
rp NgramsTerm
"animal")  ([NgramsTerm] -> MSet NgramsTerm
forall a. Ord a => [a] -> MSet a
mSetFromList [NgramsTerm
"dogs"])
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"dogs"    ListType
StopTerm      (NgramsTerm -> Maybe RootParent
rp NgramsTerm
"dog")     MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"fox"     ListType
MapTerm        Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"object"  ListType
CandidateTerm  Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"nothing" ListType
StopTerm       Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"organic" ListType
MapTerm        Maybe RootParent
forall a. Maybe a
Nothing       ([NgramsTerm] -> MSet NgramsTerm
forall a. Ord a => [a] -> MSet a
mSetFromList [NgramsTerm
"flower"])
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"flower"  ListType
MapTerm       (NgramsTerm -> Maybe RootParent
rp NgramsTerm
"organic") MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"moon"    ListType
CandidateTerm  Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  , NgramsTerm
-> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
mkNgramsElement NgramsTerm
"sky"     ListType
StopTerm       Maybe RootParent
forall a. Maybe a
Nothing       MSet NgramsTerm
forall a. Monoid a => a
mempty
  ]
  where
    rp :: NgramsTerm -> Maybe RootParent
rp NgramsTerm
n = RootParent -> Maybe RootParent
forall a. a -> Maybe a
Just (RootParent -> Maybe RootParent) -> RootParent -> Maybe RootParent
forall a b. (a -> b) -> a -> b
$ NgramsTerm -> NgramsTerm -> RootParent
RootParent NgramsTerm
n NgramsTerm
n

instance Arbitrary NgramsTable where
  arbitrary :: Gen NgramsTable
arbitrary = NgramsTable -> Gen NgramsTable
forall (f :: * -> *) a. Applicative f => a -> f a
pure NgramsTable
mockTable

instance ToSchema NgramsTable

------------------------------------------------------------------------
type NgramsTableMap = Map NgramsTerm NgramsRepoElement
------------------------------------------------------------------------
-- On the Client side:
--data Action = InGroup     NgramsId NgramsId
--            | OutGroup    NgramsId NgramsId
--            | SetListType NgramsId ListType

data PatchSet a = PatchSet
  { PatchSet a -> Set a
_rem :: Set a
  , PatchSet a -> Set a
_add :: Set a
  }
  deriving (PatchSet a -> PatchSet a -> Bool
(PatchSet a -> PatchSet a -> Bool)
-> (PatchSet a -> PatchSet a -> Bool) -> Eq (PatchSet a)
forall a. Eq a => PatchSet a -> PatchSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatchSet a -> PatchSet a -> Bool
$c/= :: forall a. Eq a => PatchSet a -> PatchSet a -> Bool
== :: PatchSet a -> PatchSet a -> Bool
$c== :: forall a. Eq a => PatchSet a -> PatchSet a -> Bool
Eq, Eq (PatchSet a)
Eq (PatchSet a)
-> (PatchSet a -> PatchSet a -> Ordering)
-> (PatchSet a -> PatchSet a -> Bool)
-> (PatchSet a -> PatchSet a -> Bool)
-> (PatchSet a -> PatchSet a -> Bool)
-> (PatchSet a -> PatchSet a -> Bool)
-> (PatchSet a -> PatchSet a -> PatchSet a)
-> (PatchSet a -> PatchSet a -> PatchSet a)
-> Ord (PatchSet a)
PatchSet a -> PatchSet a -> Bool
PatchSet a -> PatchSet a -> Ordering
PatchSet a -> PatchSet a -> PatchSet a
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
forall a. Ord a => Eq (PatchSet a)
forall a. Ord a => PatchSet a -> PatchSet a -> Bool
forall a. Ord a => PatchSet a -> PatchSet a -> Ordering
forall a. Ord a => PatchSet a -> PatchSet a -> PatchSet a
min :: PatchSet a -> PatchSet a -> PatchSet a
$cmin :: forall a. Ord a => PatchSet a -> PatchSet a -> PatchSet a
max :: PatchSet a -> PatchSet a -> PatchSet a
$cmax :: forall a. Ord a => PatchSet a -> PatchSet a -> PatchSet a
>= :: PatchSet a -> PatchSet a -> Bool
$c>= :: forall a. Ord a => PatchSet a -> PatchSet a -> Bool
> :: PatchSet a -> PatchSet a -> Bool
$c> :: forall a. Ord a => PatchSet a -> PatchSet a -> Bool
<= :: PatchSet a -> PatchSet a -> Bool
$c<= :: forall a. Ord a => PatchSet a -> PatchSet a -> Bool
< :: PatchSet a -> PatchSet a -> Bool
$c< :: forall a. Ord a => PatchSet a -> PatchSet a -> Bool
compare :: PatchSet a -> PatchSet a -> Ordering
$ccompare :: forall a. Ord a => PatchSet a -> PatchSet a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PatchSet a)
Ord, Int -> PatchSet a -> ShowS
[PatchSet a] -> ShowS
PatchSet a -> String
(Int -> PatchSet a -> ShowS)
-> (PatchSet a -> String)
-> ([PatchSet a] -> ShowS)
-> Show (PatchSet a)
forall a. Show a => Int -> PatchSet a -> ShowS
forall a. Show a => [PatchSet a] -> ShowS
forall a. Show a => PatchSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatchSet a] -> ShowS
$cshowList :: forall a. Show a => [PatchSet a] -> ShowS
show :: PatchSet a -> String
$cshow :: forall a. Show a => PatchSet a -> String
showsPrec :: Int -> PatchSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PatchSet a -> ShowS
Show, (forall x. PatchSet a -> Rep (PatchSet a) x)
-> (forall x. Rep (PatchSet a) x -> PatchSet a)
-> Generic (PatchSet a)
forall x. Rep (PatchSet a) x -> PatchSet a
forall x. PatchSet a -> Rep (PatchSet a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PatchSet a) x -> PatchSet a
forall a x. PatchSet a -> Rep (PatchSet a) x
$cto :: forall a x. Rep (PatchSet a) x -> PatchSet a
$cfrom :: forall a x. PatchSet a -> Rep (PatchSet a) x
Generic)

makeLenses ''PatchSet
makePrisms ''PatchSet

instance ToJSON a => ToJSON (PatchSet a) where
  toJSON :: PatchSet a -> Value
toJSON     = Options -> PatchSet a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> PatchSet a -> Value) -> Options -> PatchSet a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_"
  toEncoding :: PatchSet a -> Encoding
toEncoding = Options -> PatchSet a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> PatchSet a -> Encoding)
-> Options -> PatchSet a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_"

instance (Ord a, FromJSON a) => FromJSON (PatchSet a) where
  parseJSON :: Value -> Parser (PatchSet a)
parseJSON = Options -> Value -> Parser (PatchSet a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (PatchSet a))
-> Options -> Value -> Parser (PatchSet a)
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_"

{-
instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where
  arbitrary = PatchSet <$> arbitrary <*> arbitrary

type instance Patched (PatchSet a) = Set a

type ConflictResolutionPatchSet a = SimpleConflictResolution' (Set a)
type instance ConflictResolution (PatchSet a) = ConflictResolutionPatchSet a

instance Ord a => Semigroup (PatchSet a) where
  p <> q = PatchSet { _rem = (q ^. rem) `Set.difference` (p ^. add) <> p ^. rem
                    , _add = (q ^. add) `Set.difference` (p ^. rem) <> p ^. add
                    } -- TODO Review

instance Ord a => Monoid (PatchSet a) where
  mempty = PatchSet mempty mempty

instance Ord a => Group (PatchSet a) where
  invert (PatchSet r a) = PatchSet a r

instance Ord a => Composable (PatchSet a) where
  composable _ _ = undefined

instance Ord a => Action (PatchSet a) (Set a) where
  act p source = (source `Set.difference` (p ^. rem)) <> p ^. add

instance Applicable (PatchSet a) (Set a) where
  applicable _ _ = mempty

instance Ord a => Validity (PatchSet a) where
  validate p = check (Set.disjoint (p ^. rem) (p ^. add)) "_rem and _add should be dijoint"

instance Ord a => Transformable (PatchSet a) where
  transformable = undefined

  conflicts _p _q = undefined

  transformWith conflict p q = undefined conflict p q

instance ToSchema a => ToSchema (PatchSet a)
-}

type AddRem = Replace (Maybe ())

instance Serialise AddRem

remPatch, addPatch :: AddRem
remPatch :: AddRem
remPatch = Maybe () -> Maybe () -> AddRem
forall p a. Replaceable p a => a -> a -> p
replace (() -> Maybe ()
forall a. a -> Maybe a
Just ()) Maybe ()
forall a. Maybe a
Nothing
addPatch :: AddRem
addPatch = Maybe () -> Maybe () -> AddRem
forall p a. Replaceable p a => a -> a -> p
replace Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just ())

isRem :: Replace (Maybe ()) -> Bool
isRem :: AddRem -> Bool
isRem = (AddRem -> AddRem -> Bool
forall a. Eq a => a -> a -> Bool
== AddRem
remPatch)

type PatchMap = PM.PatchMap

newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
  deriving (PatchMSet a -> PatchMSet a -> Bool
(PatchMSet a -> PatchMSet a -> Bool)
-> (PatchMSet a -> PatchMSet a -> Bool) -> Eq (PatchMSet a)
forall a. Eq a => PatchMSet a -> PatchMSet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatchMSet a -> PatchMSet a -> Bool
$c/= :: forall a. Eq a => PatchMSet a -> PatchMSet a -> Bool
== :: PatchMSet a -> PatchMSet a -> Bool
$c== :: forall a. Eq a => PatchMSet a -> PatchMSet a -> Bool
Eq, Int -> PatchMSet a -> ShowS
[PatchMSet a] -> ShowS
PatchMSet a -> String
(Int -> PatchMSet a -> ShowS)
-> (PatchMSet a -> String)
-> ([PatchMSet a] -> ShowS)
-> Show (PatchMSet a)
forall a. Show a => Int -> PatchMSet a -> ShowS
forall a. Show a => [PatchMSet a] -> ShowS
forall a. Show a => PatchMSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatchMSet a] -> ShowS
$cshowList :: forall a. Show a => [PatchMSet a] -> ShowS
show :: PatchMSet a -> String
$cshow :: forall a. Show a => PatchMSet a -> String
showsPrec :: Int -> PatchMSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PatchMSet a -> ShowS
Show, (forall x. PatchMSet a -> Rep (PatchMSet a) x)
-> (forall x. Rep (PatchMSet a) x -> PatchMSet a)
-> Generic (PatchMSet a)
forall x. Rep (PatchMSet a) x -> PatchMSet a
forall x. PatchMSet a -> Rep (PatchMSet a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PatchMSet a) x -> PatchMSet a
forall a x. PatchMSet a -> Rep (PatchMSet a) x
$cto :: forall a x. Rep (PatchMSet a) x -> PatchMSet a
$cfrom :: forall a x. PatchMSet a -> Rep (PatchMSet a) x
Generic, PatchMSet a -> Validation
(PatchMSet a -> Validation) -> Validity (PatchMSet a)
forall a. PatchMSet a -> Validation
forall a. (a -> Validation) -> Validity a
validate :: PatchMSet a -> Validation
$cvalidate :: forall a. PatchMSet a -> Validation
Validity, b -> PatchMSet a -> PatchMSet a
NonEmpty (PatchMSet a) -> PatchMSet a
PatchMSet a -> PatchMSet a -> PatchMSet a
(PatchMSet a -> PatchMSet a -> PatchMSet a)
-> (NonEmpty (PatchMSet a) -> PatchMSet a)
-> (forall b. Integral b => b -> PatchMSet a -> PatchMSet a)
-> Semigroup (PatchMSet a)
forall b. Integral b => b -> PatchMSet a -> PatchMSet a
forall a. Ord a => NonEmpty (PatchMSet a) -> PatchMSet a
forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
forall a b. (Ord a, Integral b) => b -> PatchMSet a -> PatchMSet a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PatchMSet a -> PatchMSet a
$cstimes :: forall a b. (Ord a, Integral b) => b -> PatchMSet a -> PatchMSet a
sconcat :: NonEmpty (PatchMSet a) -> PatchMSet a
$csconcat :: forall a. Ord a => NonEmpty (PatchMSet a) -> PatchMSet a
<> :: PatchMSet a -> PatchMSet a -> PatchMSet a
$c<> :: forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
Semigroup, Semigroup (PatchMSet a)
PatchMSet a
Semigroup (PatchMSet a)
-> PatchMSet a
-> (PatchMSet a -> PatchMSet a -> PatchMSet a)
-> ([PatchMSet a] -> PatchMSet a)
-> Monoid (PatchMSet a)
[PatchMSet a] -> PatchMSet a
PatchMSet a -> PatchMSet a -> PatchMSet a
forall a. Ord a => Semigroup (PatchMSet a)
forall a. Ord a => PatchMSet a
forall a. Ord a => [PatchMSet a] -> PatchMSet a
forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PatchMSet a] -> PatchMSet a
$cmconcat :: forall a. Ord a => [PatchMSet a] -> PatchMSet a
mappend :: PatchMSet a -> PatchMSet a -> PatchMSet a
$cmappend :: forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
mempty :: PatchMSet a
$cmempty :: forall a. Ord a => PatchMSet a
$cp1Monoid :: forall a. Ord a => Semigroup (PatchMSet a)
Monoid, Monoid (PatchMSet a)
Monoid (PatchMSet a)
-> (PatchMSet a -> PatchMSet a)
-> (PatchMSet a -> PatchMSet a -> PatchMSet a)
-> (forall x. Integral x => PatchMSet a -> x -> PatchMSet a)
-> Group (PatchMSet a)
PatchMSet a -> PatchMSet a
PatchMSet a -> x -> PatchMSet a
PatchMSet a -> PatchMSet a -> PatchMSet a
forall x. Integral x => PatchMSet a -> x -> PatchMSet a
forall a. Ord a => Monoid (PatchMSet a)
forall a. Ord a => PatchMSet a -> PatchMSet a
forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
forall a x. (Ord a, Integral x) => PatchMSet a -> x -> PatchMSet a
forall m.
Monoid m
-> (m -> m)
-> (m -> m -> m)
-> (forall x. Integral x => m -> x -> m)
-> Group m
pow :: PatchMSet a -> x -> PatchMSet a
$cpow :: forall a x. (Ord a, Integral x) => PatchMSet a -> x -> PatchMSet a
~~ :: PatchMSet a -> PatchMSet a -> PatchMSet a
$c~~ :: forall a. Ord a => PatchMSet a -> PatchMSet a -> PatchMSet a
invert :: PatchMSet a -> PatchMSet a
$cinvert :: forall a. Ord a => PatchMSet a -> PatchMSet a
$cp1Group :: forall a. Ord a => Monoid (PatchMSet a)
Group,
            ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> (PatchMSet a, PatchMSet a)
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
PatchMSet a -> PatchMSet a -> Sum Int
PatchMSet a -> PatchMSet a -> Validation
(ConflictResolution (PatchMSet a)
 -> PatchMSet a -> PatchMSet a -> (PatchMSet a, PatchMSet a))
-> (ConflictResolution (PatchMSet a)
    -> PatchMSet a -> PatchMSet a -> PatchMSet a)
-> (ConflictResolution (PatchMSet a)
    -> PatchMSet a -> PatchMSet a -> PatchMSet a)
-> (PatchMSet a -> PatchMSet a -> Validation)
-> (PatchMSet a -> PatchMSet a -> Sum Int)
-> Transformable (PatchMSet a)
forall a.
Ord a =>
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> (PatchMSet a, PatchMSet a)
forall a.
Ord a =>
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
forall a. Ord a => PatchMSet a -> PatchMSet a -> Sum Int
forall a. Ord a => PatchMSet a -> PatchMSet a -> Validation
forall p.
(ConflictResolution p -> p -> p -> (p, p))
-> (ConflictResolution p -> p -> p -> p)
-> (ConflictResolution p -> p -> p -> p)
-> (p -> p -> Validation)
-> (p -> p -> Sum Int)
-> Transformable p
conflicts :: PatchMSet a -> PatchMSet a -> Sum Int
$cconflicts :: forall a. Ord a => PatchMSet a -> PatchMSet a -> Sum Int
transformable :: PatchMSet a -> PatchMSet a -> Validation
$ctransformable :: forall a. Ord a => PatchMSet a -> PatchMSet a -> Validation
transformSnd :: ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
$ctransformSnd :: forall a.
Ord a =>
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
transformFst :: ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
$ctransformFst :: forall a.
Ord a =>
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> PatchMSet a
transformWith :: ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> (PatchMSet a, PatchMSet a)
$ctransformWith :: forall a.
Ord a =>
ConflictResolution (PatchMSet a)
-> PatchMSet a -> PatchMSet a -> (PatchMSet a, PatchMSet a)
Transformable, Monoid (PatchMSet a)
Monoid (PatchMSet a)
-> (PatchMSet a -> PatchMSet a -> Validation)
-> Composable (PatchMSet a)
PatchMSet a -> PatchMSet a -> Validation
forall a. Ord a => Monoid (PatchMSet a)
forall a. Ord a => PatchMSet a -> PatchMSet a -> Validation
forall a. Monoid a -> (a -> a -> Validation) -> Composable a
composable :: PatchMSet a -> PatchMSet a -> Validation
$ccomposable :: forall a. Ord a => PatchMSet a -> PatchMSet a -> Validation
$cp1Composable :: forall a. Ord a => Monoid (PatchMSet a)
Composable)

unPatchMSet :: PatchMSet a -> PatchMap a AddRem
unPatchMSet :: PatchMSet a -> PatchMap a AddRem
unPatchMSet (PatchMSet PatchMap a AddRem
a) = PatchMap a AddRem
a

type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a

instance (Serialise a, Ord a) => Serialise (PatchMap a AddRem)
instance (Serialise a, Ord a) => Serialise (PatchMSet a)

-- TODO this breaks module abstraction
makePrisms ''PM.PatchMap

makePrisms ''PatchMSet

_PatchMSetIso :: Ord a => Iso' (PatchMSet a) (PatchSet a)
_PatchMSetIso :: Iso' (PatchMSet a) (PatchSet a)
_PatchMSetIso = p (PatchMap a AddRem) (f (PatchMap a AddRem))
-> p (PatchMSet a) (f (PatchMSet a))
forall a a.
Iso
  (PatchMSet a) (PatchMSet a) (PatchMap a AddRem) (PatchMap a AddRem)
_PatchMSet (p (PatchMap a AddRem) (f (PatchMap a AddRem))
 -> p (PatchMSet a) (f (PatchMSet a)))
-> (p (PatchSet a) (f (PatchSet a))
    -> p (PatchMap a AddRem) (f (PatchMap a AddRem)))
-> p (PatchSet a) (f (PatchSet a))
-> p (PatchMSet a) (f (PatchMSet a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Map a AddRem) (f (Map a AddRem))
-> p (PatchMap a AddRem) (f (PatchMap a AddRem))
forall k pv k pv.
Iso (PatchMap k pv) (PatchMap k pv) (Map k pv) (Map k pv)
_PatchMap (p (Map a AddRem) (f (Map a AddRem))
 -> p (PatchMap a AddRem) (f (PatchMap a AddRem)))
-> (p (PatchSet a) (f (PatchSet a))
    -> p (Map a AddRem) (f (Map a AddRem)))
-> p (PatchSet a) (f (PatchSet a))
-> p (PatchMap a AddRem) (f (PatchMap a AddRem))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a AddRem -> (Set a, Set a))
-> ((Set a, Set a) -> Map a AddRem)
-> Iso (Map a AddRem) (Map a AddRem) (Set a, Set a) (Set a, Set a)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Map a AddRem -> (Set a, Set a)
forall a. Ord a => Map a AddRem -> (Set a, Set a)
f (Set a, Set a) -> Map a AddRem
forall a. Ord a => (Set a, Set a) -> Map a AddRem
g (p (Set a, Set a) (f (Set a, Set a))
 -> p (Map a AddRem) (f (Map a AddRem)))
-> (p (PatchSet a) (f (PatchSet a))
    -> p (Set a, Set a) (f (Set a, Set a)))
-> p (PatchSet a) (f (PatchSet a))
-> p (Map a AddRem) (f (Map a AddRem))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (PatchSet a) (PatchSet a) (Set a, Set a) (Set a, Set a)
-> Iso (Set a, Set a) (Set a, Set a) (PatchSet a) (PatchSet a)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (PatchSet a) (PatchSet a) (Set a, Set a) (Set a, Set a)
forall a a.
Iso (PatchSet a) (PatchSet a) (Set a, Set a) (Set a, Set a)
_PatchSet
  where
    f :: Ord a => Map a (Replace (Maybe ())) -> (Set a, Set a)
    f :: Map a AddRem -> (Set a, Set a)
f = (AddRem -> Bool) -> Map a AddRem -> (Map a AddRem, Map a AddRem)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition AddRem -> Bool
isRem (Map a AddRem -> (Map a AddRem, Map a AddRem))
-> ((Map a AddRem, Map a AddRem) -> (Set a, Set a))
-> Map a AddRem
-> (Set a, Set a)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Map a AddRem -> Identity (Set a))
-> (Map a AddRem, Map a AddRem) -> Identity (Set a, Set a)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both ((Map a AddRem -> Identity (Set a))
 -> (Map a AddRem, Map a AddRem) -> Identity (Set a, Set a))
-> (Map a AddRem -> Set a)
-> (Map a AddRem, Map a AddRem)
-> (Set a, Set a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map a AddRem -> Set a
forall k a. Map k a -> Set k
Map.keysSet

    g :: Ord a => (Set a, Set a) -> Map a (Replace (Maybe ()))
    g :: (Set a, Set a) -> Map a AddRem
g (Set a
rems, Set a
adds) = (a -> AddRem) -> Set a -> Map a AddRem
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (AddRem -> a -> AddRem
forall a b. a -> b -> a
const AddRem
remPatch) Set a
rems
                  Map a AddRem -> Map a AddRem -> Map a AddRem
forall a. Semigroup a => a -> a -> a
<> (a -> AddRem) -> Set a -> Map a AddRem
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (AddRem -> a -> AddRem
forall a b. a -> b -> a
const AddRem
addPatch) Set a
adds

instance Ord a => Action (PatchMSet a) (MSet a) where
  act :: PatchMSet a -> MSet a -> MSet a
act (PatchMSet PatchMap a AddRem
p) (MSet Map a ()
m) = Map a () -> MSet a
forall a. Map a () -> MSet a
MSet (Map a () -> MSet a) -> Map a () -> MSet a
forall a b. (a -> b) -> a -> b
$ PatchMap a AddRem -> Map a () -> Map a ()
forall m s. Action m s => m -> s -> s
act PatchMap a AddRem
p Map a ()
m

instance Ord a => Applicable (PatchMSet a) (MSet a) where
  applicable :: PatchMSet a -> MSet a -> Validation
applicable (PatchMSet PatchMap a AddRem
p) (MSet Map a ()
m) = PatchMap a AddRem -> Map a () -> Validation
forall p a. Applicable p a => p -> a -> Validation
applicable PatchMap a AddRem
p Map a ()
m

instance (Ord a, ToJSON a) => ToJSON (PatchMSet a) where
  toJSON :: PatchMSet a -> Value
toJSON     = PatchSet a -> Value
forall a. ToJSON a => a -> Value
toJSON (PatchSet a -> Value)
-> (PatchMSet a -> PatchSet a) -> PatchMSet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (PatchSet a) (PatchMSet a) (PatchSet a)
-> PatchMSet a -> PatchSet a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (PatchSet a) (PatchMSet a) (PatchSet a)
forall a. Ord a => Iso' (PatchMSet a) (PatchSet a)
_PatchMSetIso
  toEncoding :: PatchMSet a -> Encoding
toEncoding = PatchSet a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (PatchSet a -> Encoding)
-> (PatchMSet a -> PatchSet a) -> PatchMSet a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (PatchSet a) (PatchMSet a) (PatchSet a)
-> PatchMSet a -> PatchSet a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (PatchSet a) (PatchMSet a) (PatchSet a)
forall a. Ord a => Iso' (PatchMSet a) (PatchSet a)
_PatchMSetIso

instance (Ord a, FromJSON a) => FromJSON (PatchMSet a) where
  parseJSON :: Value -> Parser (PatchMSet a)
parseJSON = (PatchSet a -> PatchMSet a)
-> Parser (PatchSet a) -> Parser (PatchMSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tagged (PatchSet a) (Identity (PatchSet a))
-> Tagged (PatchMSet a) (Identity (PatchMSet a))
forall a. Ord a => Iso' (PatchMSet a) (PatchSet a)
_PatchMSetIso (Tagged (PatchSet a) (Identity (PatchSet a))
 -> Tagged (PatchMSet a) (Identity (PatchMSet a)))
-> PatchSet a -> PatchMSet a
forall t b. AReview t b -> b -> t
#) (Parser (PatchSet a) -> Parser (PatchMSet a))
-> (Value -> Parser (PatchSet a)) -> Value -> Parser (PatchMSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (PatchSet a)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
  arbitrary :: Gen (PatchMSet a)
arbitrary = (PatchMap a AddRem -> PatchMSet a
forall a. PatchMap a AddRem -> PatchMSet a
PatchMSet (PatchMap a AddRem -> PatchMSet a)
-> (Map a AddRem -> PatchMap a AddRem)
-> Map a AddRem
-> PatchMSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a AddRem -> PatchMap a AddRem
forall pv k. (Monoid pv, Eq pv) => Map k pv -> PatchMap k pv
PM.fromMap) (Map a AddRem -> PatchMSet a)
-> Gen (Map a AddRem) -> Gen (PatchMSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map a AddRem)
forall a. Arbitrary a => Gen a
arbitrary

instance ToSchema a => ToSchema (PatchMSet a) where
  -- TODO
  declareNamedSchema :: Proxy (PatchMSet a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (PatchMSet a)
_ = Text -> Proxy TODO -> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, Generic a, GToSchema (Rep a),
 GenericHasSimpleShape
   a
   "genericDeclareNamedSchemaUnrestricted"
   (GenericShape (Rep a))) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
wellNamedSchema Text
"" (Proxy TODO
forall k (t :: k). Proxy t
Proxy :: Proxy TODO)

type instance Patched (PatchMSet a) = MSet a

instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
  arbitrary :: Gen (Replace a)
arbitrary = (a -> a -> Replace a) -> (a, a) -> Replace a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Replace a
forall p a. Replaceable p a => a -> a -> p
replace ((a, a) -> Replace a) -> Gen (a, a) -> Gen (Replace a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a, a)
forall a. Arbitrary a => Gen a
arbitrary
    -- If they happen to be equal then the patch is Keep.

instance ToSchema a => ToSchema (Replace a) where
  declareNamedSchema :: Proxy (Replace a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy (Replace a)
_ :: Proxy (Replace a)) = do
    -- TODO Keep constructor is not supported here.
    Referenced Schema
aSchema <- Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Replace") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
                [ (Text
"old", Referenced Schema
aSchema)
                , (Text
"new", Referenced Schema
aSchema)
                ]
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Text
"old", Text
"new" ]

data NgramsPatch
   = NgramsPatch { NgramsPatch -> PatchMSet NgramsTerm
_patch_children :: !(PatchMSet NgramsTerm)
                 , NgramsPatch -> Replace ListType
_patch_list     :: !(Replace ListType)   -- TODO Map UserId ListType
                 }
   | NgramsReplace { NgramsPatch -> Maybe NgramsRepoElement
_patch_old :: !(Maybe NgramsRepoElement)
                   , NgramsPatch -> Maybe NgramsRepoElement
_patch_new :: !(Maybe NgramsRepoElement)
                   }
      deriving (NgramsPatch -> NgramsPatch -> Bool
(NgramsPatch -> NgramsPatch -> Bool)
-> (NgramsPatch -> NgramsPatch -> Bool) -> Eq NgramsPatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsPatch -> NgramsPatch -> Bool
$c/= :: NgramsPatch -> NgramsPatch -> Bool
== :: NgramsPatch -> NgramsPatch -> Bool
$c== :: NgramsPatch -> NgramsPatch -> Bool
Eq, Int -> NgramsPatch -> ShowS
[NgramsPatch] -> ShowS
NgramsPatch -> String
(Int -> NgramsPatch -> ShowS)
-> (NgramsPatch -> String)
-> ([NgramsPatch] -> ShowS)
-> Show NgramsPatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsPatch] -> ShowS
$cshowList :: [NgramsPatch] -> ShowS
show :: NgramsPatch -> String
$cshow :: NgramsPatch -> String
showsPrec :: Int -> NgramsPatch -> ShowS
$cshowsPrec :: Int -> NgramsPatch -> ShowS
Show, (forall x. NgramsPatch -> Rep NgramsPatch x)
-> (forall x. Rep NgramsPatch x -> NgramsPatch)
-> Generic NgramsPatch
forall x. Rep NgramsPatch x -> NgramsPatch
forall x. NgramsPatch -> Rep NgramsPatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsPatch x -> NgramsPatch
$cfrom :: forall x. NgramsPatch -> Rep NgramsPatch x
Generic)

-- The JSON encoding is untagged, this is OK since the field names are disjoints and thus the encoding is unambiguous.
-- TODO: the empty object should be accepted and treated as mempty.
deriveJSON (unPrefixUntagged "_") ''NgramsPatch
makeLenses ''NgramsPatch

-- TODO: This instance is simplified since we should either have the fields children and/or list
-- or the fields old and/or new.
instance ToSchema NgramsPatch where
  declareNamedSchema :: Proxy NgramsPatch -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy NgramsPatch
_ = do
    Referenced Schema
childrenSch <- Proxy (PatchMSet NgramsTerm)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (PatchMSet NgramsTerm)
forall k (t :: k). Proxy t
Proxy :: Proxy (PatchMSet NgramsTerm))
    Referenced Schema
listSch <- Proxy (Replace ListType)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (Replace ListType)
forall k (t :: k). Proxy t
Proxy :: Proxy (Replace ListType))
    Referenced Schema
nreSch <- Proxy NgramsRepoElement
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy NgramsRepoElement
forall k (t :: k). Proxy t
Proxy :: Proxy NgramsRepoElement)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"NgramsPatch") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindSchema)))
 -> Schema -> Identity Schema)
-> SwaggerType 'SwaggerKindSchema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindSchema
SwaggerObject
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
                [ (Text
"children", Referenced Schema
childrenSch)
                , (Text
"list",     Referenced Schema
listSch)
                , (Text
"old",      Referenced Schema
nreSch)
                , (Text
"new",      Referenced Schema
nreSch)
                ]

instance Arbitrary NgramsPatch where
  arbitrary :: Gen NgramsPatch
arbitrary = [(Int, Gen NgramsPatch)] -> Gen NgramsPatch
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
9, PatchMSet NgramsTerm -> Replace ListType -> NgramsPatch
NgramsPatch (PatchMSet NgramsTerm -> Replace ListType -> NgramsPatch)
-> Gen (PatchMSet NgramsTerm)
-> Gen (Replace ListType -> NgramsPatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PatchMSet NgramsTerm)
forall a. Arbitrary a => Gen a
arbitrary Gen (Replace ListType -> NgramsPatch)
-> Gen (Replace ListType) -> Gen NgramsPatch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ListType -> ListType -> Replace ListType
forall p a. Replaceable p a => a -> a -> p
replace (ListType -> ListType -> Replace ListType)
-> Gen ListType -> Gen (ListType -> Replace ListType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ListType
forall a. Arbitrary a => Gen a
arbitrary Gen (ListType -> Replace ListType)
-> Gen ListType -> Gen (Replace ListType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ListType
forall a. Arbitrary a => Gen a
arbitrary))
                        , (Int
1, Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
NgramsReplace (Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch)
-> Gen (Maybe NgramsRepoElement)
-> Gen (Maybe NgramsRepoElement -> NgramsPatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe NgramsRepoElement)
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe NgramsRepoElement -> NgramsPatch)
-> Gen (Maybe NgramsRepoElement) -> Gen NgramsPatch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe NgramsRepoElement)
forall a. Arbitrary a => Gen a
arbitrary)
                        ]

instance Serialise NgramsPatch
instance Serialise (Replace ListType)

instance Serialise ListType

type NgramsPatchIso =
  MaybePatch NgramsRepoElement (PairPatch (PatchMSet NgramsTerm) (Replace ListType))

_NgramsPatch :: Iso' NgramsPatch NgramsPatchIso
_NgramsPatch :: p NgramsPatchIso (f NgramsPatchIso)
-> p NgramsPatch (f NgramsPatch)
_NgramsPatch = (NgramsPatch -> NgramsPatchIso)
-> (NgramsPatchIso -> NgramsPatch)
-> Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso NgramsPatch -> NgramsPatchIso
unwrap NgramsPatchIso -> NgramsPatch
wrap
  where
    unwrap :: NgramsPatch -> NgramsPatchIso
unwrap (NgramsPatch PatchMSet NgramsTerm
c Replace ListType
l) = PairPatch (PatchMSet NgramsTerm) (Replace ListType)
-> NgramsPatchIso
forall a p. p -> MaybePatch a p
Mod (PairPatch (PatchMSet NgramsTerm) (Replace ListType)
 -> NgramsPatchIso)
-> PairPatch (PatchMSet NgramsTerm) (Replace ListType)
-> NgramsPatchIso
forall a b. (a -> b) -> a -> b
$ (PatchMSet NgramsTerm, Replace ListType)
-> PairPatch (PatchMSet NgramsTerm) (Replace ListType)
forall p q. (p, q) -> PairPatch p q
PairPatch (PatchMSet NgramsTerm
c, Replace ListType
l)
    unwrap (NgramsReplace Maybe NgramsRepoElement
o Maybe NgramsRepoElement
n) = Maybe NgramsRepoElement
-> Maybe NgramsRepoElement -> NgramsPatchIso
forall p a. Replaceable p a => a -> a -> p
replace Maybe NgramsRepoElement
o Maybe NgramsRepoElement
n
    wrap :: NgramsPatchIso -> NgramsPatch
wrap NgramsPatchIso
x =
      case NgramsPatchIso
-> Maybe (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
forall a p. MaybePatch a p -> Maybe p
unMod NgramsPatchIso
x of
        Just (PairPatch (PatchMSet NgramsTerm
c, Replace ListType
l)) -> PatchMSet NgramsTerm -> Replace ListType -> NgramsPatch
NgramsPatch PatchMSet NgramsTerm
c Replace ListType
l
        Maybe (PairPatch (PatchMSet NgramsTerm) (Replace ListType))
Nothing -> Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
NgramsReplace (NgramsPatchIso
x NgramsPatchIso
-> Getting
     (First NgramsRepoElement) NgramsPatchIso NgramsRepoElement
-> Maybe NgramsRepoElement
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe NgramsRepoElement
 -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
-> NgramsPatchIso -> Const (First NgramsRepoElement) NgramsPatchIso
forall p a. Replaceable p a => Traversal' p a
old ((Maybe NgramsRepoElement
  -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
 -> NgramsPatchIso
 -> Const (First NgramsRepoElement) NgramsPatchIso)
-> ((NgramsRepoElement
     -> Const (First NgramsRepoElement) NgramsRepoElement)
    -> Maybe NgramsRepoElement
    -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
-> Getting
     (First NgramsRepoElement) NgramsPatchIso NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement
 -> Const (First NgramsRepoElement) NgramsRepoElement)
-> Maybe NgramsRepoElement
-> Const (First NgramsRepoElement) (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (NgramsPatchIso
x NgramsPatchIso
-> Getting
     (First NgramsRepoElement) NgramsPatchIso NgramsRepoElement
-> Maybe NgramsRepoElement
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe NgramsRepoElement
 -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
-> NgramsPatchIso -> Const (First NgramsRepoElement) NgramsPatchIso
forall p a. Replaceable p a => Traversal' p a
new ((Maybe NgramsRepoElement
  -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
 -> NgramsPatchIso
 -> Const (First NgramsRepoElement) NgramsPatchIso)
-> ((NgramsRepoElement
     -> Const (First NgramsRepoElement) NgramsRepoElement)
    -> Maybe NgramsRepoElement
    -> Const (First NgramsRepoElement) (Maybe NgramsRepoElement))
-> Getting
     (First NgramsRepoElement) NgramsPatchIso NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement
 -> Const (First NgramsRepoElement) NgramsRepoElement)
-> Maybe NgramsRepoElement
-> Const (First NgramsRepoElement) (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)

instance Semigroup NgramsPatch where
  NgramsPatch
p <> :: NgramsPatch -> NgramsPatch -> NgramsPatch
<> NgramsPatch
q = Tagged NgramsPatchIso (Identity NgramsPatchIso)
-> Tagged NgramsPatch (Identity NgramsPatch)
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch (Tagged NgramsPatchIso (Identity NgramsPatchIso)
 -> Tagged NgramsPatch (Identity NgramsPatch))
-> NgramsPatchIso -> NgramsPatch
forall t b. AReview t b -> b -> t
# (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch NgramsPatchIso -> NgramsPatchIso -> NgramsPatchIso
forall a. Semigroup a => a -> a -> a
<> NgramsPatch
q NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

instance Monoid NgramsPatch where
  mempty :: NgramsPatch
mempty = Tagged NgramsPatchIso (Identity NgramsPatchIso)
-> Tagged NgramsPatch (Identity NgramsPatch)
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch (Tagged NgramsPatchIso (Identity NgramsPatchIso)
 -> Tagged NgramsPatch (Identity NgramsPatch))
-> NgramsPatchIso -> NgramsPatch
forall t b. AReview t b -> b -> t
# NgramsPatchIso
forall a. Monoid a => a
mempty

instance Validity NgramsPatch where
  validate :: NgramsPatch -> Validation
validate NgramsPatch
p = NgramsPatch
p NgramsPatch
-> Getting Validation NgramsPatch Validation -> Validation
forall s a. s -> Getting a s a -> a
^. (NgramsPatchIso -> Const Validation NgramsPatchIso)
-> NgramsPatch -> Const Validation NgramsPatch
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch ((NgramsPatchIso -> Const Validation NgramsPatchIso)
 -> NgramsPatch -> Const Validation NgramsPatch)
-> ((Validation -> Const Validation Validation)
    -> NgramsPatchIso -> Const Validation NgramsPatchIso)
-> Getting Validation NgramsPatch Validation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsPatchIso -> Validation)
-> (Validation -> Const Validation Validation)
-> NgramsPatchIso
-> Const Validation NgramsPatchIso
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NgramsPatchIso -> Validation
forall a. Validity a => a -> Validation
validate

instance Transformable NgramsPatch where
  transformable :: NgramsPatch -> NgramsPatch -> Validation
transformable NgramsPatch
p NgramsPatch
q = NgramsPatchIso -> NgramsPatchIso -> Validation
forall p. Transformable p => p -> p -> Validation
transformable (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch) (NgramsPatch
q NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

  conflicts :: NgramsPatch -> NgramsPatch -> Sum Int
conflicts NgramsPatch
p NgramsPatch
q = NgramsPatchIso -> NgramsPatchIso -> Sum Int
forall p. Transformable p => p -> p -> Sum Int
conflicts (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch) (NgramsPatch
q NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

  transformWith :: ConflictResolution NgramsPatch
-> NgramsPatch -> NgramsPatch -> (NgramsPatch, NgramsPatch)
transformWith ConflictResolution NgramsPatch
conflict NgramsPatch
p NgramsPatch
q = (Tagged NgramsPatchIso (Identity NgramsPatchIso)
-> Tagged NgramsPatch (Identity NgramsPatch)
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch (Tagged NgramsPatchIso (Identity NgramsPatchIso)
 -> Tagged NgramsPatch (Identity NgramsPatch))
-> NgramsPatchIso -> NgramsPatch
forall t b. AReview t b -> b -> t
# NgramsPatchIso
p', Tagged NgramsPatchIso (Identity NgramsPatchIso)
-> Tagged NgramsPatch (Identity NgramsPatch)
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch (Tagged NgramsPatchIso (Identity NgramsPatchIso)
 -> Tagged NgramsPatch (Identity NgramsPatch))
-> NgramsPatchIso -> NgramsPatch
forall t b. AReview t b -> b -> t
# NgramsPatchIso
q')
    where
      (NgramsPatchIso
p', NgramsPatchIso
q') = ConflictResolution NgramsPatchIso
-> NgramsPatchIso
-> NgramsPatchIso
-> (NgramsPatchIso, NgramsPatchIso)
forall p.
Transformable p =>
ConflictResolution p -> p -> p -> (p, p)
transformWith ConflictResolution NgramsPatchIso
ConflictResolution NgramsPatch
conflict (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch) (NgramsPatch
q NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

type ConflictResolutionNgramsPatch =
  ( ConflictResolutionReplace (Maybe NgramsRepoElement)
  , ( ConflictResolutionPatchMSet NgramsTerm
    , ConflictResolutionReplace ListType
    )
  , (Bool, Bool)
  )
type instance ConflictResolution NgramsPatch =
  ConflictResolutionNgramsPatch

type PatchedNgramsPatch = Maybe NgramsRepoElement
type instance Patched NgramsPatch = PatchedNgramsPatch

instance Applicable (PairPatch (PatchMSet NgramsTerm) (Replace ListType)) NgramsRepoElement where
  applicable :: PairPatch (PatchMSet NgramsTerm) (Replace ListType)
-> NgramsRepoElement -> Validation
applicable (PairPatch (PatchMSet NgramsTerm
c, Replace ListType
l)) NgramsRepoElement
n = PatchMSet NgramsTerm -> MSet NgramsTerm -> Validation
forall p a. Applicable p a => p -> a -> Validation
applicable PatchMSet NgramsTerm
c (NgramsRepoElement
n NgramsRepoElement
-> Getting (MSet NgramsTerm) NgramsRepoElement (MSet NgramsTerm)
-> MSet NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting (MSet NgramsTerm) NgramsRepoElement (MSet NgramsTerm)
Lens' NgramsRepoElement (MSet NgramsTerm)
nre_children) Validation -> Validation -> Validation
forall a. Semigroup a => a -> a -> a
<> Replace ListType -> ListType -> Validation
forall p a. Applicable p a => p -> a -> Validation
applicable Replace ListType
l (NgramsRepoElement
n NgramsRepoElement
-> Getting ListType NgramsRepoElement ListType -> ListType
forall s a. s -> Getting a s a -> a
^. Getting ListType NgramsRepoElement ListType
Lens' NgramsRepoElement ListType
nre_list)

instance Action (PairPatch (PatchMSet NgramsTerm) (Replace ListType)) NgramsRepoElement where
  act :: PairPatch (PatchMSet NgramsTerm) (Replace ListType)
-> NgramsRepoElement -> NgramsRepoElement
act (PairPatch (PatchMSet NgramsTerm
c, Replace ListType
l)) = ((MSet NgramsTerm -> Identity (MSet NgramsTerm))
-> NgramsRepoElement -> Identity NgramsRepoElement
Lens' NgramsRepoElement (MSet NgramsTerm)
nre_children ((MSet NgramsTerm -> Identity (MSet NgramsTerm))
 -> NgramsRepoElement -> Identity NgramsRepoElement)
-> (MSet NgramsTerm -> MSet NgramsTerm)
-> NgramsRepoElement
-> NgramsRepoElement
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PatchMSet NgramsTerm -> MSet NgramsTerm -> MSet NgramsTerm
forall m s. Action m s => m -> s -> s
act PatchMSet NgramsTerm
c)
                         (NgramsRepoElement -> NgramsRepoElement)
-> (NgramsRepoElement -> NgramsRepoElement)
-> NgramsRepoElement
-> NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ListType -> Identity ListType)
-> NgramsRepoElement -> Identity NgramsRepoElement
Lens' NgramsRepoElement ListType
nre_list     ((ListType -> Identity ListType)
 -> NgramsRepoElement -> Identity NgramsRepoElement)
-> (ListType -> ListType) -> NgramsRepoElement -> NgramsRepoElement
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Replace ListType -> ListType -> ListType
forall m s. Action m s => m -> s -> s
act Replace ListType
l)

instance Applicable NgramsPatch (Maybe NgramsRepoElement) where
  applicable :: NgramsPatch -> Maybe NgramsRepoElement -> Validation
applicable NgramsPatch
p = NgramsPatchIso -> Maybe NgramsRepoElement -> Validation
forall p a. Applicable p a => p -> a -> Validation
applicable (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

instance Action NgramsPatch (Maybe NgramsRepoElement) where
  act :: NgramsPatch -> Maybe NgramsRepoElement -> Maybe NgramsRepoElement
act NgramsPatch
p = NgramsPatchIso
-> Maybe NgramsRepoElement -> Maybe NgramsRepoElement
forall m s. Action m s => m -> s -> s
act (NgramsPatch
p NgramsPatch
-> Getting NgramsPatchIso NgramsPatch NgramsPatchIso
-> NgramsPatchIso
forall s a. s -> Getting a s a -> a
^. Getting NgramsPatchIso NgramsPatch NgramsPatchIso
Iso NgramsPatch NgramsPatch NgramsPatchIso NgramsPatchIso
_NgramsPatch)

newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
  deriving (NgramsTablePatch -> NgramsTablePatch -> Bool
(NgramsTablePatch -> NgramsTablePatch -> Bool)
-> (NgramsTablePatch -> NgramsTablePatch -> Bool)
-> Eq NgramsTablePatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NgramsTablePatch -> NgramsTablePatch -> Bool
$c/= :: NgramsTablePatch -> NgramsTablePatch -> Bool
== :: NgramsTablePatch -> NgramsTablePatch -> Bool
$c== :: NgramsTablePatch -> NgramsTablePatch -> Bool
Eq, Int -> NgramsTablePatch -> ShowS
[NgramsTablePatch] -> ShowS
NgramsTablePatch -> String
(Int -> NgramsTablePatch -> ShowS)
-> (NgramsTablePatch -> String)
-> ([NgramsTablePatch] -> ShowS)
-> Show NgramsTablePatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NgramsTablePatch] -> ShowS
$cshowList :: [NgramsTablePatch] -> ShowS
show :: NgramsTablePatch -> String
$cshow :: NgramsTablePatch -> String
showsPrec :: Int -> NgramsTablePatch -> ShowS
$cshowsPrec :: Int -> NgramsTablePatch -> ShowS
Show, (forall x. NgramsTablePatch -> Rep NgramsTablePatch x)
-> (forall x. Rep NgramsTablePatch x -> NgramsTablePatch)
-> Generic NgramsTablePatch
forall x. Rep NgramsTablePatch x -> NgramsTablePatch
forall x. NgramsTablePatch -> Rep NgramsTablePatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NgramsTablePatch x -> NgramsTablePatch
$cfrom :: forall x. NgramsTablePatch -> Rep NgramsTablePatch x
Generic, [NgramsTablePatch] -> Encoding
[NgramsTablePatch] -> Value
NgramsTablePatch -> Encoding
NgramsTablePatch -> Value
(NgramsTablePatch -> Value)
-> (NgramsTablePatch -> Encoding)
-> ([NgramsTablePatch] -> Value)
-> ([NgramsTablePatch] -> Encoding)
-> ToJSON NgramsTablePatch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NgramsTablePatch] -> Encoding
$ctoEncodingList :: [NgramsTablePatch] -> Encoding
toJSONList :: [NgramsTablePatch] -> Value
$ctoJSONList :: [NgramsTablePatch] -> Value
toEncoding :: NgramsTablePatch -> Encoding
$ctoEncoding :: NgramsTablePatch -> Encoding
toJSON :: NgramsTablePatch -> Value
$ctoJSON :: NgramsTablePatch -> Value
ToJSON, Value -> Parser [NgramsTablePatch]
Value -> Parser NgramsTablePatch
(Value -> Parser NgramsTablePatch)
-> (Value -> Parser [NgramsTablePatch])
-> FromJSON NgramsTablePatch
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NgramsTablePatch]
$cparseJSONList :: Value -> Parser [NgramsTablePatch]
parseJSON :: Value -> Parser NgramsTablePatch
$cparseJSON :: Value -> Parser NgramsTablePatch
FromJSON, b -> NgramsTablePatch -> NgramsTablePatch
NonEmpty NgramsTablePatch -> NgramsTablePatch
NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
(NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch)
-> (NonEmpty NgramsTablePatch -> NgramsTablePatch)
-> (forall b.
    Integral b =>
    b -> NgramsTablePatch -> NgramsTablePatch)
-> Semigroup NgramsTablePatch
forall b. Integral b => b -> NgramsTablePatch -> NgramsTablePatch
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> NgramsTablePatch -> NgramsTablePatch
$cstimes :: forall b. Integral b => b -> NgramsTablePatch -> NgramsTablePatch
sconcat :: NonEmpty NgramsTablePatch -> NgramsTablePatch
$csconcat :: NonEmpty NgramsTablePatch -> NgramsTablePatch
<> :: NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
$c<> :: NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
Semigroup, Semigroup NgramsTablePatch
NgramsTablePatch
Semigroup NgramsTablePatch
-> NgramsTablePatch
-> (NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch)
-> ([NgramsTablePatch] -> NgramsTablePatch)
-> Monoid NgramsTablePatch
[NgramsTablePatch] -> NgramsTablePatch
NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [NgramsTablePatch] -> NgramsTablePatch
$cmconcat :: [NgramsTablePatch] -> NgramsTablePatch
mappend :: NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
$cmappend :: NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
mempty :: NgramsTablePatch
$cmempty :: NgramsTablePatch
$cp1Monoid :: Semigroup NgramsTablePatch
Monoid, NgramsTablePatch -> Validation
(NgramsTablePatch -> Validation) -> Validity NgramsTablePatch
forall a. (a -> Validation) -> Validity a
validate :: NgramsTablePatch -> Validation
$cvalidate :: NgramsTablePatch -> Validation
Validity, ConflictResolution NgramsTablePatch
-> NgramsTablePatch
-> NgramsTablePatch
-> (NgramsTablePatch, NgramsTablePatch)
ConflictResolution NgramsTablePatch
-> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
NgramsTablePatch -> NgramsTablePatch -> Sum Int
NgramsTablePatch -> NgramsTablePatch -> Validation
(ConflictResolution NgramsTablePatch
 -> NgramsTablePatch
 -> NgramsTablePatch
 -> (NgramsTablePatch, NgramsTablePatch))
-> (ConflictResolution NgramsTablePatch
    -> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch)
-> (ConflictResolution NgramsTablePatch
    -> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch)
-> (NgramsTablePatch -> NgramsTablePatch -> Validation)
-> (NgramsTablePatch -> NgramsTablePatch -> Sum Int)
-> Transformable NgramsTablePatch
forall p.
(ConflictResolution p -> p -> p -> (p, p))
-> (ConflictResolution p -> p -> p -> p)
-> (ConflictResolution p -> p -> p -> p)
-> (p -> p -> Validation)
-> (p -> p -> Sum Int)
-> Transformable p
conflicts :: NgramsTablePatch -> NgramsTablePatch -> Sum Int
$cconflicts :: NgramsTablePatch -> NgramsTablePatch -> Sum Int
transformable :: NgramsTablePatch -> NgramsTablePatch -> Validation
$ctransformable :: NgramsTablePatch -> NgramsTablePatch -> Validation
transformSnd :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
$ctransformSnd :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
transformFst :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
$ctransformFst :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch -> NgramsTablePatch -> NgramsTablePatch
transformWith :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch
-> NgramsTablePatch
-> (NgramsTablePatch, NgramsTablePatch)
$ctransformWith :: ConflictResolution NgramsTablePatch
-> NgramsTablePatch
-> NgramsTablePatch
-> (NgramsTablePatch, NgramsTablePatch)
Transformable)

instance Serialise NgramsTablePatch
instance Serialise (PatchMap NgramsTerm NgramsPatch)

instance FromField NgramsTablePatch
  where
    fromField :: FieldParser NgramsTablePatch
fromField = FieldParser NgramsTablePatch
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

instance FromField (PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch))
  where
    fromField :: FieldParser
  (PatchMap NgramsType (PatchMap NodeId NgramsTablePatch))
fromField = FieldParser
  (PatchMap NgramsType (PatchMap NodeId NgramsTablePatch))
forall b.
(Typeable b, FromJSON b) =>
Field -> Maybe ByteString -> Conversion b
fromField'

type instance ConflictResolution NgramsTablePatch =
  NgramsTerm -> ConflictResolutionNgramsPatch


type PatchedNgramsTablePatch = Map NgramsTerm PatchedNgramsPatch
  -- ~ Patched (PatchMap NgramsTerm NgramsPatch)
type instance Patched NgramsTablePatch = PatchedNgramsTablePatch

makePrisms ''NgramsTablePatch
instance ToSchema  (PatchMap NgramsTerm NgramsPatch)
instance ToSchema  NgramsTablePatch

instance Applicable NgramsTablePatch (Maybe NgramsTableMap) where
  applicable :: NgramsTablePatch -> Maybe NgramsTableMap -> Validation
applicable NgramsTablePatch
p = PatchMap NgramsTerm NgramsPatch
-> Maybe NgramsTableMap -> Validation
forall p a. Applicable p a => p -> a -> Validation
applicable (NgramsTablePatch
p NgramsTablePatch
-> Getting
     (PatchMap NgramsTerm NgramsPatch)
     NgramsTablePatch
     (PatchMap NgramsTerm NgramsPatch)
-> PatchMap NgramsTerm NgramsPatch
forall s a. s -> Getting a s a -> a
^. Getting
  (PatchMap NgramsTerm NgramsPatch)
  NgramsTablePatch
  (PatchMap NgramsTerm NgramsPatch)
Iso' NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
_NgramsTablePatch)


ngramsElementToRepo :: NgramsElement -> NgramsRepoElement
ngramsElementToRepo :: NgramsElement -> NgramsRepoElement
ngramsElementToRepo
  (NgramsElement { _ne_size :: NgramsElement -> Int
_ne_size     = Int
s
                 , _ne_list :: NgramsElement -> ListType
_ne_list     = ListType
l
                 , _ne_root :: NgramsElement -> Maybe NgramsTerm
_ne_root     = Maybe NgramsTerm
r
                 , _ne_parent :: NgramsElement -> Maybe NgramsTerm
_ne_parent   = Maybe NgramsTerm
p
                 , _ne_children :: NgramsElement -> MSet NgramsTerm
_ne_children = MSet NgramsTerm
c
                 }) =
  NgramsRepoElement :: Int
-> ListType
-> Maybe NgramsTerm
-> Maybe NgramsTerm
-> MSet NgramsTerm
-> NgramsRepoElement
NgramsRepoElement
    { _nre_size :: Int
_nre_size     = Int
s
    , _nre_list :: ListType
_nre_list     = ListType
l
    , _nre_parent :: Maybe NgramsTerm
_nre_parent   = Maybe NgramsTerm
p
    , _nre_root :: Maybe NgramsTerm
_nre_root     = Maybe NgramsTerm
r
    , _nre_children :: MSet NgramsTerm
_nre_children = MSet NgramsTerm
c
    }

ngramsElementFromRepo :: NgramsTerm -> NgramsRepoElement -> NgramsElement
ngramsElementFromRepo :: NgramsTerm -> NgramsRepoElement -> NgramsElement
ngramsElementFromRepo
  NgramsTerm
ngrams
  (NgramsRepoElement
      { _nre_size :: NgramsRepoElement -> Int
_nre_size     = Int
s
      , _nre_list :: NgramsRepoElement -> ListType
_nre_list     = ListType
l
      , _nre_parent :: NgramsRepoElement -> Maybe NgramsTerm
_nre_parent   = Maybe NgramsTerm
p
      , _nre_root :: NgramsRepoElement -> Maybe NgramsTerm
_nre_root     = Maybe NgramsTerm
r
      , _nre_children :: NgramsRepoElement -> MSet NgramsTerm
_nre_children = MSet NgramsTerm
c
      }) =
  NgramsElement :: NgramsTerm
-> Int
-> ListType
-> Int
-> Maybe NgramsTerm
-> Maybe NgramsTerm
-> MSet NgramsTerm
-> NgramsElement
NgramsElement { _ne_size :: Int
_ne_size        = Int
s
                , _ne_list :: ListType
_ne_list        = ListType
l
                , _ne_root :: Maybe NgramsTerm
_ne_root        = Maybe NgramsTerm
r
                , _ne_parent :: Maybe NgramsTerm
_ne_parent      = Maybe NgramsTerm
p
                , _ne_children :: MSet NgramsTerm
_ne_children    = MSet NgramsTerm
c
                , _ne_ngrams :: NgramsTerm
_ne_ngrams      = NgramsTerm
ngrams
                , _ne_occurrences :: Int
_ne_occurrences = Text -> Int
forall a. HasCallStack => Text -> a
panic (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
"API.Ngrams.Types._ne_occurrences"
                {-
                -- Here we could use 0 if we want to avoid any `panic`.
                -- It will not happen using getTableNgrams if
                -- getOccByNgramsOnly provides a count of occurrences for
                -- all the ngrams given.
                -}
                }

reRootChildren :: NgramsTerm -> ReParent NgramsTerm
reRootChildren :: NgramsTerm -> ReParent NgramsTerm
reRootChildren NgramsTerm
root NgramsTerm
ngram = do
  Maybe NgramsRepoElement
nre <- Getting
  (Maybe NgramsRepoElement) NgramsTableMap (Maybe NgramsRepoElement)
-> m (Maybe NgramsRepoElement)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (Maybe NgramsRepoElement) NgramsTableMap (Maybe NgramsRepoElement)
 -> m (Maybe NgramsRepoElement))
-> Getting
     (Maybe NgramsRepoElement) NgramsTableMap (Maybe NgramsRepoElement)
-> m (Maybe NgramsRepoElement)
forall a b. (a -> b) -> a -> b
$ Index NgramsTableMap
-> Lens' NgramsTableMap (Maybe (IxValue NgramsTableMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsTableMap
NgramsTerm
ngram
  Getting (Traversed () m) (Maybe NgramsRepoElement) NgramsTerm
-> Maybe NgramsRepoElement -> (NgramsTerm -> m ()) -> m ()
forall (f :: * -> *) r s a.
Functor f =>
Getting (Traversed r f) s a -> s -> (a -> f r) -> f ()
forOf_ ((NgramsRepoElement -> Const (Traversed () m) NgramsRepoElement)
-> Maybe NgramsRepoElement
-> Const (Traversed () m) (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((NgramsRepoElement -> Const (Traversed () m) NgramsRepoElement)
 -> Maybe NgramsRepoElement
 -> Const (Traversed () m) (Maybe NgramsRepoElement))
-> ((NgramsTerm -> Const (Traversed () m) NgramsTerm)
    -> NgramsRepoElement -> Const (Traversed () m) NgramsRepoElement)
-> Getting (Traversed () m) (Maybe NgramsRepoElement) NgramsTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MSet NgramsTerm -> Const (Traversed () m) (MSet NgramsTerm))
-> NgramsRepoElement -> Const (Traversed () m) NgramsRepoElement
Lens' NgramsRepoElement (MSet NgramsTerm)
nre_children ((MSet NgramsTerm -> Const (Traversed () m) (MSet NgramsTerm))
 -> NgramsRepoElement -> Const (Traversed () m) NgramsRepoElement)
-> ((NgramsTerm -> Const (Traversed () m) NgramsTerm)
    -> MSet NgramsTerm -> Const (Traversed () m) (MSet NgramsTerm))
-> (NgramsTerm -> Const (Traversed () m) NgramsTerm)
-> NgramsRepoElement
-> Const (Traversed () m) NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> Const (Traversed () m) NgramsTerm)
-> MSet NgramsTerm -> Const (Traversed () m) (MSet NgramsTerm)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) Maybe NgramsRepoElement
nre ((NgramsTerm -> m ()) -> m ()) -> (NgramsTerm -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \NgramsTerm
child -> do
    Index NgramsTableMap
-> Lens' NgramsTableMap (Maybe (IxValue NgramsTableMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsTableMap
NgramsTerm
child ((Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement))
 -> NgramsTableMap -> Identity NgramsTableMap)
-> ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
    -> Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement))
-> (Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
-> NgramsTableMap
-> Identity NgramsTableMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement -> Identity NgramsRepoElement)
-> Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((NgramsRepoElement -> Identity NgramsRepoElement)
 -> Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement))
-> ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
    -> NgramsRepoElement -> Identity NgramsRepoElement)
-> (Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
-> Maybe NgramsRepoElement
-> Identity (Maybe NgramsRepoElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
-> NgramsRepoElement -> Identity NgramsRepoElement
Lens' NgramsRepoElement (Maybe NgramsTerm)
nre_root ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
 -> NgramsTableMap -> Identity NgramsTableMap)
-> NgramsTerm -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= NgramsTerm
root
    NgramsTerm -> NgramsTerm -> m ()
NgramsTerm -> ReParent NgramsTerm
reRootChildren NgramsTerm
root NgramsTerm
child

reParent :: Maybe RootParent -> ReParent NgramsTerm
reParent :: Maybe RootParent -> ReParent NgramsTerm
reParent Maybe RootParent
rp NgramsTerm
child = do
  Index NgramsTableMap
-> Lens' NgramsTableMap (Maybe (IxValue NgramsTableMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsTableMap
NgramsTerm
child ((Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement))
 -> NgramsTableMap -> Identity NgramsTableMap)
-> ((NgramsRepoElement -> Identity NgramsRepoElement)
    -> Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement))
-> (NgramsRepoElement -> Identity NgramsRepoElement)
-> NgramsTableMap
-> Identity NgramsTableMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement -> Identity NgramsRepoElement)
-> Maybe NgramsRepoElement -> Identity (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((NgramsRepoElement -> Identity NgramsRepoElement)
 -> NgramsTableMap -> Identity NgramsTableMap)
-> (NgramsRepoElement -> NgramsRepoElement) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ( ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
-> NgramsRepoElement -> Identity NgramsRepoElement
Lens' NgramsRepoElement (Maybe NgramsTerm)
nre_parent ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
 -> NgramsRepoElement -> Identity NgramsRepoElement)
-> Maybe NgramsTerm -> NgramsRepoElement -> NgramsRepoElement
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (RootParent -> NgramsTerm
_rp_parent (RootParent -> NgramsTerm) -> Maybe RootParent -> Maybe NgramsTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RootParent
rp))
                      (NgramsRepoElement -> NgramsRepoElement)
-> (NgramsRepoElement -> NgramsRepoElement)
-> NgramsRepoElement
-> NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
-> NgramsRepoElement -> Identity NgramsRepoElement
Lens' NgramsRepoElement (Maybe NgramsTerm)
nre_root   ((Maybe NgramsTerm -> Identity (Maybe NgramsTerm))
 -> NgramsRepoElement -> Identity NgramsRepoElement)
-> Maybe NgramsTerm -> NgramsRepoElement -> NgramsRepoElement
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (RootParent -> NgramsTerm
_rp_root   (RootParent -> NgramsTerm) -> Maybe RootParent -> Maybe NgramsTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RootParent
rp))
                      )
  NgramsTerm -> NgramsTerm -> m ()
NgramsTerm -> ReParent NgramsTerm
reRootChildren (NgramsTerm -> Maybe NgramsTerm -> NgramsTerm
forall a. a -> Maybe a -> a
fromMaybe NgramsTerm
child (Maybe RootParent
rp Maybe RootParent
-> Getting (First NgramsTerm) (Maybe RootParent) NgramsTerm
-> Maybe NgramsTerm
forall s a. s -> Getting (First a) s a -> Maybe a
^? (RootParent -> Const (First NgramsTerm) RootParent)
-> Maybe RootParent -> Const (First NgramsTerm) (Maybe RootParent)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((RootParent -> Const (First NgramsTerm) RootParent)
 -> Maybe RootParent -> Const (First NgramsTerm) (Maybe RootParent))
-> ((NgramsTerm -> Const (First NgramsTerm) NgramsTerm)
    -> RootParent -> Const (First NgramsTerm) RootParent)
-> Getting (First NgramsTerm) (Maybe RootParent) NgramsTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> Const (First NgramsTerm) NgramsTerm)
-> RootParent -> Const (First NgramsTerm) RootParent
Lens' RootParent NgramsTerm
rp_root)) NgramsTerm
child

reParentAddRem :: RootParent -> NgramsTerm -> ReParent AddRem
reParentAddRem :: RootParent -> NgramsTerm -> ReParent AddRem
reParentAddRem RootParent
rp NgramsTerm
child AddRem
p =
  Maybe RootParent -> NgramsTerm -> m ()
Maybe RootParent -> ReParent NgramsTerm
reParent (if AddRem -> Bool
isRem AddRem
p then Maybe RootParent
forall a. Maybe a
Nothing else RootParent -> Maybe RootParent
forall a. a -> Maybe a
Just RootParent
rp) NgramsTerm
child

reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
reParentNgramsPatch NgramsTerm
parent NgramsPatch
ngramsPatch = do
  Maybe NgramsTerm
root_of_parent <- Getting (Maybe NgramsTerm) NgramsTableMap (Maybe NgramsTerm)
-> m (Maybe NgramsTerm)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Index NgramsTableMap
-> Lens' NgramsTableMap (Maybe (IxValue NgramsTableMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsTableMap
NgramsTerm
parent ((Maybe NgramsRepoElement
  -> Const (Maybe NgramsTerm) (Maybe NgramsRepoElement))
 -> NgramsTableMap -> Const (Maybe NgramsTerm) NgramsTableMap)
-> ((Maybe NgramsTerm
     -> Const (Maybe NgramsTerm) (Maybe NgramsTerm))
    -> Maybe NgramsRepoElement
    -> Const (Maybe NgramsTerm) (Maybe NgramsRepoElement))
-> Getting (Maybe NgramsTerm) NgramsTableMap (Maybe NgramsTerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement -> Const (Maybe NgramsTerm) NgramsRepoElement)
-> Maybe NgramsRepoElement
-> Const (Maybe NgramsTerm) (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((NgramsRepoElement -> Const (Maybe NgramsTerm) NgramsRepoElement)
 -> Maybe NgramsRepoElement
 -> Const (Maybe NgramsTerm) (Maybe NgramsRepoElement))
-> ((Maybe NgramsTerm
     -> Const (Maybe NgramsTerm) (Maybe NgramsTerm))
    -> NgramsRepoElement -> Const (Maybe NgramsTerm) NgramsRepoElement)
-> (Maybe NgramsTerm
    -> Const (Maybe NgramsTerm) (Maybe NgramsTerm))
-> Maybe NgramsRepoElement
-> Const (Maybe NgramsTerm) (Maybe NgramsRepoElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe NgramsTerm -> Const (Maybe NgramsTerm) (Maybe NgramsTerm))
-> NgramsRepoElement -> Const (Maybe NgramsTerm) NgramsRepoElement
Lens' NgramsRepoElement (Maybe NgramsTerm)
nre_root)
  let
    root :: NgramsTerm
root = NgramsTerm -> Maybe NgramsTerm -> NgramsTerm
forall a. a -> Maybe a -> a
fromMaybe NgramsTerm
parent Maybe NgramsTerm
root_of_parent
    rp :: RootParent
rp   = RootParent :: NgramsTerm -> NgramsTerm -> RootParent
RootParent { _rp_root :: NgramsTerm
_rp_root = NgramsTerm
root, _rp_parent :: NgramsTerm
_rp_parent = NgramsTerm
parent }
  (NgramsTerm -> AddRem -> m ()) -> Map NgramsTerm AddRem -> m ()
forall i (t :: * -> *) (f :: * -> *) a b.
(FoldableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f ()
itraverse_ (RootParent -> NgramsTerm -> ReParent AddRem
reParentAddRem RootParent
rp) (NgramsPatch
ngramsPatch NgramsPatch
-> Getting
     (Map NgramsTerm AddRem) NgramsPatch (Map NgramsTerm AddRem)
-> Map NgramsTerm AddRem
forall s a. s -> Getting a s a -> a
^. (PatchMSet NgramsTerm
 -> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm))
-> NgramsPatch -> Const (Map NgramsTerm AddRem) NgramsPatch
Traversal' NgramsPatch (PatchMSet NgramsTerm)
patch_children ((PatchMSet NgramsTerm
  -> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm))
 -> NgramsPatch -> Const (Map NgramsTerm AddRem) NgramsPatch)
-> ((Map NgramsTerm AddRem
     -> Const (Map NgramsTerm AddRem) (Map NgramsTerm AddRem))
    -> PatchMSet NgramsTerm
    -> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm))
-> Getting
     (Map NgramsTerm AddRem) NgramsPatch (Map NgramsTerm AddRem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchMap NgramsTerm AddRem
 -> Const (Map NgramsTerm AddRem) (PatchMap NgramsTerm AddRem))
-> PatchMSet NgramsTerm
-> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm)
forall a a.
Iso
  (PatchMSet a) (PatchMSet a) (PatchMap a AddRem) (PatchMap a AddRem)
_PatchMSet ((PatchMap NgramsTerm AddRem
  -> Const (Map NgramsTerm AddRem) (PatchMap NgramsTerm AddRem))
 -> PatchMSet NgramsTerm
 -> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm))
-> ((Map NgramsTerm AddRem
     -> Const (Map NgramsTerm AddRem) (Map NgramsTerm AddRem))
    -> PatchMap NgramsTerm AddRem
    -> Const (Map NgramsTerm AddRem) (PatchMap NgramsTerm AddRem))
-> (Map NgramsTerm AddRem
    -> Const (Map NgramsTerm AddRem) (Map NgramsTerm AddRem))
-> PatchMSet NgramsTerm
-> Const (Map NgramsTerm AddRem) (PatchMSet NgramsTerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NgramsTerm AddRem
 -> Const (Map NgramsTerm AddRem) (Map NgramsTerm AddRem))
-> PatchMap NgramsTerm AddRem
-> Const (Map NgramsTerm AddRem) (PatchMap NgramsTerm AddRem)
forall k pv k pv.
Iso (PatchMap k pv) (PatchMap k pv) (Map k pv) (Map k pv)
_PatchMap)
  -- TODO FoldableWithIndex/TraversableWithIndex for PatchMap

reParentNgramsTablePatch :: ReParent NgramsTablePatch
reParentNgramsTablePatch :: NgramsTablePatch -> m ()
reParentNgramsTablePatch NgramsTablePatch
p = (NgramsTerm -> NgramsPatch -> m ())
-> Map NgramsTerm NgramsPatch -> m ()
forall i (t :: * -> *) (f :: * -> *) a b.
(FoldableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f ()
itraverse_ NgramsTerm -> NgramsPatch -> m ()
NgramsTerm -> ReParent NgramsPatch
reParentNgramsPatch (NgramsTablePatch
p NgramsTablePatch
-> Getting
     (Map NgramsTerm NgramsPatch)
     NgramsTablePatch
     (Map NgramsTerm NgramsPatch)
-> Map NgramsTerm NgramsPatch
forall s a. s -> Getting a s a -> a
^. (PatchMap NgramsTerm NgramsPatch
 -> Const
      (Map NgramsTerm NgramsPatch) (PatchMap NgramsTerm NgramsPatch))
-> NgramsTablePatch
-> Const (Map NgramsTerm NgramsPatch) NgramsTablePatch
Iso' NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
_NgramsTablePatch((PatchMap NgramsTerm NgramsPatch
  -> Const
       (Map NgramsTerm NgramsPatch) (PatchMap NgramsTerm NgramsPatch))
 -> NgramsTablePatch
 -> Const (Map NgramsTerm NgramsPatch) NgramsTablePatch)
-> ((Map NgramsTerm NgramsPatch
     -> Const (Map NgramsTerm NgramsPatch) (Map NgramsTerm NgramsPatch))
    -> PatchMap NgramsTerm NgramsPatch
    -> Const
         (Map NgramsTerm NgramsPatch) (PatchMap NgramsTerm NgramsPatch))
-> Getting
     (Map NgramsTerm NgramsPatch)
     NgramsTablePatch
     (Map NgramsTerm NgramsPatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NgramsTerm NgramsPatch
 -> Const (Map NgramsTerm NgramsPatch) (Map NgramsTerm NgramsPatch))
-> PatchMap NgramsTerm NgramsPatch
-> Const
     (Map NgramsTerm NgramsPatch) (PatchMap NgramsTerm NgramsPatch)
forall k pv k pv.
Iso (PatchMap k pv) (PatchMap k pv) (Map k pv) (Map k pv)
_PatchMap)
  -- TODO FoldableWithIndex/TraversableWithIndex for PatchMap

------------------------------------------------------------------------

instance Action NgramsTablePatch (Maybe NgramsTableMap) where
  act :: NgramsTablePatch -> Maybe NgramsTableMap -> Maybe NgramsTableMap
act NgramsTablePatch
p =
    (NgramsTableMap -> NgramsTableMap)
-> Maybe NgramsTableMap -> Maybe NgramsTableMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (State NgramsTableMap () -> NgramsTableMap -> NgramsTableMap
forall s a. State s a -> s -> s
execState (NgramsTablePatch -> State NgramsTableMap ()
ReParent NgramsTablePatch
reParentNgramsTablePatch NgramsTablePatch
p)) (Maybe NgramsTableMap -> Maybe NgramsTableMap)
-> (Maybe NgramsTableMap -> Maybe NgramsTableMap)
-> Maybe NgramsTableMap
-> Maybe NgramsTableMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    PatchMap NgramsTerm NgramsPatch
-> Maybe NgramsTableMap -> Maybe NgramsTableMap
forall m s. Action m s => m -> s -> s
act (NgramsTablePatch
p NgramsTablePatch
-> Getting
     (PatchMap NgramsTerm NgramsPatch)
     NgramsTablePatch
     (PatchMap NgramsTerm NgramsPatch)
-> PatchMap NgramsTerm NgramsPatch
forall s a. s -> Getting a s a -> a
^. Getting
  (PatchMap NgramsTerm NgramsPatch)
  NgramsTablePatch
  (PatchMap NgramsTerm NgramsPatch)
Iso' NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
_NgramsTablePatch)

instance Arbitrary NgramsTablePatch where
  arbitrary :: Gen NgramsTablePatch
arbitrary = PatchMap NgramsTerm NgramsPatch -> NgramsTablePatch
NgramsTablePatch (PatchMap NgramsTerm NgramsPatch -> NgramsTablePatch)
-> (Map NgramsTerm NgramsPatch -> PatchMap NgramsTerm NgramsPatch)
-> Map NgramsTerm NgramsPatch
-> NgramsTablePatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map NgramsTerm NgramsPatch -> PatchMap NgramsTerm NgramsPatch
forall pv k. (Monoid pv, Eq pv) => Map k pv -> PatchMap k pv
PM.fromMap (Map NgramsTerm NgramsPatch -> NgramsTablePatch)
-> Gen (Map NgramsTerm NgramsPatch) -> Gen NgramsTablePatch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map NgramsTerm NgramsPatch)
forall a. Arbitrary a => Gen a
arbitrary

-- Should it be less than an Lens' to preserve PatchMap's abstraction.
-- ntp_ngrams_patches :: Lens' NgramsTablePatch (Map NgramsTerm NgramsPatch)
-- ntp_ngrams_patches = _NgramsTablePatch .  undefined

type ReParent a = forall m. MonadState NgramsTableMap m => a -> m ()

------------------------------------------------------------------------
type Version = Int

data Versioned a = Versioned
  { Versioned a -> Int
_v_version :: Version
  , Versioned a -> a
_v_data    :: a
  }
  deriving ((forall x. Versioned a -> Rep (Versioned a) x)
-> (forall x. Rep (Versioned a) x -> Versioned a)
-> Generic (Versioned a)
forall x. Rep (Versioned a) x -> Versioned a
forall x. Versioned a -> Rep (Versioned a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Versioned a) x -> Versioned a
forall a x. Versioned a -> Rep (Versioned a) x
$cto :: forall a x. Rep (Versioned a) x -> Versioned a
$cfrom :: forall a x. Versioned a -> Rep (Versioned a) x
Generic, Int -> Versioned a -> ShowS
[Versioned a] -> ShowS
Versioned a -> String
(Int -> Versioned a -> ShowS)
-> (Versioned a -> String)
-> ([Versioned a] -> ShowS)
-> Show (Versioned a)
forall a. Show a => Int -> Versioned a -> ShowS
forall a. Show a => [Versioned a] -> ShowS
forall a. Show a => Versioned a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Versioned a] -> ShowS
$cshowList :: forall a. Show a => [Versioned a] -> ShowS
show :: Versioned a -> String
$cshow :: forall a. Show a => Versioned a -> String
showsPrec :: Int -> Versioned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Versioned a -> ShowS
Show, Versioned a -> Versioned a -> Bool
(Versioned a -> Versioned a -> Bool)
-> (Versioned a -> Versioned a -> Bool) -> Eq (Versioned a)
forall a. Eq a => Versioned a -> Versioned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Versioned a -> Versioned a -> Bool
$c/= :: forall a. Eq a => Versioned a -> Versioned a -> Bool
== :: Versioned a -> Versioned a -> Bool
$c== :: forall a. Eq a => Versioned a -> Versioned a -> Bool
Eq)
deriveJSON (unPrefix "_v_") ''Versioned
makeLenses ''Versioned
instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
  declareNamedSchema :: Proxy (Versioned a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Text
-> Proxy (Versioned a) -> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, Generic a, GToSchema (Rep a),
 GenericHasSimpleShape
   a
   "genericDeclareNamedSchemaUnrestricted"
   (GenericShape (Rep a))) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
wellNamedSchema Text
"_v_"
instance Arbitrary a => Arbitrary (Versioned a) where
  arbitrary :: Gen (Versioned a)
arbitrary = Int -> a -> Versioned a
forall a. Int -> a -> Versioned a
Versioned Int
1 (a -> Versioned a) -> Gen a -> Gen (Versioned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary -- TODO 1 is constant so far
------------------------------------------------------------------------
type Count = Int

data VersionedWithCount a = VersionedWithCount
  { VersionedWithCount a -> Int
_vc_version :: Version
  , VersionedWithCount a -> Int
_vc_count   :: Count
  , VersionedWithCount a -> a
_vc_data    :: a
  }
  deriving ((forall x. VersionedWithCount a -> Rep (VersionedWithCount a) x)
-> (forall x. Rep (VersionedWithCount a) x -> VersionedWithCount a)
-> Generic (VersionedWithCount a)
forall x. Rep (VersionedWithCount a) x -> VersionedWithCount a
forall x. VersionedWithCount a -> Rep (VersionedWithCount a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (VersionedWithCount a) x -> VersionedWithCount a
forall a x. VersionedWithCount a -> Rep (VersionedWithCount a) x
$cto :: forall a x. Rep (VersionedWithCount a) x -> VersionedWithCount a
$cfrom :: forall a x. VersionedWithCount a -> Rep (VersionedWithCount a) x
Generic, Int -> VersionedWithCount a -> ShowS
[VersionedWithCount a] -> ShowS
VersionedWithCount a -> String
(Int -> VersionedWithCount a -> ShowS)
-> (VersionedWithCount a -> String)
-> ([VersionedWithCount a] -> ShowS)
-> Show (VersionedWithCount a)
forall a. Show a => Int -> VersionedWithCount a -> ShowS
forall a. Show a => [VersionedWithCount a] -> ShowS
forall a. Show a => VersionedWithCount a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionedWithCount a] -> ShowS
$cshowList :: forall a. Show a => [VersionedWithCount a] -> ShowS
show :: VersionedWithCount a -> String
$cshow :: forall a. Show a => VersionedWithCount a -> String
showsPrec :: Int -> VersionedWithCount a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> VersionedWithCount a -> ShowS
Show, VersionedWithCount a -> VersionedWithCount a -> Bool
(VersionedWithCount a -> VersionedWithCount a -> Bool)
-> (VersionedWithCount a -> VersionedWithCount a -> Bool)
-> Eq (VersionedWithCount a)
forall a.
Eq a =>
VersionedWithCount a -> VersionedWithCount a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionedWithCount a -> VersionedWithCount a -> Bool
$c/= :: forall a.
Eq a =>
VersionedWithCount a -> VersionedWithCount a -> Bool
== :: VersionedWithCount a -> VersionedWithCount a -> Bool
$c== :: forall a.
Eq a =>
VersionedWithCount a -> VersionedWithCount a -> Bool
Eq)
deriveJSON (unPrefix "_vc_") ''VersionedWithCount
makeLenses ''VersionedWithCount
instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
  declareNamedSchema :: Proxy (VersionedWithCount a)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Text
-> Proxy (VersionedWithCount a)
-> Declare (Definitions Schema) NamedSchema
forall a.
(Typeable a, Generic a, GToSchema (Rep a),
 GenericHasSimpleShape
   a
   "genericDeclareNamedSchemaUnrestricted"
   (GenericShape (Rep a))) =>
Text -> Proxy a -> Declare (Definitions Schema) NamedSchema
wellNamedSchema Text
"_vc_"
instance Arbitrary a => Arbitrary (VersionedWithCount a) where
  arbitrary :: Gen (VersionedWithCount a)
arbitrary = Int -> Int -> a -> VersionedWithCount a
forall a. Int -> Int -> a -> VersionedWithCount a
VersionedWithCount Int
1 Int
1 (a -> VersionedWithCount a) -> Gen a -> Gen (VersionedWithCount a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary -- TODO 1 is constant so far

toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
toVersionedWithCount :: Int -> Versioned a -> VersionedWithCount a
toVersionedWithCount Int
count (Versioned Int
version a
data_) = Int -> Int -> a -> VersionedWithCount a
forall a. Int -> Int -> a -> VersionedWithCount a
VersionedWithCount Int
version Int
count a
data_
------------------------------------------------------------------------

-- | TOREMOVE
data Repo s p = Repo
  { Repo s p -> Int
_r_version :: !Version
  , Repo s p -> s
_r_state   :: !s
  , Repo s p -> [p]
_r_history :: ![p]
    -- first patch in the list is the most recent
  }
  deriving ((forall x. Repo s p -> Rep (Repo s p) x)
-> (forall x. Rep (Repo s p) x -> Repo s p) -> Generic (Repo s p)
forall x. Rep (Repo s p) x -> Repo s p
forall x. Repo s p -> Rep (Repo s p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s p x. Rep (Repo s p) x -> Repo s p
forall s p x. Repo s p -> Rep (Repo s p) x
$cto :: forall s p x. Rep (Repo s p) x -> Repo s p
$cfrom :: forall s p x. Repo s p -> Rep (Repo s p) x
Generic, Int -> Repo s p -> ShowS
[Repo s p] -> ShowS
Repo s p -> String
(Int -> Repo s p -> ShowS)
-> (Repo s p -> String) -> ([Repo s p] -> ShowS) -> Show (Repo s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s p. (Show s, Show p) => Int -> Repo s p -> ShowS
forall s p. (Show s, Show p) => [Repo s p] -> ShowS
forall s p. (Show s, Show p) => Repo s p -> String
showList :: [Repo s p] -> ShowS
$cshowList :: forall s p. (Show s, Show p) => [Repo s p] -> ShowS
show :: Repo s p -> String
$cshow :: forall s p. (Show s, Show p) => Repo s p -> String
showsPrec :: Int -> Repo s p -> ShowS
$cshowsPrec :: forall s p. (Show s, Show p) => Int -> Repo s p -> ShowS
Show)

----------------------------------------------------------------------

instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
  parseJSON :: Value -> Parser (Repo s p)
parseJSON = Options -> Value -> Parser (Repo s p)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (Repo s p))
-> Options -> Value -> Parser (Repo s p)
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_r_"

instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
  toJSON :: Repo s p -> Value
toJSON     = Options -> Repo s p -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON     (Options -> Repo s p -> Value) -> Options -> Repo s p -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_r_"
  toEncoding :: Repo s p -> Encoding
toEncoding = Options -> Repo s p -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> Repo s p -> Encoding)
-> Options -> Repo s p -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
unPrefix String
"_r_"

instance (Serialise s, Serialise p) => Serialise (Repo s p)

makeLenses ''Repo

initRepo :: Monoid s => Repo s p
initRepo :: Repo s p
initRepo = Int -> s -> [p] -> Repo s p
forall s p. Int -> s -> [p] -> Repo s p
Repo Int
1 s
forall a. Monoid a => a
mempty []



--------------------

type RepoCmdM   env err m =
  ( CmdM'             env err m
  , HasConnectionPool env
  , HasConfig         env
  )


------------------------------------------------------------------------


-- Instances
instance Arbitrary NgramsRepoElement where
  arbitrary :: Gen NgramsRepoElement
arbitrary = [NgramsRepoElement] -> Gen NgramsRepoElement
forall a. [a] -> Gen a
elements ([NgramsRepoElement] -> Gen NgramsRepoElement)
-> [NgramsRepoElement] -> Gen NgramsRepoElement
forall a b. (a -> b) -> a -> b
$ (NgramsElement -> NgramsRepoElement)
-> [NgramsElement] -> [NgramsRepoElement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map NgramsElement -> NgramsRepoElement
ngramsElementToRepo [NgramsElement]
ns
    where
      NgramsTable [NgramsElement]
ns = NgramsTable
mockTable

instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
  where
    parseUrlPiece :: Text -> Either Text (Map NgramsType (Versioned NgramsTableMap))
parseUrlPiece Text
x = Text
-> Maybe (Map NgramsType (Versioned NgramsTableMap))
-> Either Text (Map NgramsType (Versioned NgramsTableMap))
forall e a. e -> Maybe a -> Either e a
maybeToEither Text
x (ByteString -> Maybe (Map NgramsType (Versioned NgramsTableMap))
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Map NgramsType (Versioned NgramsTableMap)))
-> ByteString -> Maybe (Map NgramsType (Versioned NgramsTableMap))
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
x)

ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
ngramsTypeFromTabType :: TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType =
  let here :: Text
here = Text
"Garg.API.Ngrams: " :: Text in
    case TabType
tabType of
      TabType
Sources    -> NgramsType
TableNgrams.Sources
      TabType
Authors    -> NgramsType
TableNgrams.Authors
      TabType
Institutes -> NgramsType
TableNgrams.Institutes
      TabType
Terms      -> NgramsType
TableNgrams.NgramsTerms
      TabType
_          -> Text -> NgramsType
forall a. HasCallStack => Text -> a
panic (Text -> NgramsType) -> Text -> NgramsType
forall a b. (a -> b) -> a -> b
$ Text
here Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"No Ngrams for this tab"
      -- TODO: This `panic` would disapear with custom NgramsType.

----
-- Async task

data UpdateTableNgramsCharts = UpdateTableNgramsCharts
  { UpdateTableNgramsCharts -> TabType
_utn_tab_type :: !TabType
  , UpdateTableNgramsCharts -> NodeId
_utn_list_id  :: !ListId
  } deriving (UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool
(UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool)
-> (UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool)
-> Eq UpdateTableNgramsCharts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool
$c/= :: UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool
== :: UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool
$c== :: UpdateTableNgramsCharts -> UpdateTableNgramsCharts -> Bool
Eq, Int -> UpdateTableNgramsCharts -> ShowS
[UpdateTableNgramsCharts] -> ShowS
UpdateTableNgramsCharts -> String
(Int -> UpdateTableNgramsCharts -> ShowS)
-> (UpdateTableNgramsCharts -> String)
-> ([UpdateTableNgramsCharts] -> ShowS)
-> Show UpdateTableNgramsCharts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTableNgramsCharts] -> ShowS
$cshowList :: [UpdateTableNgramsCharts] -> ShowS
show :: UpdateTableNgramsCharts -> String
$cshow :: UpdateTableNgramsCharts -> String
showsPrec :: Int -> UpdateTableNgramsCharts -> ShowS
$cshowsPrec :: Int -> UpdateTableNgramsCharts -> ShowS
Show, (forall x.
 UpdateTableNgramsCharts -> Rep UpdateTableNgramsCharts x)
-> (forall x.
    Rep UpdateTableNgramsCharts x -> UpdateTableNgramsCharts)
-> Generic UpdateTableNgramsCharts
forall x. Rep UpdateTableNgramsCharts x -> UpdateTableNgramsCharts
forall x. UpdateTableNgramsCharts -> Rep UpdateTableNgramsCharts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTableNgramsCharts x -> UpdateTableNgramsCharts
$cfrom :: forall x. UpdateTableNgramsCharts -> Rep UpdateTableNgramsCharts x
Generic)

makeLenses ''UpdateTableNgramsCharts
instance FromJSON UpdateTableNgramsCharts where
  parseJSON :: Value -> Parser UpdateTableNgramsCharts
parseJSON = Options -> Value -> Parser UpdateTableNgramsCharts
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser UpdateTableNgramsCharts)
-> Options -> Value -> Parser UpdateTableNgramsCharts
forall a b. (a -> b) -> a -> b
$ Text -> Options
jsonOptions Text
"_utn_"

instance ToJSON UpdateTableNgramsCharts where
  toJSON :: UpdateTableNgramsCharts -> Value
toJSON = Options -> UpdateTableNgramsCharts -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> UpdateTableNgramsCharts -> Value)
-> Options -> UpdateTableNgramsCharts -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Options
jsonOptions Text
"_utn_"

instance ToSchema UpdateTableNgramsCharts where
  declareNamedSchema :: Proxy UpdateTableNgramsCharts
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy UpdateTableNgramsCharts
-> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a),
 TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema (String -> SchemaOptions
unPrefixSwagger String
"_utn_")

------------------------------------------------------------------------
type NgramsList = (Map TableNgrams.NgramsType (Versioned NgramsTableMap))