Unwrap singleton values in markdown code evaluation

{-
Copyright 2016 SlamData, Inc.
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
    http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Markdown.Eval
  ( markdownEval
  ) where

import SlamData.Prelude

import Control.Monad.Aff as Aff
import Control.Monad.Aff.Free as AffF
import Control.Monad.Eff.Class as Eff
import Control.Monad.Eff.Exception as Exn
import Control.Monad.Error.Class as Err
import Control.Monad.Writer.Trans as WT

import Data.Array as A
import Data.Date as D
import Data.Date.Locale as DL
import Data.Enum as Enum
import Data.Foldable as F
import Data.Identity (Identity)
import Data.Json.Extended as EJSON
import Data.List as L
import Data.Set as Set
import Data.String as S
import Data.Time as DT

import SlamData.Effects (Slam, SlamDataEffects)
import SlamData.Workspace.Card.Eval.CardEvalT as CET
import SlamData.Workspace.Card.Port as Port
import SlamData.Quasar.Query as Quasar
import SlamData.Workspace.Deck.AdditionalSource (AdditionalSource)

import Text.Markdown.SlamDown as SD
import Text.Markdown.SlamDown.Traverse as SDT
import Text.Markdown.SlamDown.Eval as SDE
import Text.Markdown.SlamDown.Parser as SDP

import Text.Parsing.Parser as P
import Text.Parsing.Parser.Combinators as PC
import Text.Parsing.Parser.String as PS

import Utils.Path (DirPath)

markdownEval
  ∷ ∀ m
  . (Monad m, AffF.Affable SlamDataEffects m)
  ⇒ CET.CardEvalInput
  → String
  → CET.CardEvalT m Port.Port
markdownEval { path } str = do
  result  ← lift ∘ AffF.fromAff ∘ Aff.attempt ∘ evalEmbeddedQueries path $ SDP.parseMd str
  case result of
    Left e → Err.throwError $ Exn.message e
    Right (doc × as) → do
      CET.additionalSources as
      pure $ Port.SlamDown doc

findFields
  ∷ ∀ a
  . SD.SlamDownP a
  → Array String
findFields = SDT.everything (const mempty) extractField
  where
  extractField ∷ SD.Inline a → Array String
  extractField (SD.FormField label _ _) = pure label
  extractField _ = mempty

type EvalM = WT.WriterT (Set.Set AdditionalSource) Slam

runEvalM ∷ ∀ a. EvalM a → Slam (a × (Set.Set AdditionalSource))
runEvalM = WT.runWriterT

evalEmbeddedQueries
  ∷ DirPath
  → SD.SlamDownP Port.VarMapValue
  → Slam ((SD.SlamDownP Port.VarMapValue) × (Set.Set AdditionalSource))
evalEmbeddedQueries dir =
  runEvalM ∘
    SDE.eval
      { code: evalCode
      , textBox: evalTextBox
      , value: evalValue
      , list: evalList
      }

  where

  evalCode
    ∷ Maybe SDE.LanguageId
    → String
    → EvalM Port.VarMapValue
  evalCode mid code
    | languageIsSql mid = Port.Literal ∘ extractCodeValue <$> runQuery code
    | otherwise = pure $ Port.QueryExpr code

  extractCodeValue ∷ Array EJSON.EJson → EJSON.EJson
  extractCodeValue [ej] = extractSingletonObject ej
  extractCodeValue arr = EJSON.array arr

  languageIsSql
    ∷ Maybe SDE.LanguageId
    → Boolean
  languageIsSql =
    maybe
      true
      ((_ ≡ "sql") ∘ S.toLower)

  extractSingletonObject
    ∷ EJSON.EJson
    → EJSON.EJson
  extractSingletonObject lit =
    case EJSON.unroll lit of
      EJSON.Object [Tuple key val] → val
      _ → lit

  evalValue
    ∷ String
    → EvalM Port.VarMapValue
  evalValue code = do
    maybe (Port.Literal EJSON.null) (Port.Literal ∘ extractSingletonObject) ∘ A.head
      <$> runQuery code

  evalTextBox
    ∷ SD.TextBox (Const String)
    → EvalM (SD.TextBox Identity)
  evalTextBox tb = do
    let sql = getConst $ SD.traverseTextBox (map \_ → Const unit) tb
    mresult ← A.head <$> runQuery sql
    result ← maybe (Err.throwError $ Exn.error "No results") (pure ∘ extractSingletonObject) mresult
    case Tuple tb (EJSON.unroll result) of
      Tuple (SD.PlainText _) (EJSON.String str) →
        pure ∘ SD.PlainText $ pure str
      Tuple (SD.Numeric _) (EJSON.Decimal a) →
        pure ∘ SD.Numeric $ pure a
      Tuple (SD.Time _) (EJSON.Time str) →
        SD.Time ∘ pure <$> parse parseSqlTime str
      Tuple (SD.Date _) (EJSON.Date str) →
        SD.Date ∘ pure <$> parse parseSqlDate str
      Tuple (SD.DateTime _) (EJSON.Timestamp str) →
        SD.DateTime ∘ pure <$> parseSqlTimeStamp str
      _ → Err.throwError ∘ Exn.error $ "Type error: " ⊕ show result ⊕ " does not match " ⊕ show tb
    where
      parse ∷ ∀ s a. P.Parser s a → s → EvalM a
      parse p str =
        case P.runParser str p of
          Left err → Err.throwError ∘ Exn.error $ "Parse error: " ⊕ show err
          Right a → pure a

  evalList
    ∷ String
    → EvalM (L.List Port.VarMapValue)
  evalList code = do
    items ← map extractSingletonObject <$> runQuery code
    let limit = 500
    pure ∘ L.toList $
      if A.length items > limit
        then map Port.Literal (A.take limit items) ⊕ [ SD.stringValue $ "<" ⊕ show limit ⊕ "item limit reached>" ]
        else Port.Literal <$> items

  runQuery
    ∷ String
    → EvalM (Array EJSON.EJson)
  runQuery code = do
    compiled ← Quasar.compile (Left dir) code mempty
    case compiled of
      Left e → Err.throwError e
      Right {inputs} → CET.addSources inputs

    result ← Quasar.queryEJson dir code

    either
      (Err.throwError ∘ Exn.error)
      pure
      result

parseDigit ∷ P.Parser String Int
parseDigit =
  PC.choice
    [ 0 <$ PS.string "0"
    , 1 <$ PS.string "1"
    , 2 <$ PS.string "2"
    , 3 <$ PS.string "3"
    , 4 <$ PS.string "4"
    , 5 <$ PS.string "5"
    , 6 <$ PS.string "6"
    , 7 <$ PS.string "7"
    , 8 <$ PS.string "8"
    , 9 <$ PS.string "9"
    ]

many1
  ∷ ∀ s a
  . P.Parser s a
  → P.Parser s (L.List a)
many1 p =
  L.Cons
    <$> p
    <*> L.many p

parseNat ∷ P.Parser String Int
parseNat =
  many1 parseDigit
    <#> F.foldl (\a i → a * 10 + i) 0

hyphen ∷ P.Parser String Unit
hyphen = void $ PS.string "-"

colon ∷ P.Parser String Unit
colon = void $ PS.string ":"

parseSqlDate ∷ P.Parser String SD.DateValue
parseSqlDate = do
  year ← parseNat
  hyphen
  month ← parseNat
  hyphen
  day ← parseNat
  pure { year, month, day }

parseSqlTime ∷ P.Parser String SD.TimeValue
parseSqlTime = do
  hours ← parseNat
  colon
  minutes ← parseNat
  colon
  _ ← parseNat -- seconds
  pure { hours, minutes }

-- | Parses a date-time string into the user's current locale.
parseSqlTimeStamp
  ∷ String
  → EvalM SD.DateTimeValue
parseSqlTimeStamp str = do
  case D.fromString str of
    Nothing → Err.throwError ∘ Exn.error $ "Invalid date: " ⊕ show str
    Just d → Eff.liftEff do
      D.Year year ← DL.year d
      month ← Enum.fromEnum <$> DL.month d
      D.DayOfMonth day ← DL.dayOfMonth d
      DT.HourOfDay hours ← DL.hourOfDay d
      DT.MinuteOfHour minutes ← DL.minuteOfHour d
      pure
        { date: { year , month , day }
        , time: { hours , minutes }
        }

{-
Copyright 2016 SlamData, Inc.
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
    http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Markdown.Eval
  ( markdownEval
  ) where

import SlamData.Prelude

import Control.Monad.Aff as Aff
import Control.Monad.Aff.Free as AffF
import Control.Monad.Eff.Class as Eff
import Control.Monad.Eff.Exception as Exn
import Control.Monad.Error.Class as Err
import Control.Monad.Writer.Trans as WT

import Data.Array as A
import Data.Date as D
import Data.Date.Locale as DL
import Data.Enum as Enum
import Data.Foldable as F
import Data.Identity (Identity)
import Data.Json.Extended as EJSON
import Data.List as L
import Data.Set as Set
import Data.String as S
import Data.Time as DT

import SlamData.Effects (Slam, SlamDataEffects)
import SlamData.Workspace.Card.Eval.CardEvalT as CET
import SlamData.Workspace.Card.Port as Port
import SlamData.Quasar.Query as Quasar
import SlamData.Workspace.Deck.AdditionalSource (AdditionalSource)

import Text.Markdown.SlamDown as SD
import Text.Markdown.SlamDown.Traverse as SDT
import Text.Markdown.SlamDown.Eval as SDE
import Text.Markdown.SlamDown.Parser as SDP

import Text.Parsing.Parser as P
import Text.Parsing.Parser.Combinators as PC
import Text.Parsing.Parser.String as PS

import Utils.Path (DirPath)

markdownEval
  ∷ ∀ m
  . (Monad m, AffF.Affable SlamDataEffects m)
  ⇒ CET.CardEvalInput
  → String
  → CET.CardEvalT m Port.Port
markdownEval { path } str = do
  result  ← lift ∘ AffF.fromAff ∘ Aff.attempt ∘ evalEmbeddedQueries path $ SDP.parseMd str
  case result of
    Left e → Err.throwError $ Exn.message e
    Right (doc × as) → do
      CET.additionalSources as
      pure $ Port.SlamDown doc

findFields
  ∷ ∀ a
  . SD.SlamDownP a
  → Array String
findFields = SDT.everything (const mempty) extractField
  where
  extractField ∷ SD.Inline a → Array String
  extractField (SD.FormField label _ _) = pure label
  extractField _ = mempty

type EvalM = WT.WriterT (Set.Set AdditionalSource) Slam

runEvalM ∷ ∀ a. EvalM a → Slam (a × (Set.Set AdditionalSource))
runEvalM = WT.runWriterT

evalEmbeddedQueries
  ∷ DirPath
  → SD.SlamDownP Port.VarMapValue
  → Slam ((SD.SlamDownP Port.VarMapValue) × (Set.Set AdditionalSource))
evalEmbeddedQueries dir =
  runEvalM ∘
    SDE.eval
      { code: evalCode
      , textBox: evalTextBox
      , value: evalValue
      , list: evalList
      }

  where

  evalCode
    ∷ Maybe SDE.LanguageId
    → String
    → EvalM Port.VarMapValue
  evalCode mid code
    | languageIsSql mid = Port.Literal ∘ EJSON.array <$> runQuery code
    | otherwise = pure $ Port.QueryExpr code

  languageIsSql
    ∷ Maybe SDE.LanguageId
    → Boolean
  languageIsSql =
    maybe
      true
      ((_ ≡ "sql") ∘ S.toLower)

  extractSingletonObject
    ∷ EJSON.EJson
    → EJSON.EJson
  extractSingletonObject lit =
    case EJSON.unroll lit of
      EJSON.Object [Tuple key val] → val
      _ → lit

  evalValue
    ∷ String
    → EvalM Port.VarMapValue
  evalValue code = do
    maybe (Port.Literal EJSON.null) (Port.Literal ∘ extractSingletonObject) ∘ A.head
      <$> runQuery code

  evalTextBox
    ∷ SD.TextBox (Const String)
    → EvalM (SD.TextBox Identity)
  evalTextBox tb = do
    let sql = getConst $ SD.traverseTextBox (map \_ → Const unit) tb
    mresult ← A.head <$> runQuery sql
    result ← maybe (Err.throwError $ Exn.error "No results") (pure ∘ extractSingletonObject) mresult
    case Tuple tb (EJSON.unroll result) of
      Tuple (SD.PlainText _) (EJSON.String str) →
        pure ∘ SD.PlainText $ pure str
      Tuple (SD.Numeric _) (EJSON.Decimal a) →
        pure ∘ SD.Numeric $ pure a
      Tuple (SD.Time _) (EJSON.Time str) →
        SD.Time ∘ pure <$> parse parseSqlTime str
      Tuple (SD.Date _) (EJSON.Date str) →
        SD.Date ∘ pure <$> parse parseSqlDate str
      Tuple (SD.DateTime _) (EJSON.Timestamp str) →
        SD.DateTime ∘ pure <$> parseSqlTimeStamp str
      _ → Err.throwError ∘ Exn.error $ "Type error: " ⊕ show result ⊕ " does not match " ⊕ show tb
    where
      parse ∷ ∀ s a. P.Parser s a → s → EvalM a
      parse p str =
        case P.runParser str p of
          Left err → Err.throwError ∘ Exn.error $ "Parse error: " ⊕ show err
          Right a → pure a

  evalList
    ∷ String
    → EvalM (L.List Port.VarMapValue)
  evalList code = do
    items ← map extractSingletonObject <$> runQuery code
    let limit = 500
    pure ∘ L.toList $
      if A.length items > limit
        then map Port.Literal (A.take limit items) ⊕ [ SD.stringValue $ "<" ⊕ show limit ⊕ "item limit reached>" ]
        else Port.Literal <$> items

  runQuery
    ∷ String
    → EvalM (Array EJSON.EJson)
  runQuery code = do
    compiled ← Quasar.compile (Left dir) code mempty
    case compiled of
      Left e → Err.throwError e
      Right {inputs} → CET.addSources inputs

    result ← Quasar.queryEJson dir code

    either
      (Err.throwError ∘ Exn.error)
      pure
      result

parseDigit ∷ P.Parser String Int
parseDigit =
  PC.choice
    [ 0 <$ PS.string "0"
    , 1 <$ PS.string "1"
    , 2 <$ PS.string "2"
    , 3 <$ PS.string "3"
    , 4 <$ PS.string "4"
    , 5 <$ PS.string "5"
    , 6 <$ PS.string "6"
    , 7 <$ PS.string "7"
    , 8 <$ PS.string "8"
    , 9 <$ PS.string "9"
    ]

many1
  ∷ ∀ s a
  . P.Parser s a
  → P.Parser s (L.List a)
many1 p =
  L.Cons
    <$> p
    <*> L.many p

parseNat ∷ P.Parser String Int
parseNat =
  many1 parseDigit
    <#> F.foldl (\a i → a * 10 + i) 0

hyphen ∷ P.Parser String Unit
hyphen = void $ PS.string "-"

colon ∷ P.Parser String Unit
colon = void $ PS.string ":"

parseSqlDate ∷ P.Parser String SD.DateValue
parseSqlDate = do
  year ← parseNat
  hyphen
  month ← parseNat
  hyphen
  day ← parseNat
  pure { year, month, day }

parseSqlTime ∷ P.Parser String SD.TimeValue
parseSqlTime = do
  hours ← parseNat
  colon
  minutes ← parseNat
  colon
  _ ← parseNat -- seconds
  pure { hours, minutes }

-- | Parses a date-time string into the user's current locale.
parseSqlTimeStamp
  ∷ String
  → EvalM SD.DateTimeValue
parseSqlTimeStamp str = do
  case D.fromString str of
    Nothing → Err.throwError ∘ Exn.error $ "Invalid date: " ⊕ show str
    Just d → Eff.liftEff do
      D.Year year ← DL.year d
      month ← Enum.fromEnum <$> DL.month d
      D.DayOfMonth day ← DL.dayOfMonth d
      DT.HourOfDay hours ← DL.hourOfDay d
      DT.MinuteOfHour minutes ← DL.minuteOfHour d
      pure
        { date: { year , month , day }
        , time: { hours , minutes }
        }


docs and a few more helpers for nested eithers

-- | Utilities for n-eithers: sums types with more than two terms built from nested eithers.
-- |
-- | Nested eithers arise naturally in sum combinators. You shouldn't
-- | represent sum data using nested eithers, but if combinators you're working with
-- | create them, utilities in this module will allow to to more easily work
-- | with them, including translating to and from more traditional sum types.
-- |
-- | ```purescript
-- | data Color = Red Number | Green Number | Blue Number
-- |
-- | toEither3 :: Color -> Either3 Number Number Number
-- | toEither3 = either3 Red Green Blue
-- |
-- | fromEither3 :: Either3 Number Number Number -> Color
-- | fromEither3 (Red   v) = either1of3
-- | fromEither3 (Green v) = either2of3
-- | fromEither3 (Blue  v) = either3of3
-- | ```
module Data.Either.Nested where
  import Data.Either

  type Either2 a z = Either a z
  type Either3 a b z = Either (Either2 a b) z
  type Either4 a b c z = Either (Either3 a b c) z
  type Either5 a b c d z = Either (Either4 a b c d) z
  type Either6 a b c d e z = Either (Either5 a b c d e) z
  type Either7 a b c d e f z = Either (Either6 a b c d e f) z
  type Either8 a b c d e f g z = Either (Either7 a b c d e f g) z
  type Either9 a b c d e f g h z = Either (Either8 a b c d e f g h) z
  type Either10 a b c d e f g h i z = Either (Either9 a b c d e f g h i) z

  -- Either2
  either1of2 :: forall a b. a -> Either2 a b
  either1of2 = Left

  either2of2 :: forall a b. b -> Either2 a b
  either2of2 = Right

  -- Either3
  either1of3 = forall a b c. a -> Either3 a b c
  either1of3 v = (Left (Left v))

  either2of3 = forall a b c. b -> Either3 a b c
  either2of3 v = (Left (Right v))

  either3of3 = forall a b c. c -> Either3 a b c
  either3of3 v = Right v

  -- Either4
  either1of4 = forall a b c d. a -> Either4 a b c d
  either1of4 v = (Left (Left (Left v)))

  either2of4 = forall a b c d. b -> Either4 a b c d
  either2of4 v = (Left (Left (Right v)))

  either3of4 = forall a b c d. c -> Either4 a b c d
  either3of4 v = (Left (Right v))

  either4of4 = forall a b c d. d -> Either4 a b c d
  either4of4 v = Right v

  -- Either5
  either1of5 = forall a b c d e. a -> Either5 a b c d e
  either1of5 v = (Left (Left (Left (Left v))))

  either2of5 = forall a b c d e. b -> Either5 a b c d e
  either2of5 v = (Left (Left (Left (Right v))))

  either3of5 = forall a b c d e. c -> Either5 a b c d e
  either3of5 v = (Left (Left (Right v)))

  either4of5 = forall a b c d e. d -> Either5 a b c d e
  either4of5 v = (Left (Right v))

  either5of5 = forall a b c d e. e -> Either5 a b c d e
  either5of5 v = Right v

  -- Either6
  either1of6 = forall a b c d e f. a -> Either6 a b c d e f
  either1of6 v = (Left (Left (Left (Left (Left v)))))

  either2of6 = forall a b c d e f. b -> Either6 a b c d e f
  either2of6 v = (Left (Left (Left (Left (Right v)))))

  either3of6 = forall a b c d e f. c -> Either6 a b c d e f
  either3of6 v = (Left (Left (Left (Right v))))

  either4of6 = forall a b c d e f. d -> Either6 a b c d e f
  either4of6 v = (Left (Left (Right v)))

  either5of6 = forall a b c d e f. e -> Either6 a b c d e f
  either5of6 v = (Left (Right v))

  either6of6 = forall a b c d e f. f -> Either6 a b c d e f
  either6of6 v = Right v

  -- Either7
  either1of7 = forall a b c d e f g. a -> Either7 a b c d e f g
  either1of7 v = (Left (Left (Left (Left (Left (Left v))))))

  either2of7 = forall a b c d e f g. b -> Either7 a b c d e f g
  either2of7 v = (Left (Left (Left (Left (Left (Right v))))))

  either3of7 = forall a b c d e f g. c -> Either7 a b c d e f g
  either3of7 v = (Left (Left (Left (Left (Right v)))))

  either4of7 = forall a b c d e f g. d -> Either7 a b c d e f g
  either4of7 v = (Left (Left (Left (Right v))))

  either5of7 = forall a b c d e f g. e -> Either7 a b c d e f g
  either5of7 v = (Left (Left (Right v)))

  either6of7 = forall a b c d e f g. f -> Either7 a b c d e f g
  either6of7 v = (Left (Right v))

  either7of7 = forall a b c d e f g. g -> Either7 a b c d e f g
  either7of7 v = Right v

  -- Either8
  either1of8 = forall a b c d e f g h. a -> Either8 a b c d e f g h
  either1of8 v = (Left (Left (Left (Left (Left (Left (Left v)))))))

  either2of8 = forall a b c d e f g h. b -> Either8 a b c d e f g h
  either2of8 v = (Left (Left (Left (Left (Left (Left (Right v)))))))

  either3of8 = forall a b c d e f g h. c -> Either8 a b c d e f g h
  either3of8 v = (Left (Left (Left (Left (Left (Right v))))))

  either4of8 = forall a b c d e f g h. d -> Either8 a b c d e f g h
  either4of8 v = (Left (Left (Left (Left (Right v)))))

  either5of8 = forall a b c d e f g h. e -> Either8 a b c d e f g h
  either5of8 v = (Left (Left (Left (Right v))))

  either6of8 = forall a b c d e f g h. f -> Either8 a b c d e f g h
  either6of8 v = (Left (Left (Right v)))

  either7of8 = forall a b c d e f g h. g -> Either8 a b c d e f g h
  either7of8 v = (Left (Right v))

  either8of8 = forall a b c d e f g h. h -> Either8 a b c d e f g h
  either8of8 v = Right v

  -- Either9
  either1of9 = forall a b c d e f g h i. a -> Either9 a b c d e f g h i
  either1of9 v = (Left (Left (Left (Left (Left (Left (Left (Left v)))))))))

  either2of9 = forall a b c d e f g h i. b -> Either9 a b c d e f g h i
  either2of9 v = (Left (Left (Left (Left (Left (Left (Left (Right v)))))))))

  either3of9 = forall a b c d e f g h i. c -> Either9 a b c d e f g h i
  either3of9 v = (Left (Left (Left (Left (Left (Left (Right v))))))))

  either4of9 = forall a b c d e f g h i. d -> Either9 a b c d e f g h i
  either4of9 v = (Left (Left (Left (Left (Left (Right v)))))))

  either5of9 = forall a b c d e f g h i. e -> Either9 a b c d e f g h i
  either5of9 v = (Left (Left (Left (Left (Right v))))))

  either6of9 = forall a b c d e f g h i. f -> Either9 a b c d e f g h i
  either6of9 v = (Left (Left (Left (Right v)))))

  either7of9 = forall a b c d e f g h i. g -> Either9 a b c d e f g h i
  either7of9 v = (Left (Left (Right v))))

  either8of9 = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
  either8of9 v = (Left (Right v)))

  either9of9 = forall a b c d e f g h i. i -> Either9 a b c d e f g h i
  either9of9 v = Right v

  -- Either10
  either1of10 = forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
  either1of10 v = (Left (Left (Left (Left (Left (Left (Left (Left (Left v))))))))))

  either2of10 = forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
  either2of10 v = (Left (Left (Left (Left (Left (Left (Left (Left (Right v))))))))))

  either3of10 = forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
  either3of10 v = (Left (Left (Left (Left (Left (Left (Left (Right v)))))))))

  either4of10 = forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
  either4of10 v = (Left (Left (Left (Left (Left (Left (Right v))))))))

  either5of10 = forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
  either5of10 v = (Left (Left (Left (Left (Left (Right v)))))))

  either6of10 = forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
  either6of10 v = (Left (Left (Left (Left (Right v))))))

  either7of10 = forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
  either7of10 v = (Left (Left (Left (Right v)))))

  either8of10 = forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
  either8of10 v = (Left (Left (Right v))))

  either9of10 = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
  either9of10 v = (Left (Right v)))

  either10of10 = forall a b c d e f g h i j. j -> Either10 a b c d e f g h i j
  either10of10 v = Right v

  either2 :: forall a b z. (a -> z) -> (b -> z) -> Either2 a b -> z
  either2 = either

  either3 :: forall a b c z. (a -> z) -> (b -> z) -> (c -> z) -> Either3 a b c -> z
  either3 a b z = either (either2 a b) z

  either4 :: forall a b c d z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> Either4 a b c d -> z
  either4 a b c z = either (either3 a b c) z

  either5 :: forall a b c d e z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> Either5 a b c d e -> z
  either5 a b c d z = either (either4 a b c d) z

  either6 :: forall a b c d e f z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> Either6 a b c d e f -> z
  either6 a b c d e z = either (either5 a b c d e) z

  either7 :: forall a b c d e f g z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> Either7 a b c d e f g -> z
  either7 a b c d e f z = either (either6 a b c d e f) z

  either8 :: forall a b c d e f g h z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> Either8 a b c d e f g h -> z
  either8 a b c d e f g z = either (either7 a b c d e f g) z

  either9 :: forall a b c d e f g h i z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> (i -> z) -> Either9 a b c d e f g h i -> z
  either9 a b c d e f g h z = either (either8 a b c d e f g h) z

  either10 :: forall a b c d e f g h i j z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> (i -> z) -> (j -> z) -> Either10 a b c d e f g h i j -> z
  either10 a b c d e f g h i z = either (either9 a b c d e f g h i) z

module Data.Either.Nested where
  import Data.Either

  type Either2 a z = Either a z
  type Either3 a b z = Either (Either2 a b) z
  type Either4 a b c z = Either (Either3 a b c) z
  type Either5 a b c d z = Either (Either4 a b c d) z
  type Either6 a b c d e z = Either (Either5 a b c d e) z
  type Either7 a b c d e f z = Either (Either6 a b c d e f) z
  type Either8 a b c d e f g z = Either (Either7 a b c d e f g) z
  type Either9 a b c d e f g h z = Either (Either8 a b c d e f g h) z
  type Either10 a b c d e f g h i z = Either (Either9 a b c d e f g h i) z

  either2 :: forall a b z. (a -> z) -> (b -> z) -> Either2 a b -> z
  either2 = either

  either3 :: forall a b c z. (a -> z) -> (b -> z) -> (c -> z) -> Either3 a b c -> z
  either3 a b z = either (either2 a b) z

  either4 :: forall a b c d z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> Either4 a b c d -> z
  either4 a b c z = either (either3 a b c) z

  either5 :: forall a b c d e z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> Either5 a b c d e -> z
  either5 a b c d z = either (either4 a b c d) z

  either6 :: forall a b c d e f z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> Either6 a b c d e f -> z
  either6 a b c d e z = either (either5 a b c d e) z

  either7 :: forall a b c d e f g z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> Either7 a b c d e f g -> z
  either7 a b c d e f z = either (either6 a b c d e f) z

  either8 :: forall a b c d e f g h z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> Either8 a b c d e f g h -> z
  either8 a b c d e f g z = either (either7 a b c d e f g) z

  either9 :: forall a b c d e f g h i z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> (i -> z) -> Either9 a b c d e f g h i -> z
  either9 a b c d e f g h z = either (either8 a b c d e f g h) z

  either10 :: forall a b c d e f g h i j z. (a -> z) -> (b -> z) -> (c -> z) -> (d -> z) -> (e -> z) -> (f -> z) -> (g -> z) -> (h -> z) -> (i -> z) -> (j -> z) -> Either10 a b c d e f g h i j -> z
  either10 a b c d e f g h i z = either (either9 a b c d e f g h i) z


just rules

just rules

module Content.Slide.Test (tests) where

import Prelude (Unit, ($), (==), pure, (<<<), (<>), discard)
import Data.List (List(..), (:))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Aff.AVar (AVAR)
import Text.Markdown.SlamDown (SlamDown, SlamDownP(..))
import Text.Markdown.SlamDown.Syntax (Block(..), Inline(..))
import Test.Unit (suite, test)
import Test.Unit.Console (TESTOUTPUT)
import Test.Unit.Main (runTest)
import Test.Unit.Assert (assert)

import Content.Slide (slides)

p1 :: ∀ a. Block a
p1 = Paragraph $ Str "paragraph 1" : Nil

p2 :: ∀ a. Block a
p2 = Paragraph $ Str "paragraph 2" : Nil

p3 :: ∀ a. Block a
p3 = Paragraph $ Str "paragraph 3" : Nil

slam :: ∀ a. Block a -> SlamDownP a
slam = SlamDown <<< pure

blank :: ∀ a. SlamDownP a
blank = SlamDown Nil

tests :: ∀ fx. Eff ( console :: CONSOLE
                  , testOutput :: TESTOUTPUT
                  , avar :: AVAR
                  | fx
          ) Unit
tests = do
  runTest do
    suite "Content.Slide" do
        test "break into slides" do
            let actual = slides $ SlamDown ( p1 : Rule : p2 : p3 : Rule : p1 : Rule : Rule : p2 : Nil) :: SlamDown
            let expected = slam p1 : (slam p2 <> slam p3) : slam p1 : blank : slam p2 : Nil
            assert "break at rules" $ actual == expected
        test "start and end with rules" do
            let actual = slides $ SlamDown ( Rule : p2 : p3 : Rule : Nil) :: SlamDown
            let expected = blank : (slam p2 <> slam p3) : blank : Nil
            assert "break at rules" $ actual == expected
        test "just rules" do
            let actual = slides $ SlamDown ( Rule : Rule : Rule : Nil) :: SlamDown
            let expected = blank : blank : blank : blank : Nil
            assert "break at rules" $ actual == expected


