-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

module Ui.Id (
    Id, Namespace, id, namespace

    -- * access
    , un_id, un_namespace, id_name, id_namespace, set_namespace
    , set_name, modify_name

    -- * read / show
    , read_id, show_id, read_short, show_short

    -- * validate
    , valid_symbol, symbol_description, is_id_char

    -- * Ident
    , Ident(..)
    , show_ident, read_ident
    , ident_text, text_ident
    , ident_name, ident_namespace
    , modify

    -- * constants
    , global, global_namespace

    -- * instances
    , BlockId(..), ViewId(..), TrackId(..), RulerId(..)
) where
import qualified Prelude
import           Prelude hiding (id)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import qualified Text.Read as Read

import qualified Util.Seed as Seed
import qualified Util.Serialize as Serialize

import           Global


-- | IDs come in two parts, a namespace and a name.
--
-- This is so so that you can merge two scores together and not have their IDs
-- clash.  Since block calls within a score will generally leave the namespace
-- implicit, the merged score should still be playable.
data Id = Id !Namespace !Text
    deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Eq Id
-> (Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
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 :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
Ord, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)

instance Aeson.ToJSON Id where
    toJSON :: Id -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Id -> Text) -> Id -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Text
forall a. Ident a => a -> Text
ident_text
instance Aeson.FromJSON Id where
    parseJSON :: Value -> Parser Id
parseJSON (Aeson.String Text
a) = Id -> Parser Id
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ Text -> Id
read_id Text
a
    parseJSON Value
_ = String -> Parser Id
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting String"

-- | The Namespace should pass 'valid_symbol', and is guaranteed to not contain
-- \/s.  This is because the git backend uses the namespace for a directory
-- name.
newtype Namespace = Namespace Text
    deriving (Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Eq Namespace
-> (Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
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 :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, ReadPrec [Namespace]
ReadPrec Namespace
Int -> ReadS Namespace
ReadS [Namespace]
(Int -> ReadS Namespace)
-> ReadS [Namespace]
-> ReadPrec Namespace
-> ReadPrec [Namespace]
-> Read Namespace
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Namespace]
$creadListPrec :: ReadPrec [Namespace]
readPrec :: ReadPrec Namespace
$creadPrec :: ReadPrec Namespace
readList :: ReadS [Namespace]
$creadList :: ReadS [Namespace]
readsPrec :: Int -> ReadS Namespace
$creadsPrec :: Int -> ReadS Namespace
Read, Namespace -> ()
(Namespace -> ()) -> NFData Namespace
forall a. (a -> ()) -> NFData a
rnf :: Namespace -> ()
$crnf :: Namespace -> ()
DeepSeq.NFData, Int -> Namespace -> Int
(Int -> Namespace -> Int) -> Seed Namespace
forall a. (Int -> a -> Int) -> Seed a
to_seed :: Int -> Namespace -> Int
$cto_seed :: Int -> Namespace -> Int
Seed.Seed,
        Get Namespace
Putter Namespace
Putter Namespace -> Get Namespace -> Serialize Namespace
forall a. Putter a -> Get a -> Serialize a
get :: Get Namespace
$cget :: Get Namespace
put :: Putter Namespace
$cput :: Putter Namespace
Serialize.Serialize)

-- | Convert @/@ to @-@.  This is because @/@ is used to separate namespace and
-- ident.
clean :: Text -> Text
clean :: Text -> Text
clean = (Char -> Char) -> Text -> Text
Text.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
'-' else Char
c)

id :: Namespace -> Text -> Id
id :: Namespace -> Text -> Id
id Namespace
ns = Namespace -> Text -> Id
Id Namespace
ns (Text -> Id) -> (Text -> Text) -> Text -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
clean

namespace :: Text -> Namespace
namespace :: Text -> Namespace
namespace = Text -> Namespace
Namespace (Text -> Namespace) -> (Text -> Text) -> Text -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
clean

instance Serialize.Serialize Id where
    get :: Get Id
