-- 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
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
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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Text
ident_text
instance Aeson.FromJSON Id where
    parseJSON :: Value -> Parser Id
parseJSON (Aeson.String Text
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Id
read_id Text
a
    parseJSON Value
_ = 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
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
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
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]
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Namespace -> ()
$crnf :: Namespace -> ()
DeepSeq.NFData, Int -> Namespace -> Int
forall a. (Int -> a -> Int) -> Seed a
to_seed :: Int -> Namespace -> Int
$cto_seed :: Int -> Namespace -> Int
Seed.Seed,
        Get Namespace
Putter 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
clean

namespace :: Text -> Namespace
namespace :: Text -> Namespace
namespace = Text -> Namespace
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
Serialize.get
    put :: Putter Id
put (Id Namespace
a Text
b) = forall a. Serialize a => Putter a
Serialize.put Namespace
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall a. Seed a => Int -> a -> Int
Seed.& Namespace
ns 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 seq :: forall a b. a -> b -> b
`seq` Text
name seq :: forall a b. a -> b -> b
`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) = HasCallStack => 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 forall a. Semigroup a => a -> a -> a
<> 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 HasCallStack => 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 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 (HasCallStack => 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id (Text -> Namespace
Namespace Text
ns) Text
ident
    | Bool
otherwise = 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) =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Id
Id (Text -> Namespace
Namespace Text
ns) Text
ident
    | Bool
otherwise = 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 forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z'

ascii_digit :: Char -> Bool
ascii_digit :: Char -> Bool
ascii_digit Char
c = Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 = forall a. a -> a
Prelude.id
    constructor_name :: Proxy Id -> String
constructor_name Proxy Id
_ = String
"id"
    make :: Id -> Maybe Id
make = 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
"(" forall a. [a] -> [a] -> [a]
++ String
con forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Id -> Text
show_id Id
id) forall a. [a] -> [a] -> [a]
++ String
")"
    where
    id :: Id
id = forall a. Ident a => a -> Id
unpack_id a
ident
    con :: String
con = forall a. Ident a => Proxy a -> String
constructor_name (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
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
sym forall a. Eq a => a -> a -> Bool
== forall a. Ident a => Proxy a -> String
constructor_name (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
    Read.String String
str <- ReadPrec Lexeme
Read.lexP
    Read.Punc String
")" <- ReadPrec Lexeme
Read.lexP
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Ident a => Id -> Maybe a
make 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Ident a => Id -> a
make_unchecked forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Id
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: BlockId -> ()
$crnf :: BlockId -> ()
DeepSeq.NFData, Get BlockId
Putter 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
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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: ViewId -> ()
$crnf :: ViewId -> ()
DeepSeq.NFData, Get ViewId
Putter 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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TrackId -> ()
$crnf :: TrackId -> ()
DeepSeq.NFData, Get TrackId
Putter 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
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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: RulerId -> ()
$crnf :: RulerId -> ()
DeepSeq.NFData, Get RulerId
Putter 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 = forall a. Ident a => a -> String
show_ident
instance Show ViewId where show :: ViewId -> String
show = forall a. Ident a => a -> String
show_ident
instance Show TrackId where show :: TrackId -> String
show = forall a. Ident a => a -> String
show_ident
instance Show RulerId where show :: RulerId -> String
show = forall a. Ident a => a -> String
show_ident

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

instance Read BlockId where readPrec :: ReadPrec BlockId
readPrec = forall a. ReadPrec (Maybe a) -> ReadPrec a
require forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read ViewId where readPrec :: ReadPrec ViewId
readPrec = forall a. ReadPrec (Maybe a) -> ReadPrec a
require forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read TrackId where readPrec :: ReadPrec TrackId
readPrec = forall a. ReadPrec (Maybe a) -> ReadPrec a
require forall a. Ident a => ReadPrec (Maybe a)
read_ident
instance Read RulerId where readPrec :: ReadPrec RulerId
readPrec = forall a. ReadPrec (Maybe a) -> ReadPrec a
require 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 = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
Read.pfail 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ident a => Id -> a
make_unchecked 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> ViewId
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> TrackId
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> RulerId
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 = forall a. ToJSON a => a -> Value
Aeson.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ident a => a -> Id
unpack_id
instance Aeson.FromJSON BlockId where parseJSON :: Value -> Parser BlockId
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> BlockId
BlockId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

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

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

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