{-# LANGUAGE PatternSynonyms #-}

{- |
Module                  : Toml.Type.Key
Copyright               : (c) 2018-2022 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

Implementation of key type. The type is used for key-value pairs and
table names.

@since 1.3.0.0
-}

module Toml.Type.Key
    ( -- * Core types
      Key (..)
    , Prefix
    , Piece (..)
    , pattern (:||)
    , (<|)

      -- * Key difference
    , KeysDiff (..)
    , keysDiff
    ) where

import Control.DeepSeq (NFData)
import Data.Coerce (coerce)
import Data.Hashable (Hashable)
import Data.List.NonEmpty (NonEmpty (..))
import Data.String (IsString (..))
import Data.Text (Text)
import GHC.Generics (Generic)

import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text


{- | Represents the key piece of some layer.

@since 0.0.0
-}
newtype Piece = Piece
    { Piece -> Text
unPiece :: Text
    } deriving stock ((forall x. Piece -> Rep Piece x)
-> (forall x. Rep Piece x -> Piece) -> Generic Piece
forall x. Rep Piece x -> Piece
forall x. Piece -> Rep Piece x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Piece -> Rep Piece x
from :: forall x. Piece -> Rep Piece x
$cto :: forall x. Rep Piece x -> Piece
to :: forall x. Rep Piece x -> Piece
Generic)
      deriving newtype (Int -> Piece -> ShowS
[Piece] -> ShowS
Piece -> String
(Int -> Piece -> ShowS)
-> (Piece -> String) -> ([Piece] -> ShowS) -> Show Piece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Piece -> ShowS
showsPrec :: Int -> Piece -> ShowS
$cshow :: Piece -> String
show :: Piece -> String
$cshowList :: [Piece] -> ShowS
showList :: [Piece] -> ShowS
Show, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
/= :: Piece -> Piece -> Bool
Eq, Eq Piece
Eq Piece =>
(Piece -> Piece -> Ordering)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Piece)
-> (Piece -> Piece -> Piece)
-> Ord Piece
Piece -> Piece -> Bool
Piece -> Piece -> Ordering
Piece -> Piece -> Piece
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
$ccompare :: Piece -> Piece -> Ordering
compare :: Piece -> Piece -> Ordering
$c< :: Piece -> Piece -> Bool
< :: Piece -> Piece -> Bool
$c<= :: Piece -> Piece -> Bool
<= :: Piece -> Piece -> Bool
$c> :: Piece -> Piece -> Bool
> :: Piece -> Piece -> Bool
$c>= :: Piece -> Piece -> Bool
>= :: Piece -> Piece -> Bool
$cmax :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
min :: Piece -> Piece -> Piece
Ord, Eq Piece
Eq Piece =>
(Int -> Piece -> Int) -> (Piece -> Int) -> Hashable Piece
Int -> Piece -> Int
Piece -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Piece -> Int
hashWithSalt :: Int -> Piece -> Int
$chash :: Piece -> Int
hash :: Piece -> Int
Hashable, String -> Piece
(String -> Piece) -> IsString Piece
forall a. (String -> a) -> IsString a
$cfromString :: String -> Piece
fromString :: String -> Piece
IsString, Piece -> ()
(Piece -> ()) -> NFData Piece
forall a. (a -> ()) -> NFData a
$crnf :: Piece -> ()
rnf :: Piece -> ()
NFData)

