{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module      :  ELynx.Tree.Name
-- Description :  Trees with named nodes
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Jan 24 20:09:20 2019.
module ELynx.Tree.Name
  ( Name (..),
    HasName (..),
  )
where

import Control.DeepSeq
import Data.Aeson
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Default.Class
-- TODO: 2021-09-02: Native conversion is being implemented at the moment.
-- Remove external library when this is available.
import qualified Data.Double.Conversion.ByteString as BC
import Data.String

-- | Node name.
--
-- Use lazy byte strings because Newick strings are built using chunks.
newtype Name = Name {Name -> ByteString
fromName :: BL.ByteString}
  deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
(Int -> ReadS Name)
-> ReadS [Name] -> ReadPrec Name -> ReadPrec [Name] -> Read Name
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq)
  deriving (Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord, Semigroup Name
Name
Semigroup Name
-> Name
-> (Name -> Name -> Name)
-> ([Name] -> Name)
-> Monoid Name
[Name] -> Name
Name -> Name -> Name
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Name] -> Name
$cmconcat :: [Name] -> Name
mappend :: Name -> Name -> Name
$cmappend :: Name -> Name -> Name
mempty :: Name
$cmempty :: Name
$cp1Monoid :: Semigroup Name
Monoid, b -> Name -> Name
NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
sconcat :: NonEmpty Name -> Name
$csconcat :: NonEmpty Name -> Name
<> :: Name -> Name -> Name
$c<> :: Name -> Name -> Name
Semigroup, String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
fromString :: String -> Name
$cfromString :: String -> Name
IsString, Name -> ()
(Name -> ()) -> NFData Name
forall a. (a -> ()) -> NFData a
rnf :: Name -> ()
$crnf :: Name -> ()
NFData) via BL.ByteString

instance Default Name where
  def :: Name
def = ByteString -> Name
Name ByteString
""

-- XXX: This is pretty lame, but I need those instances. At the moment, I just
-- go via 'String', but this is certainly not the best solution.

instance ToJSON Name where
  toJSON :: Name -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value) -> (Name -> String) -> Name -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BL.unpack (ByteString -> String) -> (Name -> ByteString) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
fromName
  toEncoding :: Name -> Encoding
toEncoding = String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (String -> Encoding) -> (Name -> String) -> Name -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BL.unpack (ByteString -> String) -> (Name -> ByteString) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
fromName

instance FromJSON Name where
  parseJSON :: Value -> Parser Name
parseJSON = (String -> Name) -> Parser String -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Name
Name (ByteString -> Name) -> (String -> ByteString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BL.pack) (Parser String -> Parser Name)
-> (Value -> Parser String) -> Value -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Class of types having a name.
class HasName a where
  getName :: a -> Name

instance HasName Name where
  getName :: Name -> Name
getName = Name -> Name
forall a. a -> a
id

instance HasName () where
  getName :: () -> Name
getName = Name -> () -> Name
forall a b. a -> b -> a
const (ByteString -> Name
Name ByteString
BL.empty)

instance HasName Int where
  getName :: Int -> Name
getName = ByteString -> Name
Name (ByteString -> Name) -> (Int -> ByteString) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
BB.intDec

instance HasName Double where
  getName :: Double -> Name
getName = ByteString -> Name
Name (ByteString -> Name) -> (Double -> ByteString) -> Double -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Double -> ByteString) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
BC.toShortest

instance HasName Char where
  getName :: Char -> Name
getName = ByteString -> Name
Name (ByteString -> Name) -> (Char -> ByteString) -> Char -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> (Char -> Builder) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
BB.char8

instance (HasName a) => HasName [a] where
  getName :: [a] -> Name
getName = ByteString -> Name
Name (ByteString -> Name) -> ([a] -> ByteString) -> [a] -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BL.concat ([ByteString] -> ByteString)
-> ([a] -> [ByteString]) -> [a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> ByteString
fromName (Name -> ByteString) -> (a -> Name) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Name
forall a. HasName a => a -> Name
getName)

instance HasName BL.ByteString where
  getName :: ByteString -> Name
getName = ByteString -> Name
Name

instance HasName BS.ByteString where
  getName :: ByteString -> Name
getName = ByteString -> Name
Name (ByteString -> Name)
-> (ByteString -> ByteString) -> ByteString -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict