{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Unique Identifier used across Drasil.
module Language.Drasil.UID (
    UID
  , HasUID(uid)
  , mkUid, nsUid, (+++), (+++.), (+++!)
  , showUID
) where

import Data.Aeson
import Data.Aeson.Types
import Data.List (intercalate)
import Data.Text (pack)
import GHC.Generics

import Control.Lens (Lens', makeLenses, (^.), view, over)

-- | The most basic item: having a unique identifier key, here a UID.
class HasUID c where
  -- | Provides a /unique/ id for internal Drasil use.
  uid :: Lens' c UID

-- | A @UID@ is a 'unique identifier' for things that we will put into our database
-- of information. We use a newtype wrapper to make sure we are only using
-- 'UID's where desired.
data UID = UID { UID -> [String]
_namespace :: [String], UID -> String
_baseName :: String }
  deriving (UID -> UID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UID -> UID -> Bool
$c/= :: UID -> UID -> Bool
== :: UID -> UID -> Bool
$c== :: UID -> UID -> Bool
Eq, Eq UID
UID -> UID -> Bool
UID -> UID -> Ordering
UID -> UID -> UID
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 :: UID -> UID -> UID
$cmin :: UID -> UID -> UID
max :: UID -> UID -> UID
$cmax :: UID -> UID -> UID
>= :: UID -> UID -> Bool
$c>= :: UID -> UID -> Bool
> :: UID -> UID -> Bool
$c> :: UID -> UID -> Bool
<= :: UID -> UID -> Bool
$c<= :: UID -> UID -> Bool
< :: UID -> UID -> Bool
$c< :: UID -> UID -> Bool
compare :: UID -> UID -> Ordering
$ccompare :: UID -> UID -> Ordering
Ord, forall x. Rep UID x -> UID
forall x. UID -> Rep UID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UID x -> UID
$cfrom :: forall x. UID -> Rep UID x
Generic) --, ToJSONKey)

makeLenses ''UID

fullName :: UID -> [String]
fullName :: UID -> [String]
fullName UID
u = UID
u forall s a. s -> Getting a s a -> a
^. Lens' UID [String]
namespace forall a. [a] -> [a] -> [a]
++ [UID
u forall s a. s -> Getting a s a -> a
^. Lens' UID String
baseName]

instance ToJSON UID where
  toJSON :: UID -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> [String]
fullName

instance ToJSONKey UID where
  toJSONKey :: ToJSONKeyFunction UID
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

instance Show UID where
  show :: UID -> String
show = forall a. [a] -> [[a]] -> [a]
intercalate String
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. UID -> [String]
fullName

-- | Smart constructor for making a 'UID' from a 'String'.
mkUid :: String -> UID
mkUid :: String -> UID
mkUid String
s = UID { _namespace :: [String]
_namespace = [], _baseName :: String
_baseName = String
s }
  -- '►' `elem` s = error $ "► not allowed in UID " ++ show s -- FIXME: Need to implement other constructors before we can use this.
  -- null s       = error "UID must be non-zero length" -- FIXME: See Drasil.DocumentLanguage.TraceabilityGraph (uses an empty UID)
  -- otherwise    = UID s

-- | Nest UID under a namespace
nsUid :: String -> UID -> UID
nsUid :: String -> UID -> UID
nsUid String
ns = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' UID [String]
namespace (String
nsforall a. a -> [a] -> [a]
:)

-- | For when we need to modify a UID. We first take the base chunk's UID and then append a suffix to it.
(+++) :: HasUID a => a -> String -> UID
a
a +++ :: forall a. HasUID a => a -> String -> UID
+++ String
suff
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suff       = forall a. HasCallStack => String -> a
error String
"Suffix must be non-zero length"
  | Bool
otherwise       = (a
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) UID -> String -> UID
+++. String
suff
  -- otherwise       = UID $ s ++ '►':suff --FIXME: Implement this properly.
  --   where UID s = a ^. uid

-- | For when we need to append something to a UID.
(+++.) :: UID -> String -> UID
UID
a +++. :: UID -> String -> UID
+++. String
suff
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suff       = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Suffix must be non-zero length for UID " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show UID
a
  | Bool
otherwise       = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' UID String
baseName (forall a. [a] -> [a] -> [a]
++ String
suff) UID
a

(+++!) :: (HasUID a, HasUID b) => a -> b -> UID
a
a +++! :: forall a b. (HasUID a, HasUID b) => a -> b -> UID
+++! b
b
  | UID
s forall s a. s -> Getting a s a -> a
^. Lens' UID [String]
namespace forall a. Eq a => a -> a -> Bool
/= UID
t forall s a. s -> Getting a s a -> a
^. Lens' UID [String]
namespace = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UID
s forall a. [a] -> [a] -> [a]
++ String
" and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show UID
t forall a. [a] -> [a] -> [a]
++ String
" are not in the same namespace"
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UID
s forall s a. s -> Getting a s a -> a
^. Lens' UID String
baseName) Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UID
t forall s a. s -> Getting a s a -> a
^. Lens' UID String
baseName) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UID
s forall a. [a] -> [a] -> [a]
++ String
" and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show UID
t forall a. [a] -> [a] -> [a]
++ String
" UIDs must be non-zero length"
  | Bool
otherwise = UID
s UID -> String -> UID
+++. (UID
t forall s a. s -> Getting a s a -> a
^. Lens' UID String
baseName)
  where
    s :: UID
s = a
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid
    t :: UID
t = b
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid

-- | Grabs the UID from something that has a UID and displays it as a String.
showUID :: HasUID a => a -> String
showUID :: forall a. HasUID a => a -> String
showUID = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasUID c => Lens' c UID
uid