Implement the rest

This is still quite buggy, but now the basics are in place.

app/Main.hs

@@ -4,16 +4,19 @@ module Main where
 
 import           Brick
 import           Control.Monad
+import qualified Data.Text.IO          as T
 import qualified Graphics.Vty          as Vty
+import           Options.Applicative
 
-import           Profold.LineNode
+import           Profold.Options
+import           Profold.ParseProfFile
 import           Profold.UiState
 
 data UiName = UiViewport
   deriving (Show, Eq, Ord)
 
 myAppDraw :: UiState -> [Widget UiName]
-myAppDraw s = [viewport UiViewport Vertical $ renderUiState s]
+myAppDraw s = [renderUiState UiViewport s]
 
 myHandleEvent :: UiState -> BrickEvent n e -> EventM n (Next UiState)
 myHandleEvent s (VtyEvent (Vty.EvKey Vty.KEsc _))         = halt s
@@ -32,7 +35,7 @@ myAttrMap = attrMap Vty.defAttr
 
 myApp :: App UiState () UiName
 myApp = App
-  { appDraw         = \s -> [renderUiState s]
+  { appDraw         = myAppDraw
   , appChooseCursor = neverShowCursor
   , appHandleEvent  = myHandleEvent
   , appStartEvent   = pure
@@ -40,7 +43,12 @@ myApp = App
   }
 
 main :: IO ()
-main = void $ defaultMain myApp $ newUiState $ newLineNode "Hello world"
+main = do
-  [ newLineNode " Child" []
+  opts <- execParser options
-  , newLineNode " More children" []
+  let filename = optFileName opts
-  ]
+  text <- T.readFile filename
+  case parseProfFile filename text of
+    Left e     -> putStrLn e
+    Right f -> do
+      print f
+      void $ defaultMain myApp $ newUiState (profInfoLines f) (profNode f)

package.yaml

@@ -15,8 +15,8 @@ extra-source-files:
 dependencies:
 - base >= 4.7 && < 5
 - brick
-- containers
 - megaparsec
+- optparse-applicative
 - text
 - vector
 - vty

src/Profold/Options.hs

@@ -0,0 +1,17 @@
+module Profold.Options
+  ( Options(..)
+  , options
+  ) where
+
+import Options.Applicative
+
+newtype Options = Options
+  { optFileName :: String
+  } deriving (Show)
+
+parser :: Parser Options
+parser = Options
+  <$> strArgument (help "Path to the .prof file" <> metavar "FILE")
+
+options :: ParserInfo Options
+options = info (helper <*> parser) fullDesc

src/Profold/ParseProfFile.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Profold.ParseProfFile
+  ( ProfFile(..)
+  , parseProfFile
+  ) where
+
+import           Control.Monad
+import qualified Data.Text            as T
+import           Data.Void
+import           Text.Megaparsec
+import           Text.Megaparsec.Char
+
+import           Profold.LineNode
+
+data ProfFile = ProfFile
+  { profInfoLines :: [T.Text]
+  , profNode      :: LineNode
+  } deriving (Show)
+
+type Parser = Parsec Void T.Text
+
+line :: Parser T.Text
+line = label "line" $ takeWhileP Nothing (/= '\n') <* newline
+
+skipUntilTheInterestingStuff :: Parser ()
+skipUntilTheInterestingStuff = void $ skipManyTill line newLines
+  where
+    newLines = try $ newline >> newline
+
+lineWithIndentation :: T.Text -> Parser T.Text
+lineWithIndentation indentation = do
+  void $ string indentation
+  l <- line
+  pure $ indentation <> l
+
+lineNode :: T.Text -> Parser LineNode
+lineNode indentation = do
+  text <- lineWithIndentation indentation
+  children <- many $ lineNode $ indentation <> " "
+  pure $ newLineNode text children
+
+profFile :: Parser ProfFile
+profFile = do
+  skipUntilTheInterestingStuff
+  info <- count 2 line
+  void newline
+  node <- lineNode ""
+  pure $ ProfFile info node
+
+parseProfFile :: String -> T.Text -> Either String ProfFile
+parseProfFile filename text = case parse profFile filename text of
+  Left e   -> Left $ errorBundlePretty e
+  Right f -> Right f

src/Profold/UiState.hs

@@ -13,18 +13,20 @@ module Profold.UiState
 
 import           Brick
 import           Data.Maybe
+import qualified Data.Text        as T
 import qualified Data.Vector      as V
 
 import           Profold.LineNode
 import           Profold.Util
 
 data UiState = UiState
-  { uiTree    :: LineNode
+  { uiInfo    :: [T.Text]
+  , uiTree    :: LineNode
   , uiFocused :: Path
   } deriving (Show)
 
-newUiState :: LineNode -> UiState
+newUiState :: [T.Text] -> LineNode -> UiState
-newUiState ln = UiState ln []
+newUiState info ln = UiState info ln []
 
 moveFocusUp :: UiState -> UiState
 moveFocusUp s =
@@ -50,24 +52,22 @@ toggleFold s =
       | V.null $ lineChildren ln = ln
       | otherwise = ln {lineFolded = not $ lineFolded ln}
 
-wrapFolded :: Bool -> Widget n -> Widget n
-wrapFolded False widget = withDefAttr "unfolded" $ str " " <+> widget
-wrapFolded True widget  = withDefAttr "folded" $ str "+" <+> widget
-
 wrapFocused :: Bool -> Widget n -> Widget n
 wrapFocused False = withDefAttr "unfocused"
 wrapFocused True  = visible . withDefAttr "focused"
 
 renderLine :: Bool -> LineNode -> Widget n
 renderLine focused ln =
-  wrapFocused focused $
+  let prefix
-  wrapFolded foldedWithChildren $ padRight Max $ txt $ lineText ln
+        | V.null $ lineChildren ln = " "
-  where
+        | lineFolded ln = "+"
-    foldedWithChildren = lineFolded ln && not (V.null $ lineChildren ln)
+        | otherwise = "-"
+  in  wrapFocused focused $ padRight Max $ str prefix <+> txt (lineText ln)
 
-renderUiState :: UiState -> Widget n
+renderUiState :: (Show n, Ord n) => n -> UiState -> Widget n
-renderUiState s =
+renderUiState n s =
-  let flat = V.toList $ flatten $ uiTree s
+  let info = vBox $ map txt $ uiInfo s
+      flat = V.toList $ flatten $ uiTree s
       focused = uiFocused s
       rendered = map (\(p, ln) -> renderLine (p == focused) ln) flat
-  in  vBox rendered
+  in  info <=> viewport n Vertical (vBox rendered)