-- | Wrapper newtype to simplify pretty and short encoding of primary
-- sequences.

module Biobase.Primary.Pretty where

import           Data.Aeson
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import qualified Data.Text as T

import Biobase.Primary.Letter



newtype Pretty f a = Pretty { Pretty f a -> f a
getPretty :: f a }

instance (LetterChar x n) => ToJSON (Pretty VU.Vector (Letter x n)) where
  toJSON :: Pretty Vector (Letter x n) -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Pretty Vector (Letter x n) -> Text)
-> Pretty Vector (Letter x n)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Pretty Vector (Letter x n) -> String)
-> Pretty Vector (Letter x n)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Letter x n -> Char) -> [Letter x n] -> String
forall a b. (a -> b) -> [a] -> [b]
map Letter x n -> Char
forall k t (n :: k). LetterChar t n => Letter t n -> Char
letterChar ([Letter x n] -> String)
-> (Pretty Vector (Letter x n) -> [Letter x n])
-> Pretty Vector (Letter x n)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Letter x n) -> [Letter x n]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector (Letter x n) -> [Letter x n])
-> (Pretty Vector (Letter x n) -> Vector (Letter x n))
-> Pretty Vector (Letter x n)
-> [Letter x n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty Vector (Letter x n) -> Vector (Letter x n)
forall k (f :: k -> *) (a :: k). Pretty f a -> f a
getPretty

instance (LetterChar x n) => ToJSON (Pretty V.Vector (Letter x n)) where
  toJSON :: Pretty Vector (Letter x n) -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Pretty Vector (Letter x n) -> Text)
-> Pretty Vector (Letter x n)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Pretty Vector (Letter x n) -> String)
-> Pretty Vector (Letter x n)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Letter x n -> Char) -> [Letter x n] -> String
forall a b. (a -> b) -> [a] -> [b]
map Letter x n -> Char
forall k t (n :: k). LetterChar t n => Letter t n -> Char
letterChar ([Letter x n] -> String)
-> (Pretty Vector (Letter x n) -> [Letter x n])
-> Pretty Vector (Letter x n)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Letter x n) -> [Letter x n]
forall a. Vector a -> [a]
V.toList (Vector (Letter x n) -> [Letter x n])
-> (Pretty Vector (Letter x n) -> Vector (Letter x n))
-> Pretty Vector (Letter x n)
-> [Letter x n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty Vector (Letter x n) -> Vector (Letter x n)
forall k (f :: k -> *) (a :: k). Pretty f a -> f a
getPretty

instance (LetterChar x n, VS.Storable (Letter x n)) => ToJSON (Pretty VS.Vector (Letter x n)) where
  toJSON :: Pretty Vector (Letter x n) -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Pretty Vector (Letter x n) -> Text)
-> Pretty Vector (Letter x n)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Pretty Vector (Letter x n) -> String)
-> Pretty Vector (Letter x n)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Letter x n -> Char) -> [Letter x n] -> String
forall a b. (a -> b) -> [a] -> [b]
map Letter x n -> Char
forall k t (n :: k). LetterChar t n => Letter t n -> Char
letterChar ([Letter x n] -> String)
-> (Pretty Vector (Letter x n) -> [Letter x n])
-> Pretty Vector (Letter x n)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Letter x n) -> [Letter x n]
forall a. Storable a => Vector a -> [a]
VS.toList (Vector (Letter x n) -> [Letter x n])
-> (Pretty Vector (Letter x n) -> Vector (Letter x n))
-> Pretty Vector (Letter x n)
-> [Letter x n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty Vector (Letter x n) -> Vector (Letter x n)
forall k (f :: k -> *) (a :: k). Pretty f a -> f a
getPretty

instance (LetterChar x n) => ToJSON (Pretty [] (Letter x n)) where
  toJSON :: Pretty [] (Letter x n) -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Pretty [] (Letter x n) -> Text)
-> Pretty [] (Letter x n)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Pretty [] (Letter x n) -> String)
-> Pretty [] (Letter x n)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Letter x n -> Char) -> [Letter x n] -> String
forall a b. (a -> b) -> [a] -> [b]
map Letter x n -> Char
forall k t (n :: k). LetterChar t n => Letter t n -> Char
letterChar ([Letter x n] -> String)
-> (Pretty [] (Letter x n) -> [Letter x n])
-> Pretty [] (Letter x n)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty [] (Letter x n) -> [Letter x n]
forall k (f :: k -> *) (a :: k). Pretty f a -> f a
getPretty