Move about internal and external modules

diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal
index f724796e850e5307298a77b732933d464d327c5b..7deb60eb507226b149236d15644ae1df2225c186 100644 (file)
--- a/haskell-lsp-test.cabal
+++ b/haskell-lsp-test.cabal
@@ -10,55 +10,46 @@ maintainer:          luke_lau@icloud.com
 copyright:           2018 Luke Lau
 category:            Testing
 build-type:          Simple
-cabal-version:       >=1.10
+cabal-version:       >=2.0
 extra-source-files:  README.md
 
 library
-  hs-source-dirs:      src
+  hs-source-dirs:      lib
   exposed-modules:     Language.Haskell.LSP.Test
                      , Language.Haskell.LSP.Test.Replay
+                     , Language.Haskell.LSP.Test.Machine
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , haskell-lsp-types
                      , haskell-lsp >= 0.3
+                     , haskell-lsp-test-internal
                      , aeson
-                     , ansi-terminal
-                     , async
                      , bytestring
-                     , conduit
-                     , conduit-parse
                      , containers
                      , data-default
                      , directory
                      , filepath
                      , lens
-                     , mtl
                      , parser-combinators
-                     , process
                      , text
-                     , transformers
                      , unordered-containers
                      , yi-rope
-  if os(windows)
-    build-depends:     Win32
-  else
-    build-depends:     unix
-  other-modules:       Language.Haskell.LSP.Test.Compat
+
+  ghc-options:         -W
+
+library haskell-lsp-test-internal
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  exposed-modules:     Language.Haskell.LSP.Test.Compat
                        Language.Haskell.LSP.Test.Decoding
                        Language.Haskell.LSP.Test.Exceptions
                        Language.Haskell.LSP.Test.Files
-                       Language.Haskell.LSP.Test.Machine
                        Language.Haskell.LSP.Test.Messages
                        Language.Haskell.LSP.Test.Parsing
+                       Language.Haskell.LSP.Test.Script
                        Language.Haskell.LSP.Test.Server
                        Language.Haskell.LSP.Test.Session
-  ghc-options:         -W
-
-executable lsp-test
-  hs-source-dirs:     src
-  main-is:            Language/Haskell/LSP/Test/Script.hs
-  default-language:   Haskell2010
-  build-depends:      base >= 4.7 && < 5
+  build-depends:       base
                      , haskell-lsp-types
                      , haskell-lsp >= 0.3
                      , aeson
@@ -73,17 +64,36 @@ executable lsp-test
                      , filepath
                      , lens
                      , mtl
+                     , scientific
                      , parser-combinators
                      , process
                      , text
                      , transformers
                      , unordered-containers
-                    , scientific
                      , yi-rope
   if os(windows)
     build-depends:     Win32
   else
     build-depends:     unix
+  ghc-options:         -W
+
+
+executable lsp-test
+  hs-source-dirs:     lsp-test
+  main-is:            Main.hs
+  default-language:   Haskell2010
+  build-depends:      base >= 4.7 && < 5
+                    , haskell-lsp-types
+                    , haskell-lsp >= 0.3
+                    , haskell-lsp-test-internal
+                    , haskell-lsp-test
+                    , aeson
+                    , bytestring
+                    , directory
+                    , filepath
+                    , text
+                    , unordered-containers
+                    , scientific
 
 test-suite tests
   type:                exitcode-stdio-1.0
@@ -96,6 +106,7 @@ test-suite tests
                      , data-default
                      , directory
                      , haskell-lsp-test
+                     , haskell-lsp-test-internal
                      , haskell-lsp
                      , haskell-lsp-types
                      , conduit

diff --git a/src/Language/Haskell/LSP/Test.hs b/lib/Language/Haskell/LSP/Test.hs
similarity index 100%
rename from src/Language/Haskell/LSP/Test.hs
rename to lib/Language/Haskell/LSP/Test.hs

diff --git a/src/Language/Haskell/LSP/Test/Machine.hs b/lib/Language/Haskell/LSP/Test/Machine.hs
similarity index 100%
rename from src/Language/Haskell/LSP/Test/Machine.hs
rename to lib/Language/Haskell/LSP/Test/Machine.hs

diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/lib/Language/Haskell/LSP/Test/Replay.hs
similarity index 100%
rename from src/Language/Haskell/LSP/Test/Replay.hs
rename to lib/Language/Haskell/LSP/Test/Replay.hs