get = Namespace -> Text -> Id
Id (Namespace -> Text -> Id) -> Get Namespace -> Get (Text -> Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Namespace
forall a. Serialize a => Get a
Serialize.get Get (Text -> Id) -> Get Text -> Get Id
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Text
forall a. Serialize a => Get a
Serialize.get
    put :: Putter Id
put (Id Namespace
a Text
b) = Putter Namespace
forall a. Serialize a => Putter a
Serialize.put Namespace
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Text
forall a. Serialize a => Putter a
Serialize.put Text
b

instance Seed.Seed Id where
    to_seed :: Int -> Id -> Int
to_seed Int
n (Id Namespace
ns Text
name) = Int
n Int -> Namespace -> Int
forall a. Seed a => Int -> a -> Int
Seed.& Namespace
ns Int -> Text -> Int
forall a. Seed a => Int -> a -> Int
Seed.& Text
name

instance Pretty Namespace where pretty :: Namespace -> Text
pretty = Namespace -> Text
un_namespace
instance Pretty Id where pretty :: Id -> Text
pretty = Id -> Text
show_id

instance DeepSeq.NFData Id where
    rnf :: Id -> ()
rnf (Id Namespace
ns Text
name) = Namespace
ns Namespace -> () -> ()
`seq` Text
name Text -> () -> ()
`seq` ()

-- * access

un_id :: Id -> (Namespace, Text)
un_id :: Id -> (Namespace, Text)
un_id (Id Namespace
ns Text
ident) = (Namespace
ns, Text
ident)

id_name :: Id -> Text
id_name :: Id -> Text
id_name (Id Namespace
_ Text
name) = Text
name

id_namespace :: Id -> Namespace
id_namespace :: Id -> Namespace
id_namespace (Id Namespace
ns Text
_) = Namespace
ns

set_namespace :: Namespace -> Id -> Id
set_namespace :: Namespace -> Id -> Id
set_namespace Namespace
ns (Id Namespace
_ Text
name) = Namespace -> Text -> Id
Id Namespace
ns Text
name

set_name :: Text -> Id -> Id
set_name :: Text -> Id -> Id
set_name Text
name (Id Namespace
ns Text
_) = Namespace -> Text -> Id
id Namespace
ns Text
name

modify_name :: (Text -> Text) -> Id -> Id
modify_name :: (Text -> Text) -> Id -> Id
modify_name Text -> Text
modify (Id Namespace
ns Text
name) = Namespace -> Text -> Id
id Namespace
ns (Text -> Text
modify Text
name)

un_namespace :: Namespace -> Text
un_namespace :: Namespace -> Text
un_namespace (Namespace Text
s) = Text
s

-- * read / show

read_id :: Text -> Id
read_id :: Text -> Id
read_id Text
s = Namespace -> Text -> Id
id (Text -> Namespace
namespace Text
pre) (Int -> Text -> Text
Text.drop Int
1 Text
post)
    where (Text
pre, Text
post) = Text -> Text -> (Text, Text)
Text.breakOn Text
"/" Text
s

show_id :: Id -> Text
show_id :: Id -> Text
show_id (Id (Namespace Text
ns) Text
ident) = Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident

-- | A smarter constructor that only applies the namespace if the string
-- doesn't already have one.
read_short :: Namespace -> Text -> Id
read_short :: Namespace -> Text -> Id
read_short Namespace
default_ns Text
text = case Text -> Text -> (Text, Text)
Text.breakOn Text
"/" Text
text of
    (Text
ident, Text
"") -> Namespace -> Text -> Id
id Namespace
default_ns Text
ident
    (Text
ns, Text
ident) -> Namespace -> Text -> Id
id (Text -> Namespace
namespace Text
ns) (Int -> Text -> Text
Text.drop Int
1 Text
ident)

-- | The inverse of 'read_short'.
show_short :: Namespace -> Id -> Text
show_short :: Namespace -> Id -> Text
show_short Namespace
default_ns ident :: Id
ident@(Id Namespace
ns Text
name)
    | Namespace
default_ns Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace
ns = Text
name
    | Bool
otherwise = Id -> Text
show_id Id
ident

-- * validate

{- | True if this Namespace or Id name follows some strict rules, which are
    a superset of the rules that make it parseable as an unquoted symbol.

    A valid identifier is @[a-z][a-z0-9.-]*@, as in 'symbol_description'.
    Hyphens are intended to separate words, and dots intended to separate
    syntactic elements, whatever those may be.  The rules are intentionally
    restrictive, to force standardization on names, and also to keep some
    syntactic flexibility in case I want to add special syntax.

    I originally used dots for relative calls, but they turn out to be annoying
    because you can't start a tracklang symbol with one, so now they use
    a hyphen.  Dots are still used for divisions in automatically generated
    names, for instance, TrackIds are generated as block.t1.

    Several kinds of tracklang names use this definition of validity, not just
    Ids (e.g. instrument or control names).  It's easier to remember a single
    rule for a valid name rather than each syntactic form have its own rules.
-}
valid_symbol :: Text -> Bool
valid_symbol :: Text -> Bool
valid_symbol Text
s = Bool -> Bool
not (Text -> Bool
Text.null Text
s) Bool -> Bool -> Bool
&& Char -> Bool
ascii_lower_alpha (Text -> Char
Text.head Text
s)
    Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
is_id_char Text
s

valid_id :: Id -> Maybe Id
valid_id :: Id -> Maybe Id
valid_id (Id (Namespace Text
ns) Text
ident)
    | Text -> Bool
valid_symbol Text
ns Bool -> Bool -> Bool
&& Text -> Bool
valid_symbol Text
ident = Id -> Maybe Id
forall a. a -> Maybe a
Just (Id -> Maybe Id) -> Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id (Text -> Namespace
Namespace Text
ns) Text
ident
    | Bool
otherwise = Maybe Id
forall a. Maybe a
Nothing

-- | 'BlockId's are more lenient, only spaces and "" are forbidden.
valid_block_id :: Id -> Maybe Id
valid_block_id :: Id -> Maybe Id
valid_block_id (Id (Namespace Text
ns) Text
ident)
    | Text -> Bool
valid_symbol Text
ns Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
Text.null Text
ident)
            Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
" " Text -> Text -> Bool
`Text.isInfixOf` Text
ident) =
        Id -> Maybe Id
forall a. a -> Maybe a
Just (Id -> Maybe Id) -> Id -> Maybe Id
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id (Text -> Namespace
Namespace Text
ns) Text
ident
    | Bool
otherwise = Maybe Id
forall a. Maybe a
Nothing

-- | Describe a valid identifier for docs and error messages.
symbol_description :: Text
symbol_description :: Text
symbol_description = Text
"[a-z][a-z0-9.-]*"

-- | This defines the set of valid characters allowed in an ID.
is_id_char :: Char -> Bool
is_id_char :: Char -> Bool
is_id_char Char
c = Char -> Bool
ascii_lower_alpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
ascii_digit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'

ascii_lower_alpha :: Char -> Bool
ascii_lower_alpha :: Char -> Bool
ascii_lower_alpha Char
c = Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'

ascii_digit :: Char -> Bool
ascii_digit :: Char -> Bool
ascii_digit Char
c = Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'

-- * Ident

-- | BlockIds, RulerIds, etc. are just wrappers around Ids.  Giving them a
-- consistent display format lets me copy and paste them on the repl socket,
-- which puts the constructors in scope.
class Ident a where
    unpack_id :: a -> Id
    constructor_name :: Proxy a -> String
    make :: Id -> Maybe a
    make_unchecked :: Id -> a

instance Ident Id where
    unpack_id :: Id -> Id
unpack_id = Id -> Id
forall a. a -> a
Prelude.id
    constructor_name :: Proxy Id -> String
constructor_name Proxy Id
_ = String
"id"
    make :: Id -> Maybe Id
make = Id -> Maybe Id
forall a. a -> Maybe a
Just
    make_unchecked :: Id -> Id
make_unchecked Id
a = Id
a

