Use help text stirngs in ParserGenSpec

Use help text stirngs in ParserGenSpec

module Test.Spec.CompilerSpec (parserGenSpec) where

import Prelude
import Debug.Trace
import Data.Tuple (Tuple(..))
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (EXCEPTION())
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Either (Either(..), either)
import Data.List (List(..), toList, length, fromList, singleton)
import Data.Map (Map(..))
import Data.StrMap as StrMap
import Data.StrMap (StrMap())
import Data.Tuple (uncurry)
import Data.Map as Map
import Data.Array as A
import Data.Foldable (for_, intercalate)
import Control.Monad.Eff.Exception (error, throwException)
import Text.Parsing.Parser as P

import Test.Assert (assert)
import Test.Spec (describe, it, Spec())
import Test.Spec.Reporter.Console (consoleReporter)
import Test.Assert.Simple
import Test.Support (vliftEff, runMaybeEff, runEitherEff)
import Test.Support.Arguments

import Language.Docopt (parseDocopt)
import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Value
import Language.Docopt.Usage
import Language.Docopt.Env (Env())
import Language.Docopt.Compiler (genParser, runParser)
import Language.Docopt.Argument   as D
import Language.Docopt.Env        as Env
import Language.Docopt.Trans.Flat as T
import Test.Support.Docopt        as D

type Options =  { customEOA    :: Array String
                , optionsFirst :: Boolean
                }

type Test = { help  :: String
            , cases :: Array Case
            }

type Case = { argv     :: Array String
            , env      :: Array (Tuple String String)
            , expected :: Either String (StrMap Value)
            , options  :: Maybe Options
            }

test :: String     -- ^ The help text
     -> Array Case -- ^ The array of test cases to cover
     -> Test
test help ks = { help: help, cases: ks }

pass ::  Maybe Options                -- ^ The options
      -> Array String                 -- ^ ARGV
      -> (Array (Tuple String Value)) -- ^ The expected output
      -> Case
pass opts i o = { argv:     i
                , env:      []
                , options:  opts
                , expected: Right $ StrMap.fromList $ toList o
                }

pass' :: Maybe Options                 -- ^ The options
      -> Array String                  -- ^ ARGV
      -> (Array (Tuple String String)) -- ^ The environment
      -> (Array (Tuple String Value))  -- ^ The expected output
      -> Case
pass' opts i e o = { argv:     i
                   , env:      e
                   , options:  opts
                   , expected: Right $ StrMap.fromList $ toList o
                   }

fail :: Array String -- ^ ARGV
      -> String      -- ^ The expected error message
      -> Case
fail i e = { argv: i, env: [],  expected: Left e, options: Nothing }

fail' :: Array String                  -- ^ ARGV
      -> (Array (Tuple String String)) -- ^ The environment
      -> String                        -- ^ The expected error message
      -> Case
fail' i e err = { argv: i, env: e, expected: Left err, options: Nothing }

(:>) = Tuple
infixr 0 :>