Remove 'ARGS...' from '--' prettyPrint

Remove 'ARGS...' from '--' prettyPrint

module Language.Docopt.Parser.Usage.Argument (
    Argument (..)
  , IsRepeatable ()
  , IsOptional ()
  , Branch ()
  , isFree
  , isOption
  , isPositional
  , isCommand
  , prettyPrintArg
  , prettyPrintBranch
  , sopt, sopt_, soptR, soptR_
  , lopt, lopt_, loptR, loptR_
  , eoa
  , co
  , po
  , poR
  , ref
  , stdin
  ) where

import Prelude
import Data.List (List())
import Data.Foldable (intercalate, all)
import Language.Docopt.Parser.Usage.Option as O

type IsRepeatable = Boolean
type IsOptional = Boolean
type Branch = List Argument
data Argument
  = Command     String IsRepeatable
  | Positional  String IsRepeatable
  | Option      O.LOpt
  | OptionStack O.SOpt
  | Group       IsOptional (List Branch) IsRepeatable
  | EOA
  | Stdin
  | Reference String

isFree :: Argument -> Boolean
isFree (Option _)     = true
isFree (Group _ bs _) = all (all isFree) bs
isFree _              = false

isOption :: Argument -> Boolean
isOption (Option _)      = true
isOption (OptionStack _) = true
isOption _               = false

