{-# 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 (Getter, 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 :: Getter 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
(UID -> UID -> Bool) -> (UID -> UID -> Bool) -> Eq UID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UID -> UID -> Bool
== :: UID -> UID -> Bool
$c/= :: UID -> UID -> Bool
/= :: UID -> UID -> Bool
Eq, Eq UID
Eq UID =>
(UID -> UID -> Ordering)
-> (UID -> UID -> Bool)
-> (UID -> UID -> Bool)
-> (UID -> UID -> Bool)
-> (UID -> UID -> Bool)
-> (UID -> UID -> UID)
-> (UID -> UID -> UID)
-> Ord 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
$ccompare :: UID -> UID -> Ordering
compare :: UID -> UID -> Ordering
$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
>= :: UID -> UID -> Bool
$cmax :: UID -> UID -> UID
max :: UID -> UID -> UID
$cmin :: UID -> UID -> UID
min :: UID -> UID -> UID
Ord, (forall x. UID -> Rep UID x)
-> (forall x. Rep UID x -> UID) -> Generic UID
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
$cfrom :: forall x. UID -> Rep UID x
from :: forall x. UID -> Rep UID x
$cto :: forall x. Rep UID x -> UID
to :: forall x. Rep UID x -> UID
Generic) --, ToJSONKey)

makeLenses ''UID

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

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

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

instance Show UID where
  show :: UID -> String
show = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" ([String] -> String) -> (UID -> [String]) -> UID -> 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 = ASetter UID UID [String] [String]
-> ([String] -> [String]) -> UID -> UID
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UID UID [String] [String]
Lens' UID [String]
namespace (String
nsString -> [String] -> [String]
forall 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
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suff       = String -> UID
forall a. HasCallStack => String -> a
error String
"Suffix must be non-zero length"
  | Bool
otherwise       = (a
a a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a 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
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suff       = String -> UID
forall a. HasCallStack => String -> a
error (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ String
"Suffix must be non-zero length for UID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID -> String
forall a. Show a => a -> String
show UID
a
  | Bool
otherwise       = ASetter UID UID String String -> ShowS -> UID -> UID
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UID UID String String
Lens' UID String
baseName (String -> ShowS
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 UID -> Getting [String] UID [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] UID [String]
Lens' UID [String]
namespace [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= UID
t UID -> Getting [String] UID [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] UID [String]
Lens' UID [String]
namespace = String -> UID
forall a. HasCallStack => String -> a
error (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID -> String
forall a. Show a => a -> String
show UID
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" are not in the same namespace"
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UID
s UID -> Getting String UID String -> String
forall s a. s -> Getting a s a -> a
^. Getting String UID String
Lens' UID String
baseName) Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UID
t UID -> Getting String UID String -> String
forall s a. s -> Getting a s a -> a
^. Getting String UID String
Lens' UID String
baseName) = String -> UID
forall a. HasCallStack => String -> a
error (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID -> String
forall a. Show a => a -> String
show UID
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" UIDs must be non-zero length"
  | Bool
otherwise = UID
s UID -> String -> UID
+++. (UID
t UID -> Getting String UID String -> String
forall s a. s -> Getting a s a -> a
^. Getting String UID String
Lens' UID String
baseName)
  where
    s :: UID
s = a
a a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid
    t :: UID
t = b
b b -> Getting UID b UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID b UID
forall c. HasUID c => Getter c UID
Getter b 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 = UID -> String
forall a. Show a => a -> String
show (UID -> String) -> (a -> UID) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UID a UID -> a -> UID
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid