diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,18 @@ ## Unreleased changes +## [0.1.1.7] - 2021-10-06 +### Added +- `Complementary` instance for `Char`. + +## [0.1.1.6] - 2021-09-14 +### Added +- `ChainLike` instance for `Vector` + +## [0.1.1.5] - 2021-07-03 +### Changed +- `*` -> `Type` for GHC-9. + ## [0.1.1.4] - 2020-04-30 ### Fixed - Tweak `package.yaml` to make `stack-2.3.1` happy. diff --git a/cobot.cabal b/cobot.cabal --- a/cobot.cabal +++ b/cobot.cabal @@ -1,13 +1,13 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: 4089a1d80a81d96aba9533cda10ea42186142528d17846553acc98dcd7bf43b0 +-- hash: 09eef6fbd0d4093057c44a56242d5c569842b42a1e49c3625efc6d01f1471d9f name: cobot -version: 0.1.1.4 +version: 0.1.1.7 synopsis: Computational biology toolkit to collaborate with researchers in constructive protein engineering description: Please see the README on GitHub at category: Bio @@ -57,10 +57,27 @@ Paths_cobot hs-source-dirs: src - default-extensions: AllowAmbiguousTypes ConstraintKinds DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiWayIf RankNTypes RecordWildCards ScopedTypeVariables TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances + default-extensions: + AllowAmbiguousTypes + ConstraintKinds + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + MultiWayIf + RankNTypes + RecordWildCards + ScopedTypeVariables + TypeApplications + TypeFamilies + TypeSynonymInstances + UndecidableInstances build-depends: array - , base >=4.7 && <5 + , base >=4.9 && <5 , bytestring , containers , deepseq @@ -71,6 +88,7 @@ , split , template-haskell , text + , vector default-language: Haskell2010 test-suite cobot-test @@ -82,11 +100,28 @@ Paths_cobot hs-source-dirs: test - default-extensions: AllowAmbiguousTypes ConstraintKinds DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiWayIf RankNTypes RecordWildCards ScopedTypeVariables TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances + default-extensions: + AllowAmbiguousTypes + ConstraintKinds + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + MultiWayIf + RankNTypes + RecordWildCards + ScopedTypeVariables + TypeApplications + TypeFamilies + TypeSynonymInstances + UndecidableInstances ghc-options: -threaded -rtsopts "-with-rtsopts=-A64m -qb0 -I0 -N -qn4" build-depends: array - , base >=4.7 && <5 + , base >=4.9 && <5 , bytestring , cobot , containers @@ -99,6 +134,7 @@ , split , template-haskell , text + , vector default-language: Haskell2010 benchmark cobot-bench @@ -108,11 +144,29 @@ Paths_cobot hs-source-dirs: bench - default-extensions: AllowAmbiguousTypes ConstraintKinds DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiWayIf RankNTypes RecordWildCards ScopedTypeVariables TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances OverloadedStrings + default-extensions: + AllowAmbiguousTypes + ConstraintKinds + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + MultiWayIf + RankNTypes + RecordWildCards + ScopedTypeVariables + TypeApplications + TypeFamilies + TypeSynonymInstances + UndecidableInstances + OverloadedStrings ghc-options: -threaded -rtsopts "-with-rtsopts=-A64m -qb0 -I0 -N -qn4" build-depends: array - , base >=4.7 && <5 + , base >=4.9 && <5 , bytestring , clock , cobot @@ -128,4 +182,5 @@ , split , template-haskell , text + , vector default-language: Haskell2010 diff --git a/src/Bio/Chain.hs b/src/Bio/Chain.hs --- a/src/Bio/Chain.hs +++ b/src/Bio/Chain.hs @@ -7,17 +7,10 @@ ) where import Control.Lens -import qualified Data.Array as A ( bounds - , assocs - ) -import Data.Array ( Array - , Ix - , array - , listArray - , (!) - , (//) - ) -import Data.Array.Base (unsafeAt) +import Data.Array (Array, Ix, array, listArray, (!), (//)) +import qualified Data.Array as A (assocs, bounds) +import Data.Array.Base (unsafeAt) +import qualified Data.Vector as V type Chain i a = Array i a @@ -48,9 +41,9 @@ assocs = zip [0..] - modify _ _ [] = [] - modify 0 f (x:xs) = f x:xs - modify i f (x:xs) = x:modify (i - 1) f xs + modify _ _ [] = [] + modify 0 f (x:xs) = f x:xs + modify i f (x:xs) = x:modify (i - 1) f xs modifyBefore i f lst = (f <$> take i lst) ++ drop i lst modifyAfter i f lst = take (i + 1) lst ++ (f <$> drop (i + 1) lst) @@ -71,6 +64,25 @@ {-# INLINE unsafeRead #-} unsafeRead = unsafeReadArray + +instance ChainLike (V.Vector a) where + bounds v = (0, V.length v - 1) + + assocs = zip [0..] . V.toList + + modify i f ar = ar V.// [(i, f (ar V.! i))] + + modifyBefore i f ar = fmap f before <> after + where + (before, after) = V.splitAt i ar + + modifyAfter i f ar = before <> fmap f after + where + (before, after) = V.splitAt (i + 1) ar + + {-# INLINE unsafeRead #-} + unsafeRead = V.unsafeIndex + class (Ixed m) => UnsafeReadArray m where unsafeReadArray :: m -> Index m -> IxValue m diff --git a/src/Bio/Chain/Alignment/Scoring/TH.hs b/src/Bio/Chain/Alignment/Scoring/TH.hs --- a/src/Bio/Chain/Alignment/Scoring/TH.hs +++ b/src/Bio/Chain/Alignment/Scoring/TH.hs @@ -2,11 +2,11 @@ {-# LANGUAGE TemplateHaskell #-} module Bio.Chain.Alignment.Scoring.TH where -import Data.Char (toLower) -import Language.Haskell.TH -import Language.Haskell.TH.Quote +import Data.Char (toLower, toUpper) +import Language.Haskell.TH +import Language.Haskell.TH.Quote -import Bio.Chain.Alignment.Scoring.Loader +import Bio.Chain.Alignment.Scoring.Loader type Substitution a = a -> a -> Int @@ -46,11 +46,19 @@ functionDec name txt = do let subM = loadMatrix txt funName <- newName (toLower <$> name) let funSign = SigD funName (AppT (ConT ''Substitution) (ConT ''Char)) - let clauses = mkClause <$> subM + let clauses = concatMap mkClause subM let funDecl = FunD funName clauses return (funName, [funSign, funDecl]) -mkClause :: ((Char, Char), Int) -> Clause -mkClause ((c, d), i) = Clause [litC c, litC d] (NormalB (litI i)) [] - where litC = LitP . CharL - litI = LitE . IntegerL . fromIntegral +mkClause :: ((Char, Char), Int) -> [Clause] +mkClause ((c, d), i) = fmap (\pair -> Clause pair (NormalB (litI i)) []) casePairs + where + litC = LitP . CharL + litI = LitE . IntegerL . fromIntegral + + casingFunctions :: [Char -> Pat] + casingFunctions = [litC . toUpper, litC . toLower] + + casePairs :: [[Pat]] + casePairs = [ [f c, g d] | f <- casingFunctions, g <- casingFunctions ] + diff --git a/src/Bio/Chain/Alignment/Type.hs b/src/Bio/Chain/Alignment/Type.hs --- a/src/Bio/Chain/Alignment/Type.hs +++ b/src/Bio/Chain/Alignment/Type.hs @@ -7,6 +7,7 @@ import Control.DeepSeq (NFData (..)) import Control.Lens (Index, IxValue) import Data.Array.Unboxed (Ix, UArray) +import Data.Kind (Type) import GHC.Generics (Generic (..)) -- | Scoring function, returns substitution score for a couple of elements @@ -152,7 +153,7 @@ -- |Method of sequence alignment -- -class SequenceAlignment (a :: * -> * -> *) where +class SequenceAlignment (a :: Type -> Type -> Type) where -- | Defines wheater the alignment is semiglobal or not -- semi :: a e1 e2 -> Bool diff --git a/src/Bio/NucleicAcid/Nucleotide/Type.hs b/src/Bio/NucleicAcid/Nucleotide/Type.hs --- a/src/Bio/NucleicAcid/Nucleotide/Type.hs +++ b/src/Bio/NucleicAcid/Nucleotide/Type.hs @@ -9,13 +9,17 @@ , Complementary (..) ) where -import Control.DeepSeq (NFData) -import Control.Lens (Iso', iso) -import Data.Array (Array, Ix, bounds, listArray) -import Data.Foldable (Foldable (..)) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData) +import Control.Lens (Iso', iso) +import Data.Array (Array, Ix, bounds, ixmap, listArray) +import Data.Foldable (Foldable (..)) +import GHC.Generics (Generic) -data DNA = DA | DC | DG | DT +data DNA + = DA + | DC + | DG + | DT deriving (Eq, Ord, Bounded, Enum, Generic, NFData) instance Show DNA where @@ -24,7 +28,11 @@ show DG = "Guanine" show DT = "Thymine" -data RNA = RA | RC | RG | RU +data RNA + = RA + | RC + | RG + | RU deriving (Eq, Ord, Bounded, Enum, Generic, NFData) instance Show RNA where @@ -80,15 +88,35 @@ rcNA = cNA +instance Complementary Char where + cNA 'A' = 'T' + cNA 'C' = 'G' + cNA 'G' = 'C' + cNA 'T' = 'A' + cNA 'a' = 't' + cNA 'c' = 'g' + cNA 'g' = 'c' + cNA 't' = 'a' + cNA c = c + + rcNA = cNA + instance Complementary a => Complementary [a] where cNA = fmap cNA rcNA = reverse . cNA -instance (Complementary a, Ix i) => Complementary (Array i a) where +instance {-# OVERLAPPABLE #-} (Complementary a, Ix i) => Complementary (Array i a) where cNA = fmap cNA rcNA l = listArray (bounds l) rl where rl = rcNA . toList $ l + +instance {-# OVERLAPPING #-} (Complementary a) => Complementary (Array Int a) where + cNA = fmap cNA + + rcNA l = cNA $ ixmap (lo, hi) (\i -> lo + (hi - i)) l + where + (lo, hi) = bounds l diff --git a/src/Bio/Protein/AminoAcid/Instances.hs b/src/Bio/Protein/AminoAcid/Instances.hs --- a/src/Bio/Protein/AminoAcid/Instances.hs +++ b/src/Bio/Protein/AminoAcid/Instances.hs @@ -11,6 +11,7 @@ Lens', coerced, to, (^.)) import Data.Array (Array, listArray) import Data.Coerce (coerce) +import Data.Kind (Type) import Data.String (IsString (..)) ------------------------------------------------------------------------------- @@ -20,7 +21,7 @@ -- | Single object can be created -- class Createable a where - type Create a :: * + type Create a :: Type -- | Function to create single object -- create :: Create a @@ -80,7 +81,7 @@ -- | Has lens to observe, set and modify radicals -- class Functor r => HasRadical r where - type RadicalType r a :: * + type RadicalType r a :: Type -- | Lens for radical atom or group -- radical :: (Functor f, Functor g) => Lens' (AminoAcid f (Env r) g a) (RadicalType r a) diff --git a/src/Bio/Protein/Chain/Builder.hs b/src/Bio/Protein/Chain/Builder.hs --- a/src/Bio/Protein/Chain/Builder.hs +++ b/src/Bio/Protein/Chain/Builder.hs @@ -7,6 +7,7 @@ import Control.Lens import Data.Ix (Ix) +import Data.Kind (Type) import Linear.V3 (V3 (..), _z) import Linear.Vector (negated, unit, (*^)) @@ -15,7 +16,7 @@ import Bio.Utils.Geometry hiding (angle) class Buildable a where - type Monomer a :: * + type Monomer a :: Type initB :: Monomer a -> a nextB :: Monomer a -> a -> a diff --git a/src/Bio/Protein/Metric.hs b/src/Bio/Protein/Metric.hs --- a/src/Bio/Protein/Metric.hs +++ b/src/Bio/Protein/Metric.hs @@ -2,6 +2,7 @@ ( Metricable (..) ) where +import Data.Kind ( Type ) import Data.Monoid ( First (..) ) import Control.Lens import Bio.Utils.Geometry ( V3R @@ -10,7 +11,7 @@ import qualified Bio.Utils.Geometry as G class Metricable m where - type ReturnMetric m :: * + type ReturnMetric m :: Type distance :: Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R angle :: Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R dihedral :: Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting m a V3R -> Getting (ReturnMetric m) a R