module Sound.Tidal.ID (ID(..)) where

{-
    ID.hs - Polymorphic pattern identifiers
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import GHC.Exts ( IsString(..) )

-- | Wrapper for literals that can be coerced to a string and used as an identifier.
-- | Similar to Show typeclass, but constrained to strings and integers and designed
-- | so that similar cases (such as 1 and "1") convert to the same value.
newtype ID = ID { ID -> String
fromID :: String }

noOv :: String -> a
noOv :: String -> a
noOv String
meth = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
meth String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": not supported for ids"

instance Num ID where
  fromInteger :: Integer -> ID
fromInteger = String -> ID
ID (String -> ID) -> (Integer -> String) -> Integer -> ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
  + :: ID -> ID -> ID
(+) = String -> ID -> ID -> ID
forall a. String -> a
noOv String
"+"
  * :: ID -> ID -> ID
(*) = String -> ID -> ID -> ID
forall a. String -> a
noOv String
"*"
  abs :: ID -> ID
abs = String -> ID -> ID
forall a. String -> a
noOv String
"abs"
  signum :: ID -> ID
signum = String -> ID -> ID
forall a. String -> a
noOv String
"signum"
  (-) = String -> ID -> ID -> ID
forall a. String -> a
noOv String
"-"

instance IsString ID where
  fromString :: String -> ID
fromString = String -> ID
ID