module Bio.Molecule
  ( Molecule(..)
  , MoleculeLike(..)
  , singleton
  ) where

import           Control.Lens                   ( (^?)
                                                , Index
                                                , IxValue
                                                , Ixed (..)
                                                , lens
                                                , (&)
                                                , (.~)
                                                )

newtype Molecule t c = Molecule { forall t c. Molecule t c -> [(t, c)]
getChains :: [(t, c)] }
  deriving (Int -> Molecule t c -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t c. (Show t, Show c) => Int -> Molecule t c -> ShowS
forall t c. (Show t, Show c) => [Molecule t c] -> ShowS
forall t c. (Show t, Show c) => Molecule t c -> String
showList :: [Molecule t c] -> ShowS
$cshowList :: forall t c. (Show t, Show c) => [Molecule t c] -> ShowS
show :: Molecule t c -> String
$cshow :: forall t c. (Show t, Show c) => Molecule t c -> String
showsPrec :: Int -> Molecule t c -> ShowS
$cshowsPrec :: forall t c. (Show t, Show c) => Int -> Molecule t c -> ShowS
Show, Molecule t c -> Molecule t c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t c. (Eq t, Eq c) => Molecule t c -> Molecule t c -> Bool
/= :: Molecule t c -> Molecule t c -> Bool
$c/= :: forall t c. (Eq t, Eq c) => Molecule t c -> Molecule t c -> Bool
== :: Molecule t c -> Molecule t c -> Bool
$c== :: forall t c. (Eq t, Eq c) => Molecule t c -> Molecule t c -> Bool
Eq)

type instance Index (Molecule t c) = t
type instance IxValue (Molecule t c) = c

class (Eq (Index m), Ixed m) => MoleculeLike m where
    -- | Create empty molecule without chains
    --
    empty :: m
    -- | Delete chain with specified index (returns error if chain doesn't present)
    --
    deleteAt :: m -> Index m -> m
    -- | Create chain with specified index (returns error if chain is already present)
    --
    create :: m -> Index m -> IxValue m -> m
    -- | Set new chain with speficied index (creates new if does not present)
    --
    set :: m -> Index m -> IxValue m -> m

-- | Create molecule with single chain
--
singleton :: MoleculeLike m => Index m -> IxValue m -> m
singleton :: forall m. MoleculeLike m => Index m -> IxValue m -> m
singleton = forall m. MoleculeLike m => m -> Index m -> IxValue m -> m
create forall m. MoleculeLike m => m
empty

instance Eq t => Ixed (Molecule t c) where
    ix :: Index (Molecule t c)
-> Traversal' (Molecule t c) (IxValue (Molecule t c))
ix Index (Molecule t c)
idx = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Index (Molecule t c)
idx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t c. Molecule t c -> [(t, c)]
getChains) (\(Molecule [(t, c)]
m) Maybe c
my -> forall t c. [(t, c)] -> Molecule t c
Molecule forall a b. (a -> b) -> a -> b
$ Maybe c -> [(t, c)] -> [(t, c)]
setL Maybe c
my [(t, c)]
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
      where
        setL :: Maybe c -> [(t, c)] -> [(t, c)]
        setL :: Maybe c -> [(t, c)] -> [(t, c)]
setL Maybe c
Nothing  [(t, c)]
xs = [(t, c)]
xs
        setL (Just c
_) [] = forall a. HasCallStack => String -> a
error String
"Chain should be present"
        setL y :: Maybe c
y@(Just c
a) ((t
x', c
y') : [(t, c)]
xs) | t
x' forall a. Eq a => a -> a -> Bool
== Index (Molecule t c)
idx = (Index (Molecule t c)
idx, c
a) forall a. a -> [a] -> [a]
: [(t, c)]
xs
                                        | Bool
otherwise = (t
x', c
y') forall a. a -> [a] -> [a]
: Maybe c -> [(t, c)] -> [(t, c)]
setL Maybe c
y [(t, c)]
xs

instance Eq t => MoleculeLike (Molecule t c) where
    empty :: Molecule t c
empty = forall t c. [(t, c)] -> Molecule t c
Molecule []

    deleteAt :: Molecule t c -> Index (Molecule t c) -> Molecule t c
deleteAt (Molecule [(t, c)]
xs) Index (Molecule t c)
idx = forall t c. [(t, c)] -> Molecule t c
Molecule forall a b. (a -> b) -> a -> b
$ [(t, c)] -> [(t, c)]
deleteFromList [(t, c)]
xs
      where
        deleteFromList :: [(t, c)] -> [(t, c)]
        deleteFromList :: [(t, c)] -> [(t, c)]
deleteFromList [] = forall a. HasCallStack => String -> a
error String
"Chain is not present"
        deleteFromList (a :: (t, c)
a@(t
x', c
_) : [(t, c)]
ys) | t
x' forall a. Eq a => a -> a -> Bool
== Index (Molecule t c)
idx = [(t, c)]
ys
                                        | Bool
otherwise = (t, c)
a forall a. a -> [a] -> [a]
: [(t, c)] -> [(t, c)]
deleteFromList [(t, c)]
ys

    create :: Molecule t c
-> Index (Molecule t c) -> IxValue (Molecule t c) -> Molecule t c
create (Molecule [(t, c)]
xs) Index (Molecule t c)
idx IxValue (Molecule t c)
c = forall t c. [(t, c)] -> Molecule t c
Molecule forall a b. (a -> b) -> a -> b
$ [(t, c)] -> [(t, c)]
createInList [(t, c)]
xs
      where
        createInList :: [(t, c)] -> [(t, c)]
        createInList :: [(t, c)] -> [(t, c)]
createInList [] = [(Index (Molecule t c)
idx, IxValue (Molecule t c)
c)]
        createInList (a :: (t, c)
a@(t
x', c
_) : [(t, c)]
ys)
            | t
x' forall a. Eq a => a -> a -> Bool
== Index (Molecule t c)
idx = forall a. HasCallStack => String -> a
error String
"Chain should not be present at molecule"
            | Bool
otherwise = (t, c)
a forall a. a -> [a] -> [a]
: [(t, c)] -> [(t, c)]
createInList [(t, c)]
ys

    set :: Molecule t c
-> Index (Molecule t c) -> IxValue (Molecule t c) -> Molecule t c
set Molecule t c
m Index (Molecule t c)
idx IxValue (Molecule t c)
c = case Molecule t c
m forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Molecule t c)
idx of
        Maybe c
Nothing -> forall m. MoleculeLike m => m -> Index m -> IxValue m -> m
create Molecule t c
m Index (Molecule t c)
idx IxValue (Molecule t c)
c
        Just c
_  -> Molecule t c
m forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Molecule t c)
idx forall s t a b. ASetter s t a b -> b -> s -> t
.~ IxValue (Molecule t c)
c