isPositional :: Argument -> Boolean
isPositional (Positional _ _) = true
isPositional _                = false

isCommand :: Argument -> Boolean
isCommand (Command _ _) = true
isCommand _             = false

instance showArgument :: Show Argument where
  show (EOA)            = "--"
  show (Stdin)          = "-"
  show (Reference r)    = "Reference " ++ r
  show (Command n r)    = "Command " ++ n ++ show r
  show (Positional n r) = "Positional " ++ n ++ " " ++ show r
  show (Option o)       = "Option " ++ show o
  show (OptionStack o)  = "OptionStack " ++ show o
  show (Group n b o)    = "Group " ++ show n ++ " " ++ show b ++ " " ++ show o

instance eqArgument :: Eq Argument where
  eq (Stdin)          (Stdin)            = true
  eq (EOA)            (EOA)              = true
  eq (Command s r)    (Command s' r')    = (s == s') && (r == r')
  eq (Positional s r) (Positional s' r') = (s == s') && (r == r')
  eq (Option o)       (Option o')        = o == o'
  eq (Group b xs r)   (Group b' xs' r')  = (b == b') && (xs == xs') && (r == r')
  eq (OptionStack o)  (OptionStack o')   = o == o'
  eq (Reference r)    (Reference r')     = r == r'
  eq _                _                  = false

prettyPrintBranch :: Branch -> String
prettyPrintBranch xs = intercalate " " (prettyPrintArg <$> xs)

prettyPrintArg :: Argument -> String
prettyPrintArg (Command n r)
  = n ++ if r then "..." else ""
prettyPrintArg (Positional n r)
  = n ++ if r then "..." else ""
prettyPrintArg (Option o) = O.prettyPrintLOpt o
prettyPrintArg (OptionStack o) = O.prettyPrintSOpt o
prettyPrintArg (Group b xs r)
  =  (if b then "[" else "(")
  ++ (intercalate " | " (prettyPrintBranch <$> xs))
  ++ (if b then "]" else ")")
  ++ (if r then "..." else "")
prettyPrintArg (EOA) = "--"
prettyPrintArg (Stdin) = "-"
prettyPrintArg (Reference r) = "[" ++ show r ++ " options...]"

ref :: String -> Argument
ref = Reference

-- short hand to create a short option node
sopt :: Char -> Array Char -> O.Argument -> Argument
sopt f fs a = OptionStack $ O.sopt f fs a

sopt_ :: Char -> Array Char -> Argument
sopt_ f fs = OptionStack $ O.sopt_ f fs

soptR :: Char -> Array Char -> O.Argument -> Argument
soptR f fs a = OptionStack $ O.soptR f fs a

soptR_ :: Char -> Array Char -> Argument
soptR_ f fs = OptionStack $ O.soptR_ f fs

-- short hand to create a long option node
lopt :: String -> O.Argument -> Argument
lopt n a = Option $ O.lopt n a

lopt_ :: String -> Argument
lopt_ n = Option $ O.lopt_ n

loptR :: String -> O.Argument -> Argument
loptR n a = Option $ O.loptR n a

loptR_ :: String -> Argument
loptR_ n = Option $ O.loptR_ n

-- short hand to create an end-of-argument marker
eoa :: Argument
eoa = EOA

-- short hand to create an stdin marker
stdin :: Argument
stdin = Stdin

-- short hand to create a command node
co :: String -> Argument
co n = Command n false

-- short hand to create a positional node
po :: String -> Argument
po n = Positional n false

poR :: String -> Argument
poR n = Positional n true

module Language.Docopt.Parser.Usage.Argument (
    Argument (..)
  , IsRepeatable ()
  , IsOptional ()
  , Branch ()
  , isFree
  , isOption
  , isPositional
  , isCommand
  , prettyPrintArg
  , prettyPrintBranch
  , sopt, sopt_, soptR, soptR_
  , lopt, lopt_, loptR, loptR_
  , eoa
  , co
  , po
  , poR
  , ref
  , stdin
  ) where

import Prelude
import Data.List (List())
import Data.Foldable (intercalate, all)
import Language.Docopt.Parser.Usage.Option as O

type IsRepeatable = Boolean
type IsOptional = Boolean
type Branch = List Argument
data Argument
  = Command     String IsRepeatable
  | Positional  String IsRepeatable
  | Option      O.LOpt
  | OptionStack O.SOpt
  | Group       IsOptional (List Branch) IsRepeatable
  | EOA
  | Stdin
  | Reference String

isFree :: Argument -> Boolean
isFree (Option _)     = true
isFree (Group _ bs _) = all (all isFree) bs
isFree _              = false

isOption :: Argument -> Boolean
isOption (Option _)      = true
isOption (OptionStack _) = true
isOption _               = false

isPositional :: Argument -> Boolean
isPositional (Positional _ _) = true
isPositional _                = false

isCommand :: Argument -> Boolean
isCommand (Command _ _) = true
isCommand _             = false

instance showArgument :: Show Argument where
  show (EOA)            = "--"
  show (Stdin)          = "-"
  show (Reference r)    = "Reference " ++ r
  show (Command n r)    = "Command " ++ n ++ show r
  show (Positional n r) = "Positional " ++ n ++ " " ++ show r
  show (Option o)       = "Option " ++ show o
  show (OptionStack o)  = "OptionStack " ++ show o
  show (Group n b o)    = "Group " ++ show n ++ " " ++ show b ++ " " ++ show o

instance eqArgument :: Eq Argument where
  eq (Stdin)          (Stdin)            = true
  eq (EOA)            (EOA)              = true
  eq (Command s r)    (Command s' r')    = (s == s') && (r == r')
  eq (Positional s r) (Positional s' r') = (s == s') && (r == r')
  eq (Option o)       (Option o')        = o == o'
  eq (Group b xs r)   (Group b' xs' r')  = (b == b') && (xs == xs') && (r == r')
  eq (OptionStack o)  (OptionStack o')   = o == o'
  eq (Reference r)    (Reference r')     = r == r'
  eq _                _                  = false

prettyPrintBranch :: Branch -> String
prettyPrintBranch xs = intercalate " " (prettyPrintArg <$> xs)

prettyPrintArg :: Argument -> String
prettyPrintArg (Command n r)
  = n ++ if r then "..." else ""
prettyPrintArg (Positional n r)
  = n ++ if r then "..." else ""
prettyPrintArg (Option o) = O.prettyPrintLOpt o
prettyPrintArg (OptionStack o) = O.prettyPrintSOpt o
prettyPrintArg (Group b xs r)
  =  (if b then "[" else "(")
  ++ (intercalate " | " (prettyPrintBranch <$> xs))
  ++ (if b then "]" else ")")
  ++ (if r then "..." else "")
prettyPrintArg (EOA) = "-- ARGS..."
prettyPrintArg (Stdin) = "-"
prettyPrintArg (Reference r) = "[" ++ show r ++ " options...]"

ref :: String -> Argument
ref = Reference

-- short hand to create a short option node
sopt :: Char -> Array Char -> O.Argument -> Argument
sopt f fs a = OptionStack $ O.sopt f fs a

sopt_ :: Char -> Array Char -> Argument
sopt_ f fs = OptionStack $ O.sopt_ f fs

soptR :: Char -> Array Char -> O.Argument -> Argument
soptR f fs a = OptionStack $ O.soptR f fs a

soptR_ :: Char -> Array Char -> Argument
soptR_ f fs = OptionStack $ O.soptR_ f fs

-- short hand to create a long option node
lopt :: String -> O.Argument -> Argument
lopt n a = Option $ O.lopt n a

lopt_ :: String -> Argument
lopt_ n = Option $ O.lopt_ n

loptR :: String -> O.Argument -> Argument
loptR n a = Option $ O.loptR n a

loptR_ :: String -> Argument
loptR_ n = Option $ O.loptR_ n

-- short hand to create an end-of-argument marker
eoa :: Argument
eoa = EOA

-- short hand to create an stdin marker
stdin :: Argument
stdin = Stdin

-- short hand to create a command node
co :: String -> Argument
co n = Command n false

-- short hand to create a positional node
po :: String -> Argument
po n = Positional n false

poR :: String -> Argument
poR n = Positional n true