contrib/haskell/src/hkl.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3 {-
   4     Copyright  : Copyright (C) 2014-2016 Synchrotron Soleil
   5     License    : GPL3+
   6
   7     Maintainer : picca@synchrotron-soleil.fr
   8     Stability  : Experimental
   9     Portability: GHC only?
  10 -}
  11
  12 import Numeric.LinearAlgebra (Vector, Matrix,
  13                               vecdisp, disps,
  14                               dispf)
  15
  16 import Numeric.Units.Dimensional.Prelude (nano, meter, degree,
  17                                           (*~),
  18                                           (*~~), (/~~))
  19
  20 import Options.Applicative hiding ((<>))
  21
  22 import Hkl.Lattice
  23 import Hkl.Diffractometer
  24
  25 dispv :: Vector Double -> IO ()
  26 dispv = putStr . vecdisp (disps 2)
  27
  28 disp :: Matrix Double -> IO ()
  29 disp = putStr . dispf 3
  30
  31 -- command parsing
  32 data Command
  33     = Ca Double Double Double -- ca command
  34
  35 data Options
  36     = Options Command
  37
  38 withInfo :: Parser a -> String -> ParserInfo a
  39 withInfo opts desc = info (helper <*> opts) $ progDesc desc
  40
  41 parseCa :: Parser Command
  42 parseCa = Ca
  43     <$> argument auto (metavar "H")
  44     <*> argument auto (metavar "K")
  45     <*> argument auto (metavar "L")
  46
  47 parseCommand :: Parser Command
  48 parseCommand = subparser $
  49     command "ca"   (parseCa `withInfo` "compute angles for the given hkl")
  50
  51 parseOptions :: Parser Options
  52 parseOptions = Options <$> parseCommand
  53
  54 -- Actual program logic
  55 run :: Options -> IO ()
  56 run (Options cmd) =
  57     case cmd of
  58         Ca h k l-> do
  59            print (solution /~~ degree)
  60            dispv (computeHkl e4c solution lattice)
  61            disp path
  62                where
  63                  (sol, path) = computeAngles e4c angles lattice mode [h, k, l]
  64                  s = [30.0, 0.0, 0.0, 0.0, 10.0, 0.0]
  65                  d = [60.0]
  66                  angles = (s ++ d) *~~ degree
  67                  solution = fromMode mode sol angles
  68                  lattice = Cubic (1.54 *~ nano meter)
  69                  mode = ModeHklE4CConstantPhi
  70
  71 main :: IO ()
  72 main = run =<< execParser
  73     (parseOptions `withInfo` "Interact with hkl API")