From a911d2ad5b34b4944e2eb2843bc4942000a053b3 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Picca=20Fr=C3=83=C2=A9d=C3=83=C2=A9ric-Emmanuel?=
 <picca@debian.org>
Date: Sun, 11 Dec 2016 11:06:06 +0100
Subject: [PATCH] [contrib][haskell] add Edf support

---
 contrib/haskell/hkl.cabal      |  10 ++--
 contrib/haskell/src/Hkl/Edf.hs | 106 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+), 4 deletions(-)
 create mode 100644 contrib/haskell/src/Hkl/Edf.hs

diff --git a/contrib/haskell/hkl.cabal b/contrib/haskell/hkl.cabal
index 26e9fc10..85103377 100644
--- a/contrib/haskell/hkl.cabal
+++ b/contrib/haskell/hkl.cabal
@@ -22,7 +22,7 @@ Flag useHMatrixGsl
 executable ghkl
   main-is:             src/ghkl.hs
   build-depends:       attoparsec
-                     , base >= 4.6 && < 4.9
+                     , base >= 4.6 && < 4.10
                      , bindings-hdf5 >= 1.8.12
                      , containers >= 0.5 && < 0.6
                      , dimensional >= 0.10
@@ -45,7 +45,7 @@ executable ghkl
 executable xrd
   main-is:             src/xrd.hs
   build-depends:       attoparsec
-                     , base >= 4.6 && < 4.9
+                     , base >= 4.6 && < 4.10
                      , bindings-hdf5 >= 1.8.12
                      , containers >= 0.5 && < 0.6
                      , dimensional >= 0.10
@@ -58,6 +58,7 @@ executable xrd
                      , text
                      , transformers >= 0.3
                      , vector >= 0.10.0.1
+
   default-language:    Haskell2010
   pkgconfig-depends:   hkl
   build-tools:         hsc2hs
@@ -67,7 +68,7 @@ executable xrd
 
 executable hkl3d
   main-is:             src/hkl3d.hs
-  build-depends:       base >= 4.6 && < 4.9
+  build-depends:       base >= 4.6 && < 4.10
                      , bindings-hdf5 >= 1.8.12
                      , containers >= 0.5 && < 0.6
                      , dimensional >= 0.10
@@ -93,6 +94,7 @@ library
                     , Hkl.Diffabs
                     , Hkl.Diffabs.Martinetto
                     , Hkl.Diffabs.IRDRx
+                    , Hkl.Edf
                     , Hkl.Engine
                     , Hkl.H5
                     , Hkl.MyMatrix
@@ -114,7 +116,7 @@ library
                      , RecordWildCards
   build-depends:       async
                      , attoparsec
-                     , base >= 4.6 && < 4.9
+                     , base >= 4.6 && < 4.10
                      , bindings-hdf5 >= 1.8.12
                      , bytestring >= 0.10.0.2
                      , containers >= 0.5 && < 0.6
diff --git a/contrib/haskell/src/Hkl/Edf.hs b/contrib/haskell/src/Hkl/Edf.hs
new file mode 100644
index 00000000..78a2bdfc
--- /dev/null
+++ b/contrib/haskell/src/Hkl/Edf.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hkl.Edf
+       ( Edf(..)
+       , edfP
+       , edfFromFile
+       ) where
+
+import Control.Applicative
+import Data.Attoparsec.Text
+import Data.ByteString.Char8 (readFile, split)
+import Data.Text (Text, words)
+import Data.Text.Encoding (decodeUtf8)
+import Numeric.Units.Dimensional.Prelude (Length, (*~), nano, meter)
+
+import Prelude hiding (readFile, words)
+
+data Edf = Edf { edf'Lambda :: Length Double
+               , edf'MotorPos :: [Double]
+               , edf'MotorMne :: [Text]
+               }
+         deriving (Show)
+
+-- commentP :: Parser Text
+-- commentP =  "#" *> takeTill isEndOfLine <* endOfLine <?> "commentP"
+
+-- headerP :: Parser [Text]
+-- headerP = many1 commentP <?> "headerP"
+
+-- calibrantP :: Parser Text
+-- calibrantP = "calibrant: " *> takeTill isEndOfLine <* endOfLine <?> "calibrantP"
+
+-- dspacingP :: Parser [Length Double]
+-- dspacingP = "dspacing:" *> many1 lengthP' <* endOfLine <?> "dspasingP"
+
+-- doubleP :: Text -> Parser Double
+-- doubleP key = string key *> double <* endOfLine <?> "doubleP"
+
+-- lengthP' :: Parser (Length Double)
+-- lengthP' = do
+--   skipSpace
+--   value <- double
+--   pure $ value *~ meter
+
+-- lengthP :: Text -> Parser (Length Double)
+-- lengthP key = do
+--   value <- doubleP key
+--   pure $ value *~ meter
+
+-- angleP :: Text -> Parser (Angle Double)
+-- angleP key = do
+--   value <-doubleP key
+--   pure $ value *~ radian
+
+-- intP :: Text -> Parser Int
+-- intP key = string key *> decimal <* endOfLine <?> "intP"
+
+-- nptPointP :: Parser NptPoint
+-- nptPointP = NptPoint
+--   <$> ("point: x=" *> double)
+--   <*> (" y=" *> double <* endOfLine)
+
+-- nptEntryP :: Parser NptEntry
+-- nptEntryP = NptEntry
+--             <$> (skipSpace *> intP "New group of points: ")
+--             <*> angleP "2theta: "
+--             <*> intP "ring: "
+--             <*> many nptPointP
+
+edf'LambdaP :: Parser (Length Double)
+edf'LambdaP = do
+  _ <- manyTill anyChar (try $ string "Lambda = ")
+  value <- double
+  pure $ value *~ nano meter
+
+edf'MotorPosP :: Parser [Double]
+edf'MotorPosP = do
+  _ <- manyTill anyChar (try $ string "motor_pos = ")
+  many1 (skipSpace *> double)
+
+edf'MotorMneP :: Parser [Text]
+edf'MotorMneP = do
+  _ <- manyTill anyChar (try $ string "motor_mne = ")
+  vs <- takeTill (\c -> c == ';') 
+  return (words vs)
+
+edfP :: Parser Edf
+edfP = Edf
+       <$> edf'LambdaP
+       <*> edf'MotorPosP
+       <*> edf'MotorMneP
+         <?> "edfP"
+
+edfFromFile :: FilePath -> IO Edf
+edfFromFile filename = do
+  content <- readFile filename
+  let header = head (split '}' content)
+  return $ case parseOnly edfP (decodeUtf8 header) of
+    Left _     -> error $ "Can not parse the " ++ filename ++ " edf file"
+    Right a -> a
+
+main :: IO ()
+main = do
+  edf <- edfFromFile "/home/picca/test.edf"
+  print edf
+  return ()
-- 
2.11.4.GIT