diff --git a/lsp-test/Main.hs b/lsp-test/Main.hs
new file mode 100644 (file)
index 0000000..6dc0690
--- /dev/null
+++ b/lsp-test/Main.hs
@@ -0,0 +1,62 @@
+module Main where
+
+import           Control.Monad
+import           Data.Aeson
+import qualified Data.Text                     as T
+import qualified Data.HashMap.Lazy             as HM
+import           Language.Haskell.LSP.Test
+import           Language.Haskell.LSP.Test.Script
+import           System.Environment
+import           System.FilePath
+import           System.Directory
+import           Language.Haskell.LSP.Test.Machine
+import           Language.Haskell.LSP.Test.Parsing ( toJSONMsg )
+import           Language.Haskell.LSP.Messages
+import qualified Language.Haskell.LSP.Types    as LSP
+
+main = do
+  fileName <- head <$> getArgs
+  blocks <- parseScript <$> readFile fileName
+  print blocks
+  rootDir <- getCurrentDirectory
+  runBlocks rootDir blocks
+
+runBlocks :: FilePath -> [Block] -> IO ()
+runBlocks rootDir blocks = runMachine rootDir (map convertBlock blocks) >>= putStrLn
+  where
+    convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
+    convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
+
+    mkWait :: Wait -> FromServerMessage -> Bool
+    mkWait WaitAny _ = True
+    mkWait (WaitPred preds) x = all (`mkPred` x) preds
+
+    mkPred :: Predicate -> (FromServerMessage -> Bool)
+    mkPred (Predicate accessor comparison) msg =
+      let (Object obj) = toJSONMsg msg in comp (access obj accessor) comparison
+
+    comp (Just (String str)) (EqualsString expected) = str == T.pack expected
+    comp (Just (Number num)) (EqualsNumber expected) = num == expected
+    comp _ _ = False
+
+    access :: Object -> Accessor -> Maybe Value
+    access obj (AccessorTerm prop) = HM.lookup (T.pack prop) obj
+    access obj (Accessor prop next) =
+      case HM.lookup (T.pack prop) obj of
+        Just (Object nextObj) -> access nextObj next
+        _ -> Nothing
+
+    mkAction :: Action -> Session ()
+
+    mkAction (OpenDoc fp fileType) = void $ openDoc fp fileType
+
+    mkAction (Request identifier methodStr ps) = void $ sendRequest' (strToMethod methodStr) (paramToValue ps)
+    mkAction (Reply methodStr ps) = undefined -- TODO
+    mkAction (Notify methodStr ps) = void $ sendNotification (strToMethod methodStr) (paramToValue ps)
+
+    strToMethod str = case fromJSON (String $ T.pack str) of
+      Success x -> x
+      Error _ -> error $ str ++ " is not a valid method"
+    paramToValue (ParamString str) = String str
+    paramToValue (ParamUri uri)    = toJSON $ LSP.filePathToUri (rootDir </> uri)
+    paramToValue (ParamObject obj) = Object (HM.map paramToValue obj)
\ No newline at end of file

diff --git a/src/Language/Haskell/LSP/Test/Script.hs b/src/Language/Haskell/LSP/Test/Script.hs
index f9721b0e0298407a58f743b2cb330d8e3ab74b2b..ce4466429c853aafe7e292d5b3a13d53d0b873e0 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Script.hs
+++ b/src/Language/Haskell/LSP/Test/Script.hs
@@ -1,25 +1,12 @@
-module Main where
+module Language.Haskell.LSP.Test.Script where
 
 import Control.Applicative ( (<|>), some )
 import Control.Monad
-import Data.Aeson
 import Data.Char
 import qualified Data.Text as T
 import qualified Data.HashMap.Lazy as HM
-import Data.Maybe
 import Data.Scientific
 import Text.ParserCombinators.ReadP
-import System.Environment
-import System.FilePath
-import System.Directory
-import Language.Haskell.LSP.Test (openDoc, sendRequest', sendNotification, sendResponse)
-import Language.Haskell.LSP.Test.Session
-import Language.Haskell.LSP.Test.Machine
-import Language.Haskell.LSP.Test.Parsing (toJSONMsg)
-import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.TH.MessageFuncs
-import qualified Language.Haskell.LSP.Types as LSP
-import Debug.Trace
 
 data Block = Block String Wait [Action]
   deriving Show
@@ -175,51 +162,3 @@ parseScript str =
       skipSpaces
       eof
       return blocks
\ No newline at end of file
-
-main = do
-  fileName <- head <$> getArgs
-  blocks <- parseScript <$> readFile fileName
-  print blocks
-  rootDir <- getCurrentDirectory
-  runBlocks rootDir blocks
-
-
-runBlocks :: FilePath -> [Block] -> IO ()
-runBlocks rootDir blocks = runMachine rootDir (map convertBlock blocks) >>= putStrLn
-  where
-    convertBlock :: Block -> (String, FromServerMessage -> Bool, [Session ()])
-    convertBlock (Block name w actions) = (name, mkWait w, map mkAction actions)
-
-    mkWait :: Wait -> FromServerMessage -> Bool
-    mkWait WaitAny _ = True
-    mkWait (WaitPred preds) x = all (`mkPred` x) preds
-
-    mkPred :: Predicate -> (FromServerMessage -> Bool)
-    mkPred (Predicate accessor comparison) msg =
-      let (Object obj) = toJSONMsg msg in comp (access obj accessor) comparison
-
-    comp (Just (String str)) (EqualsString expected) = str == T.pack expected
-    comp (Just (Number num)) (EqualsNumber expected) = num == expected
-    comp _ _ = False
-
-    access :: Object -> Accessor -> Maybe Value
-    access obj (AccessorTerm prop) = traceShowId $ HM.lookup (T.pack prop) obj
-    access obj (Accessor prop next) =
-      case HM.lookup (T.pack prop) obj of
-        Just (Object nextObj) -> access nextObj next
-        _ -> Nothing
-
-    mkAction :: Action -> Session ()
-
-    mkAction (OpenDoc fp fileType) = void $ openDoc fp fileType
-
-    mkAction (Request identifier methodStr ps) = void $ sendRequest' (strToMethod methodStr) (paramToValue ps)
-    mkAction (Reply methodStr ps) = undefined -- TODO
-    mkAction (Notify methodStr ps) = void $ sendNotification (strToMethod methodStr) (paramToValue ps)
-
-    strToMethod str = case fromJSON (String $ T.pack str) of
-      Success x -> x
-      Error _ -> error $ str ++ " is not a valid method"
-    paramToValue (ParamString str) = String str
-    paramToValue (ParamUri uri)    = toJSON $ LSP.filePathToUri (rootDir </> uri)
-    paramToValue (ParamObject obj) = Object (HM.map paramToValue obj)