module Biobase.GeneticCodes
  ( module Biobase.GeneticCodes
  , module Biobase.GeneticCodes.Types
  , fromByteString
  , fromFile
  , geneticCodes
  , translate
  ) where

import Control.Lens
import Control.Monad.Except
import Data.List (find)
import Data.Text (pack)
import Data.Text (Text,isInfixOf,unpack)
import System.Directory (doesFileExist)
import Text.Printf
import System.Exit (exitSuccess)

import Biobase.GeneticCodes.Embedded
import Biobase.GeneticCodes.Import
import Biobase.GeneticCodes.Translation
import Biobase.GeneticCodes.Types



codeByTableID
  :: (MonadError String m)
  => [TranslationTable c a]
  -> Int
  -> m (TranslationTable c a)
codeByTableID :: [TranslationTable c a] -> Int -> m (TranslationTable c a)
codeByTableID [TranslationTable c a]
ts Int
i
  = m (TranslationTable c a)
-> (TranslationTable c a -> m (TranslationTable c a))
-> Maybe (TranslationTable c a)
-> m (TranslationTable c a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (TranslationTable c a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (TranslationTable c a))
-> String -> m (TranslationTable c a)
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"No TranslationTable with ID %d found!" Int
i) TranslationTable c a -> m (TranslationTable c a)
forall (m :: * -> *) a. Monad m => a -> m a
return
  (Maybe (TranslationTable c a) -> m (TranslationTable c a))
-> Maybe (TranslationTable c a) -> m (TranslationTable c a)
forall a b. (a -> b) -> a -> b
$ (TranslationTable c a -> Bool)
-> [TranslationTable c a] -> Maybe (TranslationTable c a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TranslationTable c a
t -> TranslationTable c a
tTranslationTable c a
-> Getting Int (TranslationTable c a) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (TranslationTable c a) Int
forall c a. Lens' (TranslationTable c a) Int
tableID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) [TranslationTable c a]
ts

codeByTableNameInfix
  :: (MonadError String m)
  => [TranslationTable c a]
  -> Text
  -> m (TranslationTable c a)
codeByTableNameInfix :: [TranslationTable c a] -> Text -> m (TranslationTable c a)
codeByTableNameInfix [TranslationTable c a]
ts Text
n
  = m (TranslationTable c a)
-> (TranslationTable c a -> m (TranslationTable c a))
-> Maybe (TranslationTable c a)
-> m (TranslationTable c a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (TranslationTable c a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (TranslationTable c a))
-> String -> m (TranslationTable c a)
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"No TranslationTable with Name infix %s found!" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
n) TranslationTable c a -> m (TranslationTable c a)
forall (m :: * -> *) a. Monad m => a -> m a
return
  (Maybe (TranslationTable c a) -> m (TranslationTable c a))
-> Maybe (TranslationTable c a) -> m (TranslationTable c a)
forall a b. (a -> b) -> a -> b
$ (TranslationTable c a -> Bool)
-> [TranslationTable c a] -> Maybe (TranslationTable c a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\TranslationTable c a
t -> Text
n Text -> Text -> Bool
`isInfixOf` (TranslationTable c a
tTranslationTable c a
-> Getting Text (TranslationTable c a) Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text (TranslationTable c a) Text
forall c a. Lens' (TranslationTable c a) Text
tableName)) [TranslationTable c a]
ts

-- | If the given filepath exists, then we try to load the genetic table from
-- the file. This will fail if there is not exactly one genetic table there. If
-- @fp@ is not a file, we try parsing @fp@ as a numeric ID and look for that
-- table. Finally we try finding an infix with that name.
--
-- This is all slightly "unsafe" but captures the most common scenario where we
-- either load such a table from file or need selection of the correct one.
--
-- If the given filepath is @"list"@, then a list of table id's and table names
-- is returned.

fromFileOrCached
  :: (MonadIO m, MonadError String m)
  => FilePath
  -> m (TranslationTable Char Char)
fromFileOrCached :: String -> m (TranslationTable Char Char)
fromFileOrCached String
fp = do
  Bool
dfe ← IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
  if | String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"list" -> do
          ((Int, Text) -> m ()) -> [(Int, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ((Int, Text) -> IO ()) -> (Int, Text) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> IO ()) -> (Int, Text) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Int -> Text -> IO ()
forall r. PrintfType r => String -> r
printf String
"%3d %s\n")) [ (TranslationTable Char Char
tTranslationTable Char Char
-> Getting Int (TranslationTable Char Char) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (TranslationTable Char Char) Int
forall c a. Lens' (TranslationTable c a) Int
tableID,TranslationTable Char Char
tTranslationTable Char Char
-> Getting Text (TranslationTable Char Char) Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text (TranslationTable Char Char) Text
forall c a. Lens' (TranslationTable c a) Text
tableName) | TranslationTable Char Char
t ← [TranslationTable Char Char]
geneticCodes ]
          IO (TranslationTable Char Char) -> m (TranslationTable Char Char)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TranslationTable Char Char)
forall a. IO a
exitSuccess
     | Bool
dfe -> String -> m [TranslationTable Char Char]
forall (m :: * -> *).
(MonadIO m, MonadError String m) =>
String -> m [TranslationTable Char Char]
fromFile String
fp m [TranslationTable Char Char]
-> ([TranslationTable Char Char] -> m (TranslationTable Char Char))
-> m (TranslationTable Char Char)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
         [TranslationTable Char Char
x] -> TranslationTable Char Char -> m (TranslationTable Char Char)
forall (m :: * -> *) a. Monad m => a -> m a
return TranslationTable Char Char
x
         [TranslationTable Char Char]
xs  -> String -> m (TranslationTable Char Char)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (TranslationTable Char Char))
-> String -> m (TranslationTable Char Char)
forall a b. (a -> b) -> a -> b
$ String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should contain exactly one translation table!"
     | [(Int
k,String
"")] <- ReadS Int
forall a. Read a => ReadS a
reads String
fp -> [TranslationTable Char Char]
-> Int -> m (TranslationTable Char Char)
forall (m :: * -> *) c a.
MonadError String m =>
[TranslationTable c a] -> Int -> m (TranslationTable c a)
codeByTableID [TranslationTable Char Char]
geneticCodes Int
k
     | Bool
otherwise -> [TranslationTable Char Char]
-> Text -> m (TranslationTable Char Char)
forall (m :: * -> *) c a.
MonadError String m =>
[TranslationTable c a] -> Text -> m (TranslationTable c a)
codeByTableNameInfix [TranslationTable Char Char]
geneticCodes (Text -> m (TranslationTable Char Char))
-> Text -> m (TranslationTable Char Char)
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
fp