fork(1) download 
  1. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
  2.  
  3. import System.Console.Haskeline
  4. import System.IO
  5. import System.IO.Unsafe
  6. import Control.Monad.State.Strict
  7. import qualified Data.ByteString.Char8 as B
  8. import Data.Maybe
  9. import Data.List 
  10. import qualified Data.Map as M
  11.  
  12. data MyDataState = MyDataState {
  13.   mydata :: [Int],
  14.   showEven :: Bool
  15. } deriving (Show)
  16.  
  17. instance MonadState s m => MonadState s (InputT m) where
  18.     get = lift get
  19.     put = lift . put
  20.     state = lift . state
  21.  
  22. myfile :: FilePath
  23. myfile = "data.txt"
  24.  
  25. defaultFlagValue :: Bool
  26. defaultFlagValue = False
  27.  
  28. saveDataToFile :: [Int] -> IO ()
  29. saveDataToFile _data = withFile myfile WriteMode $ \h -> hPutStr h (unwords $ map show _data)
  30.  
  31. {-# NOINLINE loadDataFromFile #-} 
  32. loadDataFromFile :: [Int]
  33. loadDataFromFile = map read . words $ B.unpack $ unsafePerformIO $ B.readFile myfile
  34.  
  35. wordList = [":help", ":q", ":commands", ":show", ":save", ":edit", ":new", ":toggleShowEven"]
  36.  
  37. searchFunc :: MyDataState -> String -> [Completion]
  38. searchFunc (MyDataState mydata showEven) str = map simpleCompletion $ filter (str `isPrefixOf`) (wordList ++ (map show mydata))
  39.  
  40. mySettings :: Settings (StateT MyDataState IO)
  41. mySettings = Settings { historyFile = Just "myhist"
  42.                       , complete = completeWord Nothing " \t" $ \str -> do 
  43.                           _data <- get
  44.                           searchFunc _data str 
  45.                       --, complete = completeWord Nothing " \t" $ return . (searchFunc (MyDataState [] False) )
  46.                       , autoAddHistory = True
  47.                       }
  48.  
  49. help :: InputT (StateT MyDataState IO) ()
  50. help = liftIO $ mapM_ putStrLn
  51.        [ ""
  52.        , ":help     - this help"
  53.        , ":q        - quit"
  54.        , ":commands - list available commands"
  55.        , ""
  56.        ]
  57.  
  58. commands :: InputT (StateT MyDataState IO) ()
  59. commands = liftIO $ mapM_ putStrLn
  60.        [ ""
  61.        , ":show           - display data"
  62.        , ":save           - save results to file"
  63.        , ":edit           - edit data"
  64.        , ":new            - generate new element "
  65.        , ":toggleShowEven - toggle display of even elements"
  66.        , ""
  67.        ]
  68.  
  69. toggleFlag :: InputT (StateT MyDataState IO) ()
  70. toggleFlag = do
  71.   MyDataState mydata flag <- get
  72.   put $ MyDataState mydata (not flag)
  73.  
  74. parseInput :: String -> InputT (StateT MyDataState IO) () 
  75. parseInput inp
  76.   | ":q" == inp = return ()
  77.  
  78.   | ":help" == inp = help >> mainLoop
  79.  
  80.   | ":commands" == inp = commands >> mainLoop
  81.  
  82.   | ":toggleShowEven" == inp = toggleFlag >> mainLoop
  83.  
  84.   | ":show" == inp = do
  85.       MyDataState mydata showEven <- get
  86.       liftIO $ putStrLn $ unwords $ if showEven 
  87.         then map show mydata
  88.         else map show $ filter odd mydata
  89.       mainLoop 
  90.  
  91.   | ":save" == inp = do
  92.       MyDataState mydata _ <- get 
  93.       liftIO $ saveDataToFile mydata
  94.       mainLoop
  95.  
  96.   | ":load" == inp = do
  97.       put (MyDataState loadDataFromFile defaultFlagValue)
  98.       mainLoop
  99.  
  100.   | ":new" == inp = do
  101.       MyDataState mydata showEven <- get                     -- reads the state
  102.       inputData <- getInputLine "\tEnter data: "
  103.       case inputData of 
  104.         Nothing -> put ( MyDataState [0] showEven )
  105.         Just inputD -> 
  106.           put $ if null mydata 
  107.             then MyDataState [read inputD] showEven
  108.             else MyDataState (mydata ++ [read inputD]) showEven -- updates the state
  109.       mainLoop
  110.  
  111.   | ":" == inp = do
  112.     outputStrLn $ "\nNo command \"" ++ inp ++ "\"\n"
  113.     mainLoop
  114.  
  115.   | otherwise = handleInput inp
  116.  
  117. handleInput :: String -> InputT (StateT MyDataState IO) ()
  118. handleInput inp = mainLoop
  119.  
  120. mainLoop :: InputT (StateT MyDataState IO ) ()
  121. mainLoop = do
  122.   inp <- getInputLine "% "
  123.   maybe (return ()) parseInput inp
  124.  
  125. greet :: IO ()
  126. greet = mapM_ putStrLn
  127.         [ ""
  128.         , "          MyProgram"
  129.         , "=============================="
  130.         , "For help type \":help\""
  131.         , ""
  132.         ]
  133.  
  134. main :: IO ((), MyDataState)
  135. main = do 
  136.     greet 
  137.     runStateT (runInputT mySettings mainLoop) MyDataState {mydata = [] , showEven = defaultFlagValue}
Compilation error #stdin compilation error #stdout 0s 4348KB
comments (?)
stdin 
Standard input is empty
compilation info 
[1 of 1] Compiling Main             ( prog.hs, prog.o )

prog.hs:42:36: error:
    • Couldn't match type ‘[]’ with ‘StateT MyDataState IO’
      Expected type: CompletionFunc (StateT MyDataState IO)
        Actual type: CompletionFunc []
    • In the ‘complete’ field of a record
      In the expression:
        Settings
          {historyFile = Just "myhist",
           complete = completeWord Nothing " \t"
                      $ \ str
                          -> do { _data <- get;
                                  .... },
           autoAddHistory = True}
      In an equation for ‘mySettings’:
          mySettings
            = Settings
                {historyFile = Just "myhist",
                 complete = completeWord Nothing " \t" $ \ str -> do { ... },
                 autoAddHistory = True}

prog.hs:44:27: error:
    • Couldn't match type ‘Completion’ with ‘[Completion]’
      Expected type: [[Completion]]
        Actual type: [Completion]
    • In a stmt of a 'do' block: searchFunc _data str
      In the expression:
        do { _data <- get;
             searchFunc _data str }
      In the second argument of ‘($)’, namely
        ‘\ str
           -> do { _data <- get;
                   searchFunc _data str }’
stdout 
Standard output is empty
https://ideone.com/Zr4pK1
language:
Haskell (ghc 8.4.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!