{-# LANGUAGE PatternSynonyms #-}

{- |
Copyright: (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

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
$cto :: forall x. Rep Piece x -> Piece
$cfrom :: forall x. Piece -> Rep Piece x
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
showList :: [Piece] -> ShowS
$cshowList :: [Piece] -> ShowS
show :: Piece -> String
$cshow :: Piece -> String
showsPrec :: Int -> Piece -> ShowS
$cshowsPrec :: Int -> Piece -> ShowS
Show, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: 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
min :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmax :: Piece -> Piece -> Piece
>= :: Piece -> Piece -> Bool
$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
compare :: Piece -> Piece -> Ordering
$ccompare :: Piece -> Piece -> Ordering
$cp1Ord :: Eq Piece
Ord, Int -> Piece -> Int
Piece -> Int
(Int -> Piece -> Int) -> (Piece -> Int) -> Hashable Piece
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Piece -> Int
$chash :: Piece -> Int
hashWithSalt :: Int -> Piece -> Int
$chashWithSalt :: Int -> Piece -> Int
Hashable, String -> Piece
(String -> Piece) -> IsString Piece
forall a. (String -> a) -> IsString a
fromString :: String -> Piece
$cfromString :: String -> Piece
IsString, Piece -> ()
(Piece -> ()) -> NFData Piece
forall a. (a -> ()) -> NFData a
rnf :: Piece -> ()
$crnf :: 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
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
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
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: 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
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$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
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> Int
Key -> Int
(Int -> Key -> Int) -> (Key -> Int) -> Hashable Key
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Key -> Int
$chash :: Key -> Int
hashWithSalt :: Int -> Key -> Int
$chashWithSalt :: Int -> Key -> Int
Hashable, Key -> ()
(Key -> ()) -> NFData Key
forall a. (a -> ()) -> NFData a
rnf :: Key -> ()
$crnf :: Key -> ()
NFData, b -> Key -> Key
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
stimes :: b -> Key -> Key
$cstimes :: forall b. Integral b => b -> Key -> Key
sconcat :: NonEmpty Key -> Key
$csconcat :: NonEmpty Key -> Key
<> :: Key -> Key -> Key
$c<> :: Key -> 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
        "" -> NonEmpty Piece -> Key
Key ("" Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [])
        s :: String
s  -> case Text -> Text -> [Text]
Text.splitOn "." (String -> Text
forall a. IsString a => String -> a
fromString String
s) of
            []   -> String -> Key
forall a. HasCallStack => String -> a
error "Text.splitOn returned empty string"  -- can't happen
            x :: Text
x:xs :: [Text]
xs -> NonEmpty Text -> Key
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 $b:|| :: Piece -> [Piece] -> Key
$m:|| :: forall r. Key -> (Piece -> [Piece] -> r) -> (Void# -> r) -> r
:|| xs <- Key (x :| xs)
  where
    x :: Piece
x :|| xs :: [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
(<|) p :: Piece
p k :: 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
showList :: [KeysDiff] -> ShowS
$cshowList :: [KeysDiff] -> ShowS
show :: KeysDiff -> String
$cshow :: KeysDiff -> String
showsPrec :: Int -> KeysDiff -> ShowS
$cshowsPrec :: Int -> KeysDiff -> ShowS
Show, KeysDiff -> KeysDiff -> Bool
(KeysDiff -> KeysDiff -> Bool)
-> (KeysDiff -> KeysDiff -> Bool) -> Eq KeysDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeysDiff -> KeysDiff -> Bool
$c/= :: KeysDiff -> KeysDiff -> Bool
== :: KeysDiff -> KeysDiff -> Bool
$c== :: KeysDiff -> KeysDiff -> Bool
Eq)

{- | Find key difference between two keys.

@since 0.0.0
-}
keysDiff :: Key -> Key -> KeysDiff
keysDiff :: Key -> Key -> KeysDiff
keysDiff (x :: Piece
x :|| xs :: [Piece]
xs) (y :: Piece
y :|| ys :: [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 [] []     _ = KeysDiff
Equal
    listSame [] (s :: Piece
s:ss :: [Piece]
ss) _ = Key -> KeysDiff
FstIsPref (Key -> KeysDiff) -> Key -> KeysDiff
forall a b. (a -> b) -> a -> b
$ Piece
s Piece -> [Piece] -> Key
:|| [Piece]
ss
    listSame (f :: Piece
f:fs :: [Piece]
fs) [] _ = Key -> KeysDiff
SndIsPref (Key -> KeysDiff) -> Key -> KeysDiff
forall a b. (a -> b) -> a -> b
$ Piece
f Piece -> [Piece] -> Key
:|| [Piece]
fs
    listSame (f :: Piece
f:fs :: [Piece]
fs) (s :: Piece
s:ss :: [Piece]
ss) pr :: [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)