{- | Key of value in @key = val@ pair. Represents as non-empty list of key
components — 'Piece's. Key like

@
site."google.com"
@

is represented like

@
Key (Piece "site" :| [Piece "\\"google.com\\""])
@

@since 0.0.0
-}
newtype Key = Key
    { Key -> NonEmpty Piece
unKey :: NonEmpty Piece
    } deriving stock ((forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Key -> Rep Key x
from :: forall x. Key -> Rep Key x
$cto :: forall x. Rep Key x -> Key
to :: forall x. Rep Key x -> Key
Generic)
      deriving newtype (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord, Eq Key
Eq Key => (Int -> Key -> Int) -> (Key -> Int) -> Hashable Key
Int -> Key -> Int
Key -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Key -> Int
hashWithSalt :: Int -> Key -> Int
$chash :: Key -> Int
hash :: Key -> Int
Hashable, Key -> ()
(Key -> ()) -> NFData Key
forall a. (a -> ()) -> NFData a
$crnf :: Key -> ()
rnf :: Key -> ()
NFData, NonEmpty Key -> Key
Key -> Key -> Key
(Key -> Key -> Key)
-> (NonEmpty Key -> Key)
-> (forall b. Integral b => b -> Key -> Key)
-> Semigroup Key
forall b. Integral b => b -> Key -> Key
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Key -> Key -> Key
<> :: Key -> Key -> Key
$csconcat :: NonEmpty Key -> Key
sconcat :: NonEmpty Key -> Key
$cstimes :: forall b. Integral b => b -> Key -> Key
stimes :: forall b. Integral b => b -> Key -> Key
Semigroup)

{- | Type synonym for 'Key'.

@since 0.0.0
-}
type Prefix = Key

{- | Split a dot-separated string into 'Key'. Empty string turns into a 'Key'
with single element — empty 'Piece'.

This instance is not safe for now. Use carefully. If you try to use as a key
string like this @site.\"google.com\"@ you will have list of three components
instead of desired two.

@since 0.1.0
-}
instance IsString Key where
    fromString :: String -> Key
    fromString :: String -> Key
fromString = \case
        String
"" -> NonEmpty Piece -> Key
Key (Piece
"" Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [])
        String
s  -> case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"." (String -> Text
forall a. IsString a => String -> a
fromString String
s) of
            []   -> String -> Key
forall a. HasCallStack => String -> a
error String
"Text.splitOn returned empty string"  -- can't happen
            Text
x:[Text]
xs -> forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(NonEmpty Text) @Key (Text
x Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
xs)

{- | Bidirectional pattern synonym for constructing and deconstructing 'Key's.
-}
pattern (:||) :: Piece -> [Piece] -> Key
pattern x $m:|| :: forall {r}. Key -> (Piece -> [Piece] -> r) -> ((# #) -> r) -> r
$b:|| :: Piece -> [Piece] -> Key
:|| xs <- Key (x :| xs)
  where
    Piece
x :|| [Piece]
xs = NonEmpty Piece -> Key
Key (Piece
x Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [Piece]
xs)

{-# COMPLETE (:||) #-}

-- | Prepends 'Piece' to the beginning of the 'Key'.
(<|) :: Piece -> Key -> Key
<| :: Piece -> Key -> Key
(<|) Piece
p Key
k = NonEmpty Piece -> Key
Key (Piece
p Piece -> NonEmpty Piece -> NonEmpty Piece
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.<| Key -> NonEmpty Piece
unKey Key
k)
{-# INLINE (<|) #-}

{- | Data represent difference between two keys.

@since 0.0.0
-}
data KeysDiff
    = Equal      -- ^ Keys are equal
    | NoPrefix   -- ^ Keys don't have any common part.
    | FstIsPref  -- ^ The first key is the prefix of the second one.
        !Key     -- ^ Rest of the second key.
    | SndIsPref  -- ^ The second key is the prefix of the first one.
        !Key     -- ^ Rest of the first key.
    | Diff       -- ^ Key have a common prefix.
        !Key     -- ^ Common prefix.
        !Key     -- ^ Rest of the first key.
        !Key     -- ^ Rest of the second key.
    deriving stock (Int -> KeysDiff -> ShowS
[KeysDiff] -> ShowS
KeysDiff -> String
(Int -> KeysDiff -> ShowS)
-> (KeysDiff -> String) -> ([KeysDiff] -> ShowS) -> Show KeysDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeysDiff -> ShowS
showsPrec :: Int -> KeysDiff -> ShowS
$cshow :: KeysDiff -> String
show :: KeysDiff -> String
$cshowList :: [KeysDiff] -> ShowS
showList :: [KeysDiff] -> ShowS
Show, KeysDiff -> KeysDiff -> Bool
(KeysDiff -> KeysDiff -> Bool)
-> (KeysDiff -> KeysDiff -> Bool) -> Eq KeysDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeysDiff -> KeysDiff -> Bool
== :: KeysDiff -> KeysDiff -> Bool
$c/= :: KeysDiff -> KeysDiff -> Bool
/= :: KeysDiff -> KeysDiff -> Bool
Eq)

{- | Find key difference between two keys.

@since 0.0.0
-}
keysDiff :: Key -> Key -> KeysDiff
keysDiff :: Key -> Key -> KeysDiff
keysDiff (Piece
x :|| [Piece]
xs) (Piece
y :|| [Piece]
ys)
    | Piece
x Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
y    = [Piece] -> [Piece] -> [Piece] -> KeysDiff
listSame [Piece]
xs [Piece]
ys []
    | Bool
otherwise = KeysDiff
NoPrefix
  where
    listSame :: [Piece] -> [Piece] -> [Piece] -> KeysDiff
    listSame :: [Piece] -> [Piece] -> [Piece] -> KeysDiff
listSame [] []     [Piece]
_ = KeysDiff
Equal
    listSame [] (Piece
s:[Piece]
ss) [Piece]
_ = Key -> KeysDiff
FstIsPref (Key -> KeysDiff) -> Key -> KeysDiff
forall a b. (a -> b) -> a -> b
$ Piece
s Piece -> [Piece] -> Key
:|| [Piece]
ss
    listSame (Piece
f:[Piece]
fs) [] [Piece]
_ = Key -> KeysDiff
SndIsPref (Key -> KeysDiff) -> Key -> KeysDiff
forall a b. (a -> b) -> a -> b
$ Piece
f Piece -> [Piece] -> Key
:|| [Piece]
fs
    listSame (Piece
f:[Piece]
fs) (Piece
s:[Piece]
ss) [Piece]
pr =
        if Piece
f Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
s
        then [Piece] -> [Piece] -> [Piece] -> KeysDiff
listSame [Piece]
fs [Piece]
ss ([Piece]
pr [Piece] -> [Piece] -> [Piece]
forall a. [a] -> [a] -> [a]
++ [Piece
f])
        else Key -> Key -> Key -> KeysDiff
Diff (Piece
x Piece -> [Piece] -> Key
:|| [Piece]
pr) (Piece
f Piece -> [Piece] -> Key
:|| [Piece]
fs) (Piece
s Piece -> [Piece] -> Key
:|| [Piece]
ss)