module Language.Drasil.UID (
UID
, HasUID(uid)
, mkUid, (+++), (+++.), (+++!)
, showUID
) where
import Control.Lens (Lens', (^.), view)
class HasUID c where
uid :: Lens' c UID
newtype UID = UID String
deriving (UID -> UID -> Bool
(UID -> UID -> Bool) -> (UID -> UID -> Bool) -> Eq UID
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
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
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
$cp1Ord :: Eq UID
Ord)
instance Show UID where
show :: UID -> String
show (UID u :: String
u) = String
u
mkUid :: String -> UID
mkUid :: String -> UID
mkUid = String -> UID
UID
(+++) :: HasUID a => a -> String -> UID
a :: a
a +++ :: a -> String -> UID
+++ suff :: String
suff
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suff = String -> UID
forall a. HasCallStack => String -> a
error "Suffix must be non-zero length"
| Bool
otherwise = String -> UID
UID (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suff
where UID s :: String
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 => Lens' c UID
uid
(+++.) :: UID -> String -> UID
a :: UID
a +++. :: UID -> String -> UID
+++. suff :: String
suff
| String -> 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
$ "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 = String -> UID
UID (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suff
where UID s :: String
s = UID
a
(+++!) :: (HasUID a, HasUID b) => a -> b -> UID
a :: a
a +++! :: a -> b -> UID
+++! b :: b
b
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (a -> String
forall a. HasUID a => a -> String
showUID a
a) Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (b -> String
forall a. HasUID a => a -> String
showUID b
b) = String -> UID
forall a. HasCallStack => String -> a
error (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. HasUID a => a -> String
showUID a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ " and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. HasUID a => a -> String
showUID b
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ " UIDs must be non-zero length"
| Bool
otherwise = String -> UID
UID (a -> String
forall a. HasUID a => a -> String
showUID a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. HasUID a => a -> String
showUID b
b)
showUID :: HasUID a => a -> String
showUID :: 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 => Lens' c UID
uid