parserGenSpec = \_ -> describe "The parser generator" do
  it "" do
    pure unit

  -- Some options that will be used for these tests
  let testCases = [
      test
        "usage: prog <qux>..."
        [ pass Nothing
            [ "a", "b", "c" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            ]
        , fail [ "--foo", "baz" ]
            "Expected <qux>..., but got --foo"
        , fail
            [ "a", "--foo", "-f=10" ]
            "Unmatched option: --foo"
        ]

    , test
        "usage: prog <qux>... --"
        [ pass Nothing
            [ "a", "b", "c", "--" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            , "--"    :> D.array []
            ]
        , pass Nothing
            [ "a", "b", "c", "--", "--", "--" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            , "--"    :> D.array [ D.str "--" , D.str "--" ]
            ]
        ]

    , test
        """
        usage: prog [options]
        options:
          -h, --host <host[:port]> [default: "http://localhost:3000"]
        """
        [ pass
            Nothing
            [ "-hhttp://localhost:5000" ]
            [ "-h"     :> D.str "http://localhost:5000"
            , "--host" :> D.str "http://localhost:5000"
            ]
        ]

    , test
        """
        usage: prog [options]
        options:
          -h, --host FOO [default: BAR] [env: HOST]
        """
        [ pass'
            Nothing
            []
            [ "HOST" :> "HOME" ]
            [ "-h"     :> D.str "HOME"
            , "--host" :> D.str "HOME"
            ]
        ]

    , test
        """
        usage: prog (-iFILE)
        options:
          -i, --input FILE
        """
        [ fail [] "Expected option(s): -i|--input=FILE"
        , pass Nothing
            [ "-i", "bar" ]
            [ "-i"      :> D.str "bar"
            , "--input" :> D.str "bar" ]
        ]

    , test
        """
        usage: prog (-iFILE) -oFILE
        options:
          -i, --input FILE
          -o, --output FILE
        """
        [ fail []
          $ "Expected option(s): -i|--input=FILE, -o|--output=FILE"

        , fail [ "-i", "bar" ]
          $ "Expected option(s): -o|--output=FILE"

        , pass Nothing
            [ "-i", "bar", "-o", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]

          -- group should be interchangable if it's only of options:
        , pass Nothing
            [ "-o", "bar", "-i", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]
        ]

    , test
        """
        usage: prog ((-iFILE) -rFILE) -oFILE
        options:
          -i, --input FILE
          -o, --output FILE
          -r, --redirect FILE [env: QUX]
        """
        [ fail []
          $ "Expected option(s): -i|--input=FILE -r|--redirect=FILE, -o|--output=FILE"

        , fail [ "-i", "bar", "-r", "bar" ]
            "Expected option(s): -o|--output=FILE"

        , pass Nothing
            [ "-i", "bar", "-r", "bar", "-o", "bar" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "bar"
            , "-r"         :> D.str "bar"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]

          -- group should be interchangable if it's only of options:
        , pass Nothing
            [ "-o", "bar", "-r", "bar", "-i", "bar" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "bar"
            , "-r"         :> D.str "bar"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]

        , pass' Nothing
            [ "-o", "bar", "-i", "bar" ]
            [ "QUX" :> "BAR" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "BAR"
            , "-r"         :> D.str "BAR"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]
        ]

    , test
        """
        usage: prog ((-i FILE) <env>) -oFILE
        options:
          -i, --input FILE
          -o, --output FILE
          -r, --redirect FILE
        """
        [ fail [] "Expected option(s): -i|--input=FILE"
          -- XXX: Would be cool to show the reason the group did not parse!
        , fail [ "-i", "bar" ] "Expected <env>"
        , pass Nothing
            [ "-i", "bar", "x", "-o", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "<env>"    :> D.str "x"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]
          -- group should NOT be interchangable if it contains non-options:
        , fail [ "-o", "bar", "x", "-i", "bar" ]
            "Expected option(s): -i|--input=FILE"
        ]

    , test
        """
        usage: prog [options]
        options:
          -o, --out FOO [env: FOO]
        """
        [ pass' Nothing
            []
            [ "FOO"    :> "BAR" ]
            [  "--out" :> D.str "BAR"
            ,  "-o"    :> D.str "BAR" ]
        ]

    , test
        """
        usage: prog [options]
        options:
          -o, --out FOO [default: "ADLER"] [env: FOO]
        """
        [ pass' Nothing
            []
            [ "FOO" :> "BAR" ]
            [  "--out" :> D.str "BAR"
            ,  "-o"    :> D.str "BAR" ]
        ]

    , test
        """
        usage: prog -a
           or: prog -b
        """
        [ pass Nothing
            [ "-a" ]
            [ "-a" :> D.bool true ]
        , pass Nothing
            [ "-b" ]
            [ "-b" :> D.bool true ]
        , pass Nothing
            []
            []
        ]

    , test
        """
        usage: prog a
           or: prog b
        """
        [ pass Nothing
            [ "a" ]
            [ "a" :> D.bool true ]
        , pass Nothing
            [ "b" ]
            [ "b" :> D.bool true ]
        , fail
            [ "a", "b" ]
            "Unmatched command: b"
        , fail
            [ "b", "a" ]
            "Unmatched command: a"
        , fail [] ""
        ]

    , test
        """
        usage: prog foo -io -q... -b=BAZ -f=FOZ... baz
        options:
          -i, --input
          -o, --out
          -q, --qux...
          -b, --baz BAZ [default: "ax"]
          -f, --foo FOZ...
        """
        [ pass Nothing
            [ "foo", "--out", "--input", "--qux", "--foo=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--qux"   :> D.int 1
            , "-q"      :> D.int 1
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "baz"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            ]

        , pass Nothing
            [ "foo" , "--out", "-qqq", "--foo=ox", "--baz=ax", "--input", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--qux"   :> D.int 3
            , "-q"      :> D.int 3
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "-q", "-o", "--qux", "-i", "--baz=ax", "-f=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--qux"   :> D.int 2
            , "-q"      :> D.int 2
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "--baz=ax", "-o", "-f=ox", "-i", "baz" ]
            [ "foo"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "-o", "-i", "-bax", "-f=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "baz"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            ]

        , fail
            [ "foo" ]
            "Expected option(s): -f|--foo=FOZ..."
        , fail
            [ "foo", "-o", "-i", "-bax" ]
            "Expected option(s): -f|--foo=FOZ..."
        ]

    , test
        """
        usage: prog [foo]
        """
        [ fail [ "goo" ] "Unmatched command: goo" ]

    , test
        """
        usage: prog (foo)
        """
        [ fail [ "goo" ] "Expected foo, but got goo" ]
  ]

  for_ testCases \(({ help, cases })) -> do
    describe help do
      for_ cases \(({ argv, env, expected, options })) ->
            let msg = either (\e -> "Should fail with \"" <> e <> "\"")
                              prettyPrintOut
                              expected
                premsg = if A.length argv > 0
                            then intercalate " " argv
                            else "(no input)"
            in it (premsg <> " -> " <> msg) do
                  vliftEff do
                    { specification } <- runEitherEff do
                      parseDocopt help { smartOptions: true }
                    validate (specification)
                             argv
                             (Env.fromFoldable env)
                             options
                             expected

    where

      prettyPrintOut :: StrMap Value -> String
      prettyPrintOut m = "\n\t" <> prettyPrintStrMap m

      prettyPrintStrMap :: StrMap Value -> String
      prettyPrintStrMap m = intercalate "\n\t" $
        StrMap.toList m <#> \(Tuple arg val) ->
          arg <> " => " <> prettyPrintValue val

      validate :: forall eff.  List Usage
                            -> Array String
                            -> Env
                            -> Maybe Options
                            -> Either String (StrMap Value)
                            -> Eff (err :: EXCEPTION | eff) Unit
      validate spec argv env options expected = do
        let result = uncurry (T.reduce spec env)
                <$> runParser
                      env
                      argv
                      (genParser spec (fromMaybe {
                        optionsFirst: false
                      , customEOA:    []
                      } options))

        case result of
          Left (e@(P.ParseError { message: msg })) ->
            either
              (\e' ->
                if (msg /= e')
                  then throwException $ error $
                    "Unexpected error:\n" <> msg
                  else return unit)
              (const $ throwException $ error $ show e)
              expected
          Right r -> do
            either
              (\e ->
                throwException $ error $
                  "Missing expected exception:"
                    <> "\n"
                    <> show e
                    <> "\n"
                    <> "\n"
                    <> "instead received output:"
                    <> "\n"
                    <> prettyPrintOut r)
              (\r' ->
                if (r /= r')
                  then throwException $ error $
                    "Unexpected output:\n"
                      <> prettyPrintOut r
                  else return unit)
              expected

module Test.Spec.CompilerSpec (parserGenSpec) where

import Prelude
import Debug.Trace
import Data.Tuple (Tuple(..))
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (EXCEPTION())
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Either (Either(..), either)
import Data.List (List(..), toList, length, fromList, singleton)
import Data.Map (Map(..))
import Data.StrMap as StrMap
import Data.StrMap (StrMap())
import Data.Tuple (uncurry)
import Data.Map as Map
import Data.Array as A
import Data.Foldable (for_, intercalate)
import Control.Monad.Eff.Exception (error, throwException)
import Text.Parsing.Parser as P

import Test.Assert (assert)
import Test.Spec (describe, it, Spec())
import Test.Spec.Reporter.Console (consoleReporter)
import Test.Assert.Simple
import Test.Support (vliftEff, runMaybeEff, runEitherEff)
import Test.Support.Arguments

import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Value
import Language.Docopt.Usage
import Language.Docopt.Env (Env())
import Language.Docopt.Compiler (genParser, runParser)
import Language.Docopt.Argument   as D
import Language.Docopt.Env        as Env
import Language.Docopt.Trans.Flat as T
import Test.Support.Docopt        as D

type Options =  { customEOA    :: Array String
                , optionsFirst :: Boolean
                }

type Test = { spec  :: List (Array Argument)
            , cases :: Array Case
            }

type Case = { argv     :: Array String
            , env      :: Array (Tuple String String)
            , expected :: Either String (StrMap Value)
            , options  :: Maybe Options
            }

test :: Array Argument -- ^ The (flat) specification
     -> Array Case     -- ^ The array of test cases to cover
     -> Test
test a ks = { spec: singleton a, cases: ks }

test' :: Array (Array Argument) -- ^ The specification
      -> Array Case             -- ^ The array of test cases to cover
      -> Test
test' a ks = { spec: toList a, cases: ks }

pass ::  Maybe Options                -- ^ The options
      -> Array String                 -- ^ ARGV
      -> (Array (Tuple String Value)) -- ^ The expected output
      -> Case
pass opts i o = { argv:     i
                , env:      []
                , options:  opts
                , expected: Right $ StrMap.fromList $ toList o
                }

pass' :: Maybe Options                 -- ^ The options
      -> Array String                  -- ^ ARGV
      -> (Array (Tuple String String)) -- ^ The environment
      -> (Array (Tuple String Value))  -- ^ The expected output
      -> Case
pass' opts i e o = { argv:     i
                   , env:      e
                   , options:  opts
                   , expected: Right $ StrMap.fromList $ toList o
                   }

fail :: Array String -- ^ ARGV
      -> String      -- ^ The expected error message
      -> Case
fail i e = { argv: i, env: [],  expected: Left e, options: Nothing }

fail' :: Array String                  -- ^ ARGV
      -> (Array (Tuple String String)) -- ^ The environment
      -> String                        -- ^ The expected error message
      -> Case
fail' i e err = { argv: i, env: e, expected: Left err, options: Nothing }

(:>) = Tuple
infixr 0 :>

parserGenSpec = \_ -> describe "The parser generator" do
  it "" do
    pure unit

  -- Some options that will be used for these tests
  let testCases = [
      test
        [ poR "<qux>" ]
        [ pass Nothing
            [ "a", "b", "c" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            ]
        , fail [ "--foo", "baz" ]
            "Expected <qux>..., but got --foo"
        , fail
            [ "a", "--foo", "-f=10" ]
            "Unmatched option: --foo"
        ]

    , test
        [ poR "<qux>", eoa ]
        [ pass Nothing
            [ "a", "b", "c", "--" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            , "--"    :> D.array []
            ]
        , pass Nothing
            [ "a", "b", "c", "--", "--", "--" ]
            [ "<qux>" :> D.array [ D.str "a", D.str "b", D.str "c" ]
            , "--"    :> D.array [ D.str "--" , D.str "--" ]
            ]
        ]

    , test
        [ grr false [] ]
        [ pass Nothing [] [] ]

    , test
        [ gro false [] ]
        [ pass Nothing [] [] ]

    , test
        [ opt 'h' "host" (oa "host[:port]"
                           (D.str "http://localhost:3000"))
        ]
        [ pass Nothing
            [ "-hhttp://localhost:5000" ]
            [ "-h"     :> D.str "http://localhost:5000"
            , "--host" :> D.str "http://localhost:5000"
            ]
        ]

    , test
        [ optE 'h' "host" (oa "FOO" (D.str "BAR")) "HOST" ]
        [ pass' Nothing
            []
            [ "HOST" :> "HOME" ]
            [ "-h"     :> D.str "HOME"
            , "--host" :> D.str "HOME"
            ]
        ]

    , test
        [ grr false [[ opt 'i' "input" (oa_ "FILE") ]]
        ]
        [ fail [] "Expected option(s): -i|--input=FILE"
        , pass Nothing
            [ "-i", "bar" ]
            [ "-i"      :> D.str "bar"
            , "--input" :> D.str "bar" ]
        ]

    , test
        [ grr false [[ opt 'i' "input" (oa_ "FILE") ]]
        ]
        [ fail [] "Expected option(s): -i|--input=FILE"
        , pass Nothing
            [ "-i", "bar" ]
            [ "-i"      :> D.str "bar"
            , "--input" :> D.str "bar" ]
        ]

    , test
        [ grr false [[ opt 'i' "input" (oa_ "FILE") ]]
        , opt 'o' "output" (oa_ "FILE")
        ]
        [ fail []
          $ "Expected option(s): -i|--input=FILE, -o|--output=FILE"

        , fail [ "-i", "bar" ]
          $ "Expected option(s): -o|--output=FILE"

        , pass Nothing
            [ "-i", "bar", "-o", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]

          -- group should be interchangable if it's only of options:
        , pass Nothing
            [ "-o", "bar", "-i", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]
        ]

    , test
        [ grr false [[
            grr false [[
              opt 'i' "input" (oa_ "FILE")
            ]]
          , optE 'r' "redirect" (oa_ "FILE") "QUX"
          ]]
        , opt 'o' "output" (oa_ "FILE")
        ]
        [ fail []
          $ "Expected option(s): -i|--input=FILE -r|--redirect=FILE, -o|--output=FILE"

        , fail [ "-i", "bar", "-r", "bar" ]
            "Expected option(s): -o|--output=FILE"

        , pass Nothing
            [ "-i", "bar", "-r", "bar", "-o", "bar" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "bar"
            , "-r"         :> D.str "bar"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]

          -- group should be interchangable if it's only of options:
        , pass Nothing
            [ "-o", "bar", "-r", "bar", "-i", "bar" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "bar"
            , "-r"         :> D.str "bar"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]

        , pass' Nothing
            [ "-o", "bar", "-i", "bar" ]
            [ "QUX" :> "BAR" ]
            [ "--input"    :> D.str "bar"
            , "-i"         :> D.str "bar"
            , "--redirect" :> D.str "BAR"
            , "-r"         :> D.str "BAR"
            , "--output"   :> D.str "bar"
            , "-o"         :> D.str "bar" ]
        ]

    , test
        [ grr false [[
            opt 'i' "input" (oa_ "FILE")
          , po  "<env>"
          ]]
        , opt 'o' "output" (oa_ "FILE")
        ]
        [ fail [] "Expected option(s): -i|--input=FILE"
          -- XXX: Would be cool to show the reason the group did not parse!
        , fail [ "-i", "bar" ] "Expected <env>"
        , pass Nothing
            [ "-i", "bar", "x", "-o", "bar" ]
            [ "--input"  :> D.str "bar"
            , "-i"       :> D.str "bar"
            , "<env>"    :> D.str "x"
            , "--output" :> D.str "bar"
            , "-o"       :> D.str "bar" ]
          -- group should NOT be interchangable if it contains non-options:
        , fail [ "-o", "bar", "x", "-i", "bar" ]
            "Expected option(s): -i|--input=FILE"
        ]

    , test
        [ optE 'o' "out" (oa_ "FOO") "FOO" ]
        [ pass' Nothing
            []
            [ "FOO"    :> "BAR" ]
            [  "--out" :> D.str "BAR"
            ,  "-o"    :> D.str "BAR" ]
        ]

    , test
        [ optE 'o' "out" (oa "FOO" (D.str "ADLER")) "FOO" ]
        [ pass' Nothing
            []
            [ "FOO" :> "BAR" ]
            [  "--out" :> D.str "BAR"
            ,  "-o"    :> D.str "BAR" ]
        ]

    , test'
        [ [ sopt_ 'a' ], [ sopt_ 'b' ] ]
        [ pass Nothing
            [ "-a" ]
            [ "-a" :> D.bool true ]
        , pass Nothing
            [ "-b" ]
            [ "-b" :> D.bool true ]
        , pass Nothing
            []
            []
        ]

    , test'
        [ [ co "a" ], [ co "b" ] ]
        [ pass Nothing
            [ "a" ]
            [ "a" :> D.bool true ]
        , pass Nothing
            [ "b" ]
            [ "b" :> D.bool true ]
        , fail
            [ "a", "b" ]
            "Unmatched command: b"
        , fail
            [ "b", "a" ]
            "Unmatched command: a"
        , fail [] ""
        ]

    , test
        [ co     "foo"
        , opt_  'o' "out"
        , optR_ 'q' "qux"
        , opt   'b' "baz" (oa "BAZ" $ D.str "ax")
        , opt_  'i' "input"
        , optR  'f' "foo" (oa_ "FOZ")
        , co    "baz"
        ]
        [ pass Nothing
            [ "foo", "--out", "--input", "--qux", "--foo=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--qux"   :> D.int 1
            , "-q"      :> D.int 1
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "baz"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            ]

        , pass Nothing
            [ "foo" , "--out", "-qqq", "--foo=ox", "--baz=ax", "--input", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--qux"   :> D.int 3
            , "-q"      :> D.int 3
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "-q", "-o", "--qux", "-i", "--baz=ax", "-f=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--qux"   :> D.int 2
            , "-q"      :> D.int 2
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "--baz=ax", "-o", "-f=ox", "-i", "baz" ]
            [ "foo"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "baz"     :> D.bool true
            ]

        , pass Nothing
            [ "foo", "-o", "-i", "-bax", "-f=ox", "baz" ]
            [ "foo"     :> D.bool true
            , "--out"   :> D.bool true
            , "-o"      :> D.bool true
            , "--input" :> D.bool true
            , "-i"      :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "baz"     :> D.bool true
            , "--baz"   :> D.str "ax"
            , "-b"      :> D.str "ax"
            , "--foo"   :> D.array [ D.str "ox" ]
            , "-f"      :> D.array [ D.str "ox" ]
            ]

        , fail
            [ "foo" ]
            "Expected option(s): -f|--foo=FOZ..."
        , fail
            [ "foo", "-o", "-i", "-bax" ]
            "Expected option(s): -f|--foo=FOZ..."
        ]

    , test
        [ gro false [[ co "foo" ]] ]
        [ fail [ "goo" ] "Unmatched command: goo" ]
    , test
        [ grr false [[ co "foo" ]] ]
        [ fail [ "goo" ] "Expected foo, but got goo" ]
  ]

  for_ testCases \(({ spec, cases })) -> do
    describe (intercalate " | " $ prettyPrintBranch <<< br <$> spec) do
      for_ cases \(({ argv, env, expected, options })) ->
            let msg = either (\e -> "Should fail with \"" <> e <> "\"")
                              prettyPrintOut
                              expected
                premsg = if A.length argv > 0
                            then intercalate " " argv
                            else "(no input)"
            in it (premsg <> " -> " <> msg) do
                  vliftEff do
                    validate spec
                             argv
                             (Env.fromFoldable env)
                             options
                             expected

    where

      prettyPrintOut :: StrMap Value -> String
      prettyPrintOut m = "\n\t" <> prettyPrintStrMap m

      prettyPrintStrMap :: StrMap Value -> String
      prettyPrintStrMap m = intercalate "\n\t" $
        StrMap.toList m <#> \(Tuple arg val) ->
          arg <> " => " <> prettyPrintValue val

      validate :: forall eff.  List (Array Argument)
                            -> Array String
                            -> Env
                            -> Maybe Options
                            -> Either String (StrMap Value)
                            -> Eff (err :: EXCEPTION | eff) Unit
      validate args argv env options expected = do
        let prg = singleton $ Usage $ br <$> args
            result = uncurry (T.reduce prg env)
                <$> runParser
                      env
                      argv
                      (genParser prg (fromMaybe {
                        optionsFirst: false
                      , customEOA:    []
                      } options))

        case result of
          Left (e@(P.ParseError { message: msg })) ->
            either
              (\e' ->
                if (msg /= e')
                  then throwException $ error $
                    "Unexpected error:\n" <> msg
                  else return unit)
              (const $ throwException $ error $ show e)
              expected
          Right r -> do
            either
              (\e ->
                throwException $ error $
                  "Missing expected exception:"
                    <> "\n"
                    <> show e
                    <> "\n"
                    <> "\n"
                    <> "instead received output:"
                    <> "\n"
                    <> prettyPrintOut r)
              (\r' ->
                if (r /= r')
                  then throwException $ error $
                    "Unexpected output:\n"
                      <> prettyPrintOut r
                  else return unit)
              expected


fix import

fix import

-- | This module defines the `MonadError` type class and its instances.

module Control.Monad.Error.Class where

import Prelude

import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Effect (Effect)
import Effect.Exception as Ex

-- | The `MonadThrow` type class represents those monads which support errors via
-- | `throwError`, where `throwError e` halts, yielding the error `e`.
-- |
-- | An implementation is provided for `ExceptT`, and for other monad transformers
-- | defined in this library.
-- |
-- | Laws:
-- |
-- | - Left zero: `throwError e >>= f = throwError e`
-- |
class Monad m <= MonadThrow e m | m -> e where
  throwError :: forall a. e -> m a

-- | The `MonadError` type class represents those monads which support catching
-- | errors.
-- |
-- | - `catchError x f` calls the error handler `f` if an error is thrown during the
-- |   evaluation of `x`.
-- |
-- | An implementation is provided for `ExceptT`, and for other monad transformers
-- | defined in this library.
-- |
-- | Laws:
-- |
-- | - Catch: `catchError (throwError e) f = f e`
-- | - Pure: `catchError (pure a) f = pure a`
-- |
class MonadThrow e m <= MonadError e m | m -> e where
  catchError :: forall a. m a -> (e -> m a) -> m a

-- | This function allows you to provide a predicate for selecting the
-- | exceptions that you're interested in, and handle only those exceptons.
-- | If the inner computation throws an exception, and the predicate returns
-- | Nothing, then the whole computation will still fail with that exception.
catchJust
  :: forall e m a b
   . MonadError e m
  => (e -> Maybe b) -- ^ Predicate to select exceptions
  -> m a            -- ^ Computation to run
  -> (b -> m a)     -- ^ Handler
  -> m a
catchJust p act handler = catchError act handle
  where
  handle e =
    case p e of
      Nothing -> throwError e
      Just b -> handler b

-- | Return `Right` if the given action succeeds, `Left` if it throws.
try
  :: forall e m a
   . MonadError e m
  => m a
  -> m (Either e a)
try a = (Right <$> a) `catchError` (pure <<< Left)

instance monadThrowEither :: MonadThrow e (Either e) where
  throwError = Left

instance monadErrorEither :: MonadError e (Either e) where
  catchError (Left e) h = h e
  catchError (Right x) _ = Right x

instance monadThrowMaybe :: MonadThrow Unit Maybe where
  throwError = const Nothing

instance monadErrorMaybe :: MonadError Unit Maybe where
  catchError Nothing f  = f unit
  catchError (Just a) _ = Just a

instance monadThrowEffect :: MonadThrow Ex.Error Effect where
  throwError = Ex.throwException

instance monadErrorEffect :: MonadError Ex.Error Effect where
  catchError = flip Ex.catchException

-- | Make sure that a resource is cleaned up in the event of an exception. The
-- | release action is called regardless of whether the body action throws or
-- | returns.
withResource
  :: forall e m r a
   . MonadError e m
  => m r
  -> (r -> m Unit)
  -> (r -> m a)
  -> m a
withResource acquire release kleisli = do
  resource <- acquire
  result <- try $ kleisli resource
  release resource
  either throwError pure result

-- | This module defines the `MonadError` type class and its instances.

module Control.Monad.Error.Class where

import Prelude

import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Effect (Effect)
import Effect as Effect
import Effect.Exception (Error)

-- | The `MonadThrow` type class represents those monads which support errors via
-- | `throwError`, where `throwError e` halts, yielding the error `e`.
-- |
-- | An implementation is provided for `ExceptT`, and for other monad transformers
-- | defined in this library.
-- |
-- | Laws:
-- |
-- | - Left zero: `throwError e >>= f = throwError e`
-- |
class Monad m <= MonadThrow e m | m -> e where
  throwError :: forall a. e -> m a

-- | The `MonadError` type class represents those monads which support catching
-- | errors.
-- |
-- | - `catchError x f` calls the error handler `f` if an error is thrown during the
-- |   evaluation of `x`.
-- |
-- | An implementation is provided for `ExceptT`, and for other monad transformers
-- | defined in this library.
-- |
-- | Laws:
-- |
-- | - Catch: `catchError (throwError e) f = f e`
-- | - Pure: `catchError (pure a) f = pure a`
-- |
class MonadThrow e m <= MonadError e m | m -> e where
  catchError :: forall a. m a -> (e -> m a) -> m a

-- | This function allows you to provide a predicate for selecting the
-- | exceptions that you're interested in, and handle only those exceptons.
-- | If the inner computation throws an exception, and the predicate returns
-- | Nothing, then the whole computation will still fail with that exception.
catchJust
  :: forall e m a b
   . MonadError e m
  => (e -> Maybe b) -- ^ Predicate to select exceptions
  -> m a            -- ^ Computation to run
  -> (b -> m a)     -- ^ Handler
  -> m a
catchJust p act handler = catchError act handle
  where
  handle e =
    case p e of
      Nothing -> throwError e
      Just b -> handler b

-- | Return `Right` if the given action succeeds, `Left` if it throws.
try
  :: forall e m a
   . MonadError e m
  => m a
  -> m (Either e a)
try a = (Right <$> a) `catchError` (pure <<< Left)

instance monadThrowEither :: MonadThrow e (Either e) where
  throwError = Left

instance monadErrorEither :: MonadError e (Either e) where
  catchError (Left e) h = h e
  catchError (Right x) _ = Right x

instance monadThrowMaybe :: MonadThrow Unit Maybe where
  throwError = const Nothing

instance monadErrorMaybe :: MonadError Unit Maybe where
  catchError Nothing f  = f unit
  catchError (Just a) _ = Just a

instance monadThrowEffect :: MonadThrow Error Effect where
  throwError = Effect.throwException

instance monadErrorEffect :: MonadError Error Effect where
  catchError = flip Effect.catchException

-- | Make sure that a resource is cleaned up in the event of an exception. The
-- | release action is called regardless of whether the body action throws or
-- | returns.
withResource
  :: forall e m r a
   . MonadError e m
  => m r
  -> (r -> m Unit)
  -> (r -> m a)
  -> m a
withResource acquire release kleisli = do
  resource <- acquire
  result <- try $ kleisli resource
  release resource
  either throwError pure result


add a terrible search feature like any crud app

module FrontEnd where

import Prelude
import Data.JSDate as JSDate
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver as D
import Network.HTTP.Affjax as AJ
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Aff.Class (class MonadAff)
import Control.Monad.Aff.Console (CONSOLE, errorShow, log)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import Control.Monad.Eff.Unsafe (unsafePerformEff)
import Control.Monad.Except (runExcept)
import DOM (DOM)
import Data.Array (filter, reverse, sort, sortWith)
import Data.Either (Either(Left), either)
import Data.Foreign (ForeignError)
import Data.Foreign.Class (class Encode, class Decode, encode)
import Data.Foreign.Generic (decodeJSON)
import Data.List.NonEmpty (NonEmptyList)
import Data.Maybe (Maybe(Nothing, Just), isJust, maybe)
import Data.Monoid (mempty)
import Data.Newtype (unwrap, wrap)
import Data.String (Pattern(..), contains, toLower)
import Data.Traversable (find)
import Data.Tuple (Tuple(..))
import Data.Validation.Semigroup (V, invalid, unV)
import Global.Unsafe (unsafeStringify)
import Network.HTTP.Affjax (AJAX)
import Routes (Route(..), files, open, update, watched)
import Types (FileData(..), OpenRequest(..), Path(..), WatchedData(..))

type VE a = V (NonEmptyList ForeignError) a

request :: forall req res m eff.
  MonadAff
    ( ajax :: AJAX
    | eff
    )
    m
  => Encode req
  => Decode res
  => Route req res -> Maybe req -> m (VE res)
request (Route route) body =
  H.liftAff $ either invalid pure <$> parseResponse <$> action
  where
    action = AJ.affjax $ AJ.defaultRequest
      { method = Left route.method
      , url = route.url
      , content = unsafeStringify <<< encode <$> body
      }
    parseResponse response =
      runExcept $ decodeJSON response.response

unV' :: forall e a m.
  MonadAff
    ( console :: CONSOLE
    | e
    )
    m
  => (a -> m Unit) -> VE a -> m Unit
unV' = unV (H.liftAff <<< errorShow)

data Dir = ASC | DSC
derive instance eqDir :: Eq Dir
data Col = Title | Status
derive instance eqCol :: Eq Col
data Sorting = Sorting Col Dir | NoSorting

type State =
  { files :: Array Path
  , watched :: Array WatchedData
  , sorting :: Sorting
  , search :: String
  }

data Query a
  = Init a
  | OpenFile Path a
  | SetWatched Path Boolean a
  | ChangeSorting Col a
  | Search String a
  | ClearSearch a

type AppEffects eff =
  Aff
  ( ajax :: AJAX
  , console :: CONSOLE
  | eff )

ui :: forall eff. H.Component HH.HTML Query Unit Void (AppEffects eff)
ui =
  H.lifecycleComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }
  where
    initialState :: State
    initialState =
      { files: mempty
      , watched: mempty
      , sorting: NoSorting
      , search: mempty
      }

    render :: State -> H.ComponentHTML Query
    render state =
      HH.div
        [ HP.class_ $ wrap "container" ]
        $ [ HH.h1_ [ HH.text "Vidtracker" ]
          , HH.div
            [ HP.class_ $ wrap "search" ]
            $ [ HH.h4_ [ HH.text "Search" ]
              , HH.input
                  [ HP.value state.search
                  , HE.onValueInput (HE.input Search)
                  ]
              ] <> if state.search == ""
                then mempty
                else pure $
                  HH.button
                    [ HE.onClick $ HE.input_ ClearSearch ]
                    [ HH.text "Clear" ]
          , HH.div
            [ HP.class_ $ wrap "file"]
            [ HH.h3
              [ HP.class_ $ wrap "file-link"
              , HE.onClick $ HE.input_ (ChangeSorting Title)
              ] [ HH.text $ "Title" <> displayTicker Title ]
            , HH.h3
              [ HP.class_ $ wrap "file-button"
              , HE.onClick $ HE.input_ (ChangeSorting Status)
              ] [ HH.text $ "Status" <> displayTicker Status ]
            , HH.h3 [HP.class_ $ wrap "file-note"] [ HH.text "Date" ]
            ]
          ] <> (file <$> applyTransforms state.files)
      where
        displayTicker col
          | Sorting col' dir <- state.sorting
          , asc <- dir == ASC
          , col' == col = if asc
            then " ASC"
            else " DSC"
          | otherwise = ""
        applyTransforms = applySorting <<< applyFiltering
        applyFiltering = case state.search of
            "" -> id
            x -> filter $ \(Path path) -> contains (Pattern $ toLower x) (toLower path)
        applySorting
          | Sorting col dir <- state.sorting
          , rev <- if dir == ASC then id else reverse
          , sort' <- case col of
            Title -> sort
            Status -> sortWith findWatched
          = rev <<< sort'
          | otherwise = id
        findWatched path = find (\(WatchedData fd) -> fd.path == path) state.watched
        file path =
          HH.div
            [ HP.class_ $ wrap "file"]
            [ HH.a
              [ HP.classes $ wrap <$>
                [ "file-link"
                , maybe "" (const "watched") watched
                ]
              , HE.onClick $ HE.input_ (OpenFile path) ]
              [ HH.text $ unwrap path ]
            , HH.button
              [ HP.classes $ wrap <$>
                [ "file-button"
                , "pure-button"
                , maybe "" (const "pure-button-primary") watched
                ]
              , HE.onClick $ HE.input_ (SetWatched path (not $ isJust watched))
              ]
              [ HH.text $ maybe "not watched" (const "watched") watched ]
            , HH.span
              [ HP.class_ $ wrap "file-note" ]
              [ HH.text $ maybe "" id watched ]
            ]
          where
            watched = getDate <$> findWatched path
            getDate (WatchedData {created}) = JSDate.toDateString <<< unsafePerformEff <<< JSDate.parse $ created

    eval :: Query ~> H.ComponentDSL State Query Void (AppEffects eff)
    eval (Init next) = do
      getResult >>= unV'
        \(Tuple f w) -> H.modify _ {files = f, watched = w}
      pure next
      where
        getResult = do
          files <- request files Nothing
          watched <- request watched Nothing
          pure $ Tuple <$> files <*> watched

    eval (OpenFile path next) = do
      _ <- request open $ Just (OpenRequest {path})
      pure next

    eval (SetWatched path flag next) = do
      request update (Just $ FileData {path, watched: flag}) >>= unV'
        \w -> H.modify _ {watched = w}
      pure next

    eval (Search str next) = do
      H.modify _ {search = str}
      pure next

    eval (ClearSearch next) = do
      H.modify _ {search = ""}
      pure next

    eval (ChangeSorting col next)= do
      H.modify $ \s -> case s.sorting of
        Sorting curr dir | curr == col ->
          s {sorting = case dir of
              ASC -> Sorting col DSC
              DSC -> NoSorting
            }
        _ -> s {sorting = Sorting col ASC}
      pure next

main :: forall e.
  Eff
    ( avar :: AVAR
    , ref :: REF
    , exception :: EXCEPTION
    , dom :: DOM
    , console :: CONSOLE
    , ajax :: AJAX
    | e
    )
    Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  io <- D.runUI ui unit body

  log "Running"

module FrontEnd where

import Prelude
import Data.JSDate as JSDate
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver as D
import Network.HTTP.Affjax as AJ
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Aff.Class (class MonadAff)
import Control.Monad.Aff.Console (CONSOLE, errorShow, log)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import Control.Monad.Eff.Unsafe (unsafePerformEff)
import Control.Monad.Except (runExcept)
import DOM (DOM)
import Data.Array (reverse, sort, sortWith)
import Data.Either (Either(Left), either)
import Data.Foreign (ForeignError)
import Data.Foreign.Class (class Encode, class Decode, encode)
import Data.Foreign.Generic (decodeJSON)
import Data.List.NonEmpty (NonEmptyList)
import Data.Maybe (Maybe(Nothing, Just), isJust, maybe)
import Data.Monoid (mempty)
import Data.Newtype (unwrap, wrap)
import Data.Traversable (find)
import Data.Tuple (Tuple(..))
import Data.Validation.Semigroup (V, invalid, unV)
import Global.Unsafe (unsafeStringify)
import Network.HTTP.Affjax (AJAX)
import Routes (Route(..), files, open, update, watched)
import Types (FileData(..), OpenRequest(..), Path, WatchedData(..))

type VE a = V (NonEmptyList ForeignError) a

request :: forall req res m eff.
  MonadAff
    ( ajax :: AJAX
    | eff
    )
    m
  => Encode req
  => Decode res
  => Route req res -> Maybe req -> m (VE res)
request (Route route) body =
  H.liftAff $ either invalid pure <$> parseResponse <$> action
  where
    action = AJ.affjax $ AJ.defaultRequest
      { method = Left route.method
      , url = route.url
      , content = unsafeStringify <<< encode <$> body
      }
    parseResponse response =
      runExcept $ decodeJSON response.response

unV' :: forall e a m.
  MonadAff
    ( console :: CONSOLE
    | e
    )
    m
  => (a -> m Unit) -> VE a -> m Unit
unV' = unV (H.liftAff <<< errorShow)

data Dir = ASC | DSC
derive instance eqDir :: Eq Dir
data Col = Title | Status
derive instance eqCol :: Eq Col
data Sorting = Sorting Col Dir | NoSorting

type State =
  { files :: Array Path
  , watched :: Array WatchedData
  , sorting :: Sorting
  }

data Query a
  = Init a
  | OpenFile Path a
  | SetWatched Path Boolean a
  | ChangeSorting Col a

type AppEffects eff =
  Aff
  ( ajax :: AJAX
  , console :: CONSOLE
  | eff )

ui :: forall eff. H.Component HH.HTML Query Unit Void (AppEffects eff)
ui =
  H.lifecycleComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }
  where
    initialState :: State
    initialState =
      { files: mempty
      , watched: mempty
      , sorting: NoSorting
      }

    render :: State -> H.ComponentHTML Query
    render state =
      HH.div
        [ HP.class_ $ wrap "container" ]
        $ [ HH.h1_ [ HH.text "Vidtracker" ]
          , HH.div
            [ HP.class_ $ wrap "file"]
            [ HH.h3
              [ HP.class_ $ wrap "file-link"
              , HE.onClick $ HE.input_ (ChangeSorting Title)
              ] [ HH.text $ "Title" <> displayTicker Title ]
            , HH.h3
              [ HP.class_ $ wrap "file-button"
              , HE.onClick $ HE.input_ (ChangeSorting Status)
              ] [ HH.text $ "Status" <> displayTicker Status ]
            , HH.h3 [HP.class_ $ wrap "file-note"] [ HH.text "Date" ]
            ]
          ] <> (file <$> applySort state.files)
      where
        displayTicker col
          | Sorting col' dir <- state.sorting
          , asc <- dir == ASC
          , col' == col = if asc
            then " ㊤"
            else " ㊦"
          | otherwise = ""
        applySort
          | Sorting col dir <- state.sorting
          , rev <- if dir == ASC then id else reverse
          = rev <<< case col of
              Title -> sort
              Status -> sortWith findWatched
          | otherwise = id
        findWatched path = find (\(WatchedData fd) -> fd.path == path) state.watched
        file path =
          HH.div
            [ HP.class_ $ wrap "file"]
            [ HH.a
              [ HP.classes $ wrap <$>
                [ "file-link"
                , maybe "" (const "watched") watched
                ]
              , HE.onClick $ HE.input_ (OpenFile path) ]
              [ HH.text $ unwrap path ]
            , HH.button
              [ HP.classes $ wrap <$>
                [ "file-button"
                , "pure-button"
                , maybe "" (const "pure-button-primary") watched
                ]
              , HE.onClick $ HE.input_ (SetWatched path (not $ isJust watched))
              ]
              [ HH.text $ maybe "not watched" (const "watched") watched ]
            , HH.span
              [ HP.class_ $ wrap "file-note" ]
              [ HH.text $ maybe "" id watched ]
            ]
          where
            watched = getDate <$> findWatched path
            getDate (WatchedData {created}) = JSDate.toDateString <<< unsafePerformEff <<< JSDate.parse $ created

    eval :: Query ~> H.ComponentDSL State Query Void (AppEffects eff)
    eval (Init next) = do
      getResult >>= unV'
        \(Tuple f w) -> H.modify _ {files = f, watched = w}
      pure next
      where
        getResult = do
          files <- request files Nothing
          watched <- request watched Nothing
          pure $ Tuple <$> files <*> watched

    eval (OpenFile path next) = do
      _ <- request open $ Just (OpenRequest {path})
      pure next

    eval (SetWatched path flag next) = do
      request update (Just $ FileData {path, watched: flag}) >>= unV'
        \w -> H.modify _ {watched = w}
      pure next

    eval (ChangeSorting col next)= do
      H.modify $ \s -> case s.sorting of
        Sorting curr dir | curr == col ->
          s {sorting = case dir of
              ASC -> Sorting col DSC
              DSC -> NoSorting
            }
        _ -> s {sorting = Sorting col ASC}
      pure next

main :: forall e.
  Eff
    ( avar :: AVAR
    , ref :: REF
    , exception :: EXCEPTION
    , dom :: DOM
    , console :: CONSOLE
    , ajax :: AJAX
    | e
    )
    Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  io <- D.runUI ui unit body

  log "Running"


Stop swallowing "Compiling <module>" messages (#49)

Instead, ensure they are fed back to the psa process's stdout or stderr
as appropriate by passing the corresponding element of `Child.inherit`
to the `stdio` option of `Child.spawn`.