
  0 | module Text.Molfile.Writer.V3000
  1 | 
  2 | import Data.Linear.Traverse1
  3 | import Data.SortedMap
  4 | import Data.String
  5 | import Data.String.Builder
  6 | import Syntax.T1
  7 | import Text.Molfile.Types
  8 | import Text.Molfile.Writer.Util
  9 | import Text.Molfile.Writer.V2000
 10 | 
 11 | %hide Prelude.(>>)
 12 | 
 13 | %default total
 14 | 
 15 | export
 16 | dispStereoV3 : BondStereo -> String
 17 | dispStereoV3 NoBondStereo = "0"
 18 | dispStereoV3 Up           = "1"
 19 | dispStereoV3 Either       = "2"
 20 | dispStereoV3 Down         = "3"
 21 | 
 22 | parameters {auto b : Builder q}
 23 | 
 24 |   chrg : Charge -> F1' q
 25 |   chrg 0 = pure ()
 26 |   chrg c = putText " CHG=\{c}"
 27 | 
 28 |   rad : Radical -> F1' q
 29 |   rad NoRadical = pure ()
 30 |   rad r         = putText " RAD=\{dispRadical r}"
 31 | 
 32 |   mass : Isotope -> F1' q
 33 |   mass (MkI H (Just 2)) = linebreak
 34 |   mass (MkI H (Just 3)) = linebreak
 35 |   mass (MkI _ Nothing)  = linebreak
 36 |   mass (MkI _ (Just m)) = putTextLn " MASS=\{show m.value}"
 37 | 
 38 |   mv30 : F1' q
 39 |   mv30 = putText "M  V30 "
 40 | 
 41 |   begin, end : String -> F1' q
 42 |   begin s = mv30 >> putText "BEGIN " >> putTextLn s
 43 |   end   s = mv30 >> putText "END " >> putTextLn s
 44 | 
 45 |   fin : Fin k -> F1' q
 46 |   fin x = putText " \{show $ S $ finToNat x}"
 47 | 
 48 |   coordsV3 : Vect 3 Coordinate -> F1' q
 49 |   coordsV3 [x,y,z] =
 50 |     putText " \{dispCoordShort x} \{dispCoordShort y} \{dispCoordShort z} 0"
 51 | 
 52 |   counts : (na,nb,ng : Nat) -> F1' q
 53 |   counts na nb ng =
 54 |     mv30 >> putText "COUNTS " >>
 55 |     putShowSep na >> putShowSep nb >> putShow ng >>
 56 |     putTextLn " 0 0"
 57 | 
 58 |   atomV3 : Fin k -> Adj k MolBond (MolAtom' h t c) -> F1' q
 59 |   atomV3 n (A (MkAtom a c pos r _ _ _ l) _) =
 60 |     mv30 >> putShowSep (S $ finToNat n) >> putText (dispIso a) >>
 61 |     coordsV3 pos >> chrg c >> rad r >> mass a
 62 | 
 63 |   cfg : BondStereo -> F1' q
 64 |   cfg NoBondStereo = linebreak
 65 |   cfg x            = putTextLn " CFG=\{dispStereoV3 x}"
 66 | 
 67 |   bondsV3 : (Nat, Edge k MolBond) -> F1' q
 68 |   bondsV3 (n, E x y (MkBond b o s)) =
 69 |    let pre  := mv30 >> putShow (S n) >> putText " \{o}"
 70 |     in case b of
 71 |       True  => pre >> fin x >> fin y >> cfg s
 72 |       False => pre >> fin y >> fin x >> cfg s
 73 | 
 74 |   nats : List Nat -> F1' q
 75 |   nats ns =
 76 |     putText "(\{show $ length ns} " >> traverse1_ putShowSep ns >> putTextLn ")"
 77 | 
 78 |   groupV3 : (Nat,String,SnocList Nat) -> F1' q
 79 |   groupV3 (n,l,x) =
 80 |     mv30 >> putShow n >> putText " SUP 0 LABEL=\"\{l}\" ATOMS=" >> nats (x<>>[])
 81 | 
 82 |   export
 83 |   putMol3000 : List (Edge k MolBond) -> MolGraph' h t c -> F1' q
 84 |   putMol3000 es (G o g) = T1.do
 85 |     let gs := kvList $ foldrKV appendLbl empty g.graph
 86 |     putTextLn "00000999 V3000"
 87 |     begin "CTAB"
 88 |     counts o (length es) (length gs)
 89 |     begin "ATOM"
 90 |     traverseKV1_ atomV3 g.graph
 91 |     end   "ATOM"
 92 |     begin "BOND"
 93 |     traverse1_ bondsV3 $ zipWithIndex es
 94 |     end   "BOND"
 95 |     begin "SGROUP"
 96 |     traverse1_ groupV3 gs
 97 |     end   "SGROUP"
 98 |     end "CTAB"
 99 |