contrib/haskell/src/Hkl/Edf.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module Hkl.Edf
   4        ( Edf(..)
   5        , edfP
   6        , edfFromFile
   7        ) where
   8
   9 import Control.Applicative
  10 import Data.Attoparsec.Text
  11 import Data.ByteString.Char8 (readFile, split)
  12 import Data.Text (Text, words)
  13 import Data.Text.Encoding (decodeUtf8)
  14 import Numeric.Units.Dimensional.Prelude (Length, (*~), nano, meter)
  15
  16 import Prelude hiding (readFile, words)
  17
  18 data Edf = Edf { edf'Lambda :: Length Double
  19                , edf'MotorPos :: [Double]
  20                , edf'MotorMne :: [Text]
  21                }
  22          deriving (Show)
  23
  24 -- commentP :: Parser Text
  25 -- commentP =  "#" *> takeTill isEndOfLine <* endOfLine <?> "commentP"
  26
  27 -- headerP :: Parser [Text]
  28 -- headerP = many1 commentP <?> "headerP"
  29
  30 -- calibrantP :: Parser Text
  31 -- calibrantP = "calibrant: " *> takeTill isEndOfLine <* endOfLine <?> "calibrantP"
  32
  33 -- dspacingP :: Parser [Length Double]
  34 -- dspacingP = "dspacing:" *> many1 lengthP' <* endOfLine <?> "dspasingP"
  35
  36 -- doubleP :: Text -> Parser Double
  37 -- doubleP key = string key *> double <* endOfLine <?> "doubleP"
  38
  39 -- lengthP' :: Parser (Length Double)
  40 -- lengthP' = do
  41 --   skipSpace
  42 --   value <- double
  43 --   pure $ value *~ meter
  44
  45 -- lengthP :: Text -> Parser (Length Double)
  46 -- lengthP key = do
  47 --   value <- doubleP key
  48 --   pure $ value *~ meter
  49
  50 -- angleP :: Text -> Parser (Angle Double)
  51 -- angleP key = do
  52 --   value <-doubleP key
  53 --   pure $ value *~ radian
  54
  55 -- intP :: Text -> Parser Int
  56 -- intP key = string key *> decimal <* endOfLine <?> "intP"
  57
  58 -- nptPointP :: Parser NptPoint
  59 -- nptPointP = NptPoint
  60 --   <$> ("point: x=" *> double)
  61 --   <*> (" y=" *> double <* endOfLine)
  62
  63 -- nptEntryP :: Parser NptEntry
  64 -- nptEntryP = NptEntry
  65 --             <$> (skipSpace *> intP "New group of points: ")
  66 --             <*> angleP "2theta: "
  67 --             <*> intP "ring: "
  68 --             <*> many nptPointP
  69
  70 edf'LambdaP :: Parser (Length Double)
  71 edf'LambdaP = do
  72   _ <- manyTill anyChar (try $ string "Lambda = ")
  73   value <- double
  74   pure $ value *~ nano meter
  75
  76 edf'MotorPosP :: Parser [Double]
  77 edf'MotorPosP = do
  78   _ <- manyTill anyChar (try $ string "motor_pos = ")
  79   many1 (skipSpace *> double)
  80
  81 edf'MotorMneP :: Parser [Text]
  82 edf'MotorMneP = do
  83   _ <- manyTill anyChar (try $ string "motor_mne = ")
  84   vs <- takeTill (\c -> c == ';')
  85   return (words vs)
  86
  87 edfP :: Parser Edf
  88 edfP = Edf
  89        <$> edf'LambdaP
  90        <*> edf'MotorPosP
  91        <*> edf'MotorMneP
  92          <?> "edfP"
  93
  94 edfFromFile :: FilePath -> IO Edf
  95 edfFromFile filename = do
  96   content <- readFile filename
  97   let header = head (split '}' content)
  98   return $ case parseOnly edfP (decodeUtf8 header) of
  99     Left _     -> error $ "Can not parse the " ++ filename ++ " edf file"
 100     Right a -> a
 101
 102 main :: IO ()
 103 main = do
 104   edf <- edfFromFile "/home/picca/test.edf"
 105   print edf
 106   return ()