show_ident :: forall a. Ident a => a -> String
show_ident :: forall a. Ident a => a -> String
show_ident a
ident = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Id -> Text
show_id Id
id) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    where
    id :: Id
id = a -> Id
forall a. Ident a => a -> Id
unpack_id a
ident
    con :: String
con = Proxy a -> String
forall a. Ident a => Proxy a -> String
constructor_name (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

read_ident :: forall a. Ident a => ReadPrec.ReadPrec (Maybe a)
read_ident :: forall a. Ident a => ReadPrec (Maybe a)
read_ident = do
    Read.Punc String
"(" <- ReadPrec Lexeme
Read.lexP
    Read.Ident String
sym <- ReadPrec Lexeme
Read.lexP
    Bool -> ReadPrec ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
sym String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy a -> String
forall a. Ident a => Proxy a -> String
constructor_name (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
    Read.String String
str <- ReadPrec Lexeme
Read.lexP
    Read.Punc String
")" <- ReadPrec Lexeme
Read.lexP
    Maybe a -> ReadPrec (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ReadPrec (Maybe a)) -> Maybe a -> ReadPrec (Maybe a)
forall a b. (a -> b) -> a -> b
$ Id -> Maybe a
forall a. Ident a => Id -> Maybe a
make (Text -> Id
read_id (String -> Text
txt String
str))

-- | SomethingId -> "ns/name"
ident_text :: Ident a => a -> Text
ident_text :: forall a. Ident a => a -> Text
ident_text = Id -> Text
show_id (Id -> Text) -> (a -> Id) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Id
forall a. Ident a => a -> Id
unpack_id

-- | "ns/name" -> SomethingId
text_ident :: Ident a => Text -> Maybe a
text_ident :: forall a. Ident a => Text -> Maybe a
text_ident = Id -> Maybe a
forall a. Ident a => Id -> Maybe a
make (Id -> Maybe a) -> (Text -> Id) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Id
read_id

-- | SomethingId -> "name"
ident_name :: Ident a => a -> Text
ident_name :: forall a. Ident a => a -> Text
ident_name = Id -> Text
id_name (Id -> Text) -> (a -> Id) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Id
forall a. Ident a => a -> Id
unpack_id

ident_namespace :: Ident a => a -> Namespace
ident_namespace :: forall a. Ident a => a -> Namespace
ident_namespace = Id -> Namespace
id_namespace (Id -> Namespace) -> (a -> Id) -> a -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Id
forall a. Ident a => a -> Id
unpack_id

modify :: Ident a => (Id -> Id) -> a -> a
modify :: forall a. Ident a => (Id -> Id) -> a -> a
modify Id -> Id
f = Id -> a
forall a. Ident a => Id -> a
make_unchecked (Id -> a) -> (a -> Id) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Id
f (Id -> Id) -> (a -> Id) -> a -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Id
forall a. Ident a => a -> Id
unpack_id

-- * constants

global :: Text -> Id
global :: Text -> Id
global = Namespace -> Text -> Id
id Namespace
global_namespace

global_namespace :: Namespace
global_namespace :: Namespace
global_namespace = Text -> Namespace
namespace Text
""


-- * instances

-- | Reference to a Block.  Use this to look up Blocks in the State.
--
-- The convention is that BlockId should name a block which is expected to
-- exist, and the only way to create a BlockId is via 'Ui.State.create_block'.
-- The name of a block which is to be created is simply 'Id'.
--
-- However, since the constructor is exported, this isn't rigorously enforced.
--
-- Unlike other Ids, block names have no restrictions, except no spaces.  This
-- is because they become note calls, and it's convenient to have arbitrary
-- names for the same reason it's convenient to allow arbitrary characters in
-- call names.
newtype BlockId = BlockId Id
    deriving (BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c== :: BlockId -> BlockId -> Bool
Eq, Eq BlockId
Eq BlockId
-> (BlockId -> BlockId -> Ordering)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> BlockId)
-> (BlockId -> BlockId -> BlockId)
-> Ord BlockId
BlockId -> BlockId -> Bool
BlockId -> BlockId -> Ordering
BlockId -> BlockId -> BlockId
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 :: BlockId -> BlockId -> BlockId
$cmin :: BlockId -> BlockId -> BlockId
max :: BlockId -> BlockId -> BlockId
$cmax :: BlockId -> BlockId -> BlockId
>= :: BlockId -> BlockId -> Bool
$c>= :: BlockId -> BlockId -> Bool
> :: BlockId -> BlockId -> Bool
$c> :: BlockId -> BlockId -> Bool
<= :: BlockId -> BlockId -> Bool
$c<= :: BlockId -> BlockId -> Bool
< :: BlockId -> BlockId -> Bool
$c< :: BlockId -> BlockId -> Bool
compare :: BlockId -> BlockId -> Ordering
$ccompare :: BlockId -> BlockId -> Ordering
Ord, BlockId -> ()
(BlockId -> ()) -> NFData BlockId
forall a. (a -> ()) -> NFData a
rnf :: BlockId -> ()
$crnf :: BlockId -> ()
DeepSeq.NFData, Get BlockId
Putter BlockId
Putter BlockId -> Get BlockId -> Serialize BlockId
forall a. Putter a -> Get a -> Serialize a
get :: Get BlockId
$cget :: Get BlockId
put :: Putter BlockId
$cput :: Putter BlockId
Serialize.Serialize,
        Int -> BlockId -> Int
(Int -> BlockId -> Int) -> Seed BlockId
forall a. (Int -> a -> Int) -> Seed a
to_seed :: Int -> BlockId -> Int
$cto_seed :: Int -> BlockId -> Int
Seed.Seed)

-- | Reference to a View, as per 'BlockId'.
newtype ViewId = ViewId Id
    deriving (ViewId -> ViewId -> Bool
(ViewId -> ViewId -> Bool)
-> (ViewId -> ViewId -> Bool) -> Eq ViewId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewId -> ViewId -> Bool
$c/= :: ViewId -> ViewId -> Bool
== :: ViewId -> ViewId -> Bool
$c== :: ViewId -> ViewId -> Bool
Eq, Eq ViewId
Eq ViewId
-> (ViewId -> ViewId -> Ordering)
-> (ViewId -> ViewId -> Bool)
-> (ViewId -> ViewId -> Bool)
-> (ViewId -> ViewId -> Bool)
-> (ViewId -> ViewId -> Bool)
-> (ViewId -> ViewId -> ViewId)
-> (ViewId -> ViewId -> ViewId)
-> Ord ViewId
ViewId -> ViewId -> Bool
ViewId -> ViewId -> Ordering
ViewId -> ViewId -> ViewId
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 :: ViewId -> ViewId -> ViewId
$cmin :: ViewId -> ViewId -> ViewId
max :: ViewId -> ViewId -> ViewId
$cmax :: ViewId -> ViewId -> ViewId
>= :: ViewId -> ViewId -> Bool
$c>= :: ViewId -> ViewId -> Bool
> :: ViewId -> ViewId -> Bool
$c> :: ViewId -> ViewId -> Bool
<= :: ViewId -> ViewId -> Bool
$c<= :: ViewId -> ViewId -> Bool
< :: ViewId -> ViewId -> Bool
$c< :: ViewId -> ViewId -> Bool
compare :: ViewId -> ViewId -> Ordering
$ccompare :: ViewId -> ViewId -> Ordering
Ord, ViewId -> ()
(ViewId -> ()) -> NFData ViewId
forall a. (a -> ()) -> NFData a
rnf :: ViewId -> ()
$crnf :: ViewId -> ()
DeepSeq.NFData, Get ViewId
Putter ViewId
Putter ViewId -> Get ViewId -> Serialize ViewId
forall a. Putter a -> Get a -> Serialize a
get :: Get ViewId
$cget :: Get ViewId
put :: Putter ViewId
$cput :: Putter ViewId
Serialize.Serialize)

newtype TrackId = TrackId Id
    deriving (TrackId -> TrackId -> Bool
(TrackId -> TrackId -> Bool)
-> (TrackId -> TrackId -> Bool) -> Eq TrackId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackId -> TrackId -> Bool
$c/= :: TrackId -> TrackId -> Bool
== :: TrackId -> TrackId -> Bool
$c== :: TrackId -> TrackId -> Bool
Eq, Eq TrackId
Eq TrackId
-> (TrackId -> TrackId -> Ordering)
-> (TrackId -> TrackId -> Bool)
-> (TrackId -> TrackId -> Bool)
-> (TrackId -> TrackId -> Bool)
-> (TrackId -> TrackId -> Bool)
-> (TrackId -> TrackId -> TrackId)
-> (TrackId -> TrackId -> TrackId)
-> Ord TrackId
TrackId -> TrackId -> Bool
TrackId -> TrackId -> Ordering
TrackId -> TrackId -> TrackId
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 :: TrackId -> TrackId -> TrackId
$cmin :: TrackId -> TrackId -> TrackId
max :: TrackId -> TrackId -> TrackId
$cmax :: TrackId -> TrackId -> TrackId
>= :: TrackId -> TrackId -> Bool
$c>= :: TrackId -> TrackId -> Bool
> :: TrackId -> TrackId -> Bool
$c> :: TrackId -> TrackId -> Bool
<= :: TrackId -> TrackId -> Bool
$c<= :: TrackId -> TrackId -> Bool
< :: TrackId -> TrackId -> Bool
$c< :: TrackId -> TrackId -> Bool
compare :: TrackId -> TrackId -> Ordering
$ccompare :: TrackId -> TrackId -> Ordering
Ord, TrackId -> ()
(TrackId -> ()) -> NFData TrackId
forall a. (a -> ()) -> NFData a
rnf :: TrackId -> ()
$crnf :: TrackId -> ()
DeepSeq.NFData, Get TrackId
Putter TrackId
Putter TrackId -> Get TrackId -> Serialize TrackId
forall a. Putter a -> Get a -> Serialize a
get :: Get TrackId
$cget :: Get TrackId
put :: Putter TrackId
$cput :: Putter TrackId
Serialize.Serialize, Int -> TrackId -> Int
(Int -> TrackId -> Int) -> Seed TrackId
forall a. (Int -> a -> Int) -> Seed a
to_seed :: Int -> TrackId -> Int
$cto_seed :: Int -> TrackId -> Int
Seed.Seed)

newtype RulerId = RulerId Id
    deriving (RulerId -> RulerId -> Bool
(RulerId -> RulerId -> Bool)
-> (RulerId -> RulerId -> Bool) -> Eq RulerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RulerId -> RulerId -> Bool
$c/= :: RulerId -> RulerId -> Bool
== :: RulerId -> RulerId -> Bool
$c== :: RulerId -> RulerId -> Bool
Eq, Eq RulerId
Eq RulerId
-> (RulerId -> RulerId -> Ordering)
-> (RulerId -> RulerId -> Bool)
-> (RulerId -> RulerId -> Bool)
-> (RulerId -> RulerId -> Bool)
-> (RulerId -> RulerId -> Bool)
-> (RulerId -> RulerId -> RulerId)
-> (RulerId -> RulerId -> RulerId)
-> Ord RulerId
RulerId -> RulerId -> Bool
RulerId -> RulerId -> Ordering
RulerId -> RulerId -> RulerId
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 :: RulerId -> RulerId -> RulerId
$cmin :: RulerId -> RulerId -> RulerId
max :: RulerId -> RulerId -> RulerId
$cmax :: RulerId -> RulerId -> RulerId
>= :: RulerId -> RulerId -> Bool
$c>= :: RulerId -> RulerId -> Bool
> :: RulerId -> RulerId -> Bool
$c> :: RulerId -> RulerId -> Bool
<= :: RulerId -> RulerId -> Bool
$c<= :: RulerId -> RulerId -> Bool
< :: RulerId -> RulerId -> Bool
$c< :: RulerId -> RulerId -> Bool
compare :: RulerId -> RulerId -> Ordering
$ccompare :: RulerId -> RulerId -> Ordering
Ord, RulerId -> ()
(RulerId -> ()) -> NFData RulerId
forall a. (a -> ()) -> NFData a
rnf :: RulerId -> ()
$crnf :: RulerId -> ()
DeepSeq.NFData, Get RulerId
Putter RulerId
Putter RulerId -> Get RulerId -> Serialize RulerId
forall a. Putter a -> Get a -> Serialize a
get :: Get RulerId
$cget :: Get RulerId
put :: Putter RulerId
$cput :: Putter RulerId
Serialize.Serialize)

instance Show BlockId where show :: BlockId -> String
show = BlockId -> String
forall a. Ident a => a -> String
show_ident
instance Show ViewId where show :: ViewId -> String
show = ViewId -> String
forall a. Ident a => a -> String
show_ident
instance Show TrackId where show :: TrackId -> String
show = TrackId -> String
forall a. Ident a => a -> String
show_ident
instance Show RulerId where show :: RulerId -> String
show = RulerId -> String
forall a. Ident a => a -> String
show_ident

instance Pretty BlockId where pretty :: BlockId -> Text
pretty = BlockId -> Text
forall a. Show a => a -> Text
showt
instance Pretty ViewId where pretty :: ViewId -> Text
pretty = ViewId -> Text
forall a. Show a => a -> Text
showt
instance Pretty TrackId where pretty :: TrackId -> Text
pretty = TrackId -> Text
forall a. Show a => a -> Text
showt
instance Pretty RulerId where pretty :: RulerId -> Text
pretty = RulerId -> Text
forall a. Show a => a -> Text
showt

instance Read BlockId where readPrec :: ReadPrec BlockId
readPrec = ReadPrec (Maybe BlockId) -> ReadPrec BlockId
forall a. ReadPrec (Maybe a) -> ReadPrec a
require ReadPrec (Maybe BlockId)
forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read ViewId where readPrec :: ReadPrec ViewId
readPrec = ReadPrec (Maybe ViewId) -> ReadPrec ViewId
forall a. ReadPrec (Maybe a) -> ReadPrec a
require ReadPrec (Maybe ViewId)
forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read TrackId where readPrec :: ReadPrec TrackId
readPrec = ReadPrec (Maybe TrackId) -> ReadPrec TrackId
forall a. ReadPrec (Maybe a) -> ReadPrec a
require ReadPrec (Maybe TrackId)
forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read RulerId where readPrec :: ReadPrec RulerId
readPrec = ReadPrec (Maybe RulerId) -> ReadPrec RulerId
forall a. ReadPrec (Maybe a) -> ReadPrec a
require ReadPrec (Maybe RulerId)
forall a. Ident a => ReadPrec (Maybe a)
read_ident

require :: Read.ReadPrec (Maybe a) -> Read.ReadPrec a
require :: forall a. ReadPrec (Maybe a) -> ReadPrec a
require = (ReadPrec a -> (a -> ReadPrec a) -> Maybe a -> ReadPrec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec a
forall a. ReadPrec a
Read.pfail a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return =<<)

instance Ident BlockId where
    unpack_id :: BlockId -> Id
unpack_id (BlockId Id
a) = Id
a
    constructor_name :: Proxy BlockId -> String
constructor_name Proxy BlockId
_ = String
"bid"
    make :: Id -> Maybe BlockId
make = (Id -> BlockId) -> Maybe Id -> Maybe BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> BlockId
forall a. Ident a => Id -> a
make_unchecked (Maybe Id -> Maybe BlockId)
-> (Id -> Maybe Id) -> Id -> Maybe BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Maybe Id
valid_block_id
    make_unchecked :: Id -> BlockId
make_unchecked = Id -> BlockId
BlockId
instance Ident ViewId where
    unpack_id :: ViewId -> Id
unpack_id (ViewId Id
a) = Id
a
    constructor_name :: Proxy ViewId -> String
constructor_name Proxy ViewId
_ = String
"vid"
    make :: Id -> Maybe ViewId
make = (Id -> ViewId) -> Maybe Id -> Maybe ViewId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> ViewId
ViewId (Maybe Id -> Maybe ViewId)
-> (Id -> Maybe Id) -> Id -> Maybe ViewId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Maybe Id
valid_id
    make_unchecked :: Id -> ViewId
make_unchecked = Id -> ViewId
ViewId
instance Ident TrackId where
    unpack_id :: TrackId -> Id
unpack_id (TrackId Id
a) = Id
a
    constructor_name :: Proxy TrackId -> String
constructor_name Proxy TrackId
_ = String
"tid"
    make :: Id -> Maybe TrackId
make = (Id -> TrackId) -> Maybe Id -> Maybe TrackId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> TrackId
TrackId (Maybe Id -> Maybe TrackId)
-> (Id -> Maybe Id) -> Id -> Maybe TrackId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Maybe Id
valid_id
    make_unchecked :: Id -> TrackId
make_unchecked = Id -> TrackId
TrackId
instance Ident RulerId where
    unpack_id :: RulerId -> Id
unpack_id (RulerId Id
a) = Id
a
    constructor_name :: Proxy RulerId -> String
constructor_name Proxy RulerId
_ = String
"rid"
    make :: Id -> Maybe RulerId
make = (Id -> RulerId) -> Maybe Id -> Maybe RulerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> RulerId
RulerId (Maybe Id -> Maybe RulerId)
-> (Id -> Maybe Id) -> Id -> Maybe RulerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Maybe Id
valid_id
    make_unchecked :: Id -> RulerId
make_unchecked = Id -> RulerId
RulerId

instance Aeson.ToJSON BlockId where toJSON :: BlockId -> Value
toJSON = Id -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Id -> Value) -> (BlockId -> Id) -> BlockId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Id
forall a. Ident a => a -> Id
unpack_id
instance Aeson.FromJSON BlockId where parseJSON :: Value -> Parser BlockId
parseJSON = (Id -> BlockId) -> Parser Id -> Parser BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> BlockId
BlockId (Parser Id -> Parser BlockId)
-> (Value -> Parser Id) -> Value -> Parser BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

instance Aeson.ToJSON ViewId where toJSON :: ViewId -> Value
toJSON = Id -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Id -> Value) -> (ViewId -> Id) -> ViewId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewId -> Id
forall a. Ident a => a -> Id
unpack_id
instance Aeson.FromJSON ViewId where parseJSON :: Value -> Parser ViewId
parseJSON = (Id -> ViewId) -> Parser Id -> Parser ViewId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> ViewId
ViewId (Parser Id -> Parser ViewId)
-> (Value -> Parser Id) -> Value -> Parser ViewId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

instance Aeson.ToJSON TrackId where toJSON :: TrackId -> Value
toJSON = Id -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Id -> Value) -> (TrackId -> Id) -> TrackId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackId -> Id
forall a. Ident a => a -> Id
unpack_id
instance Aeson.FromJSON TrackId where parseJSON :: Value -> Parser TrackId
parseJSON = (Id -> TrackId) -> Parser Id -> Parser TrackId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> TrackId
TrackId (Parser Id -> Parser TrackId)
-> (Value -> Parser Id) -> Value -> Parser TrackId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

instance Aeson.ToJSON RulerId where toJSON :: RulerId -> Value
toJSON = Id -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Id -> Value) -> (RulerId -> Id) -> RulerId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RulerId -> Id
forall a. Ident a => a -> Id
unpack_id
instance Aeson.FromJSON RulerId where parseJSON :: Value -> Parser RulerId
parseJSON = (Id -> RulerId) -> Parser Id -> Parser RulerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> RulerId
RulerId (Parser Id -> Parser RulerId)
-> (Value -> Parser Id) -> Value -> Parser RulerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Id
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON