Fix move default

Fix move default

{-
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.Quasar.FS
  ( children
  , transitiveChildren
  , getNewName
  , move
  , listing
  , delete
  , messageIfFileNotFound
  , dirNotAccessible
  , fileNotAccessible
  , module Quasar.Error
  ) where

import SlamData.Prelude

import Control.Monad.Eff.Exception (error)

import Data.Array as Arr
import Data.Foldable as F
import Data.Lens ((.~), (^.), (^?), _Left)
import Data.List as List
import Data.Path.Pathy ((</>))
import Data.Path.Pathy as P
import Data.String as S

import Quasar.Advanced.QuasarAF as QF
import Quasar.Error (QError(..))
import Quasar.FS as QFS
import Quasar.FS.Mount as QFSM
import Quasar.FS.Resource as QR
import Quasar.Types (AnyPath, DirPath, FilePath)

import SlamData.Config as Config
import SlamData.FileSystem.Resource as R
import SlamData.Quasar.Class (class QuasarDSL, liftQuasar)
import SlamData.Quasar.Data as QD

import SlamData.Workspace.Model as WM
import SlamData.Workspace.Deck.Model as DM
import SlamData.Workspace.Card.Model as CM
import SlamData.Workspace.Deck.DeckId as DID
import SlamData.Workspace.Card.Draftboard.Pane as Pane

import Utils.Array (enumerate)
import Utils.Ace (RangeRec)

children
  ∷ ∀ m
  . (Monad m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
children dir = runExceptT do
  cs ← ExceptT $ listing dir
  let result = (R._root .~ dir) <$> cs
  -- TODO: do this somewhere more appropriate
  -- lift $ fromAff $ memoizeCompletionStrs dir result
  pure result

transitiveChildren
  ∷ ∀ f m
  . (Parallel f m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
transitiveChildren start = runExceptT do
  rs ← ExceptT $ children start
  cs ← parTraverse go rs
  pure $ rs <> join cs
  where
  go :: R.Resource → ExceptT QError m (Array R.Resource)
  go r = case R.getPath r of
    Left dir → do
      crs ← ExceptT $ transitiveChildren dir
      pure $ [r] <> crs
    Right _ → pure [r]

listing
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
listing p =
  map (map toResource) <$> liftQuasar (QF.dirMetadata p)
  where
  toResource ∷ QFS.Resource → R.Resource
  toResource res = case res of
    QFS.File path → R.File path
    QFS.Directory path →
      let workspaceName
            = S.stripSuffix (S.Pattern $ "." <> Config.workspaceExtension)
            ∘ P.runDirName =<< P.dirName path
      in case workspaceName of
        Just name → R.Workspace (p </> P.dir name)
        Nothing → R.Directory path
    QFS.Mount m → R.Mount $ either R.Database R.View $ QFSM.getPath m

-- | Generates a new resource name based on a directory path and a name for the
-- | resource. If the name already exists in the path a number is appended to
-- | the end of the name.
getNewName
  ∷ ∀ m
  . (Monad m, QuasarDSL m)
  ⇒ DirPath
  → String
  → m (Either QError String)
getNewName parent name = do
  result ← liftQuasar (QF.dirMetadata parent)
  pure case result of
    Right items
      | exists name items → Right (getNewName' items 1)
      | otherwise → Right name
    Left QF.NotFound → Right name
    Left err → Left err
  where

  getNewName' ∷ Array QFS.Resource → Int → String
  getNewName' items i =
    let arr = S.split (S.Pattern ".") name
    in fromMaybe "" do
      body ← Arr.head arr
      suffixes ← Arr.tail arr
      let newName = S.joinWith "." $ Arr.cons (body <> " " <> show i) suffixes
      pure if exists newName items
           then getNewName' items (i + one)
           else newName

  exists ∷ String → Array QFS.Resource → Boolean
  exists n = F.any ((_ == n) ∘ printName ∘ QR.getName)

  printName ∷ Either (Maybe P.DirName) P.FileName → String
  printName = either (fromMaybe "" ∘ map P.runDirName) P.runFileName

-- | Will return `Just` in case the resource was successfully moved, and
-- | `Nothing` in case no resource existed at the requested source path.
move
  ∷ ∀ f m
  . (Monad m, QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → AnyPath
  → m (Either QError (Maybe AnyPath))
move src tgt = do
  let
    srcPath = R.getPath src

  runExceptT ∘ traverse cleanViewMounts $ srcPath ^? _Left

  runExceptT case src of
    R.Workspace wsDir → replacePathsInWorkspace wsDir
    _ → pure unit

  result ←
    case src of
      R.Mount _ → liftQuasar $ QF.moveMount srcPath tgt
      _ → liftQuasar $ QF.moveData srcPath tgt

  pure
    case result of
      Right _ → Right (Just tgt)
      Left QF.NotFound → Right Nothing
      Left err → Left err

  where
  replacePathsInWorkspace ∷ DirPath → ExceptT QError m Unit
  replacePathsInWorkspace wsDir = do
    mbDid ← getWorkspaceRoot wsDir
    for_ mbDid \did → do
      deck ← getDeck wsDir did
      (save × newDeck) ← replacePathsInDeck wsDir deck
      when save $ putDeck wsDir did newDeck

  getWorkspaceRoot ∷ DirPath → ExceptT QError m (Maybe DID.DeckId)
  getWorkspaceRoot wsDir = do
    wmJS ← ExceptT $ QD.load $ wsDir </> P.file "index"
    deck ← ExceptT $ pure $ lmap (Error ∘ error) $ WM.decode wmJS
    pure deck.root

  getDeck ∷ DirPath → DID.DeckId → ExceptT QError m DM.Deck
  getDeck wsDir did = do
    deckJS ← ExceptT $ QD.load $ wsDir </> P.dir (DID.toString did) </> P.file "index"
    ExceptT $ pure $ lmap (Error ∘ error) $ DM.decode deckJS

  putDeck ∷ DirPath → DID.DeckId → DM.Deck → ExceptT QError m Unit
  putDeck wsDir did deck =
    ExceptT
      $ QD.save
        (wsDir </> P.dir (DID.toString did) </> P.file "index")
        (DM.encode deck)

  replacePathsInDeck ∷ DirPath → DM.Deck → ExceptT QError m (Boolean × DM.Deck)
  replacePathsInDeck wsDir deck =
    let
      replaceCardModel ∷ CM.Model → DM.Deck → DM.Deck
      replaceCardModel card@{cardId} d =
        d { cards =
               Arr.sortBy (\{cardId: a} {cardId: b} → compare a b)
               $ Arr.cons card
               $ Arr.filter (not ∘ eq cardId ∘ _.cardId) d.cards
          }

      foldFn ∷ Boolean × DM.Deck → CM.Model → ExceptT QError m (Boolean × DM.Deck)
      foldFn current@(shouldSave × d) {cardId, model} = case model of
        CM.Draftboard m → do
          flip parTraverse_ (List.catMaybes $ Pane.toList m.layout) \did → do
            d' ← getDeck wsDir  did
            (save × newDeck) ← replacePathsInDeck wsDir d'
            when save $ putDeck wsDir did newDeck
          pure current
        CM.Cache m →
          let
            newM =
              S.replace
                (S.Pattern $ P.printPath wsDir)
                (S.Replacement $ either P.printPath P.printPath tgt)
                <$> m
            newCard = {cardId, model: CM.Cache newM}
          in
            pure $ true × replaceCardModel newCard d
        CM.Open r →
          let
            newR = fromMaybe r do
              rel ←
                bisequence
                  $ bimap (flip P.relativeTo wsDir) (flip P.relativeTo wsDir)
                  $ R.getPath r
              tgtDir ← either Just (const Nothing) tgt
              let
                newP =
                  bimap P.canonicalize P.canonicalize
                  $ bimap (tgtDir </> _) (tgtDir </> _) rel
              pure $ R.setPath r newP

            newCard = {cardId, model: CM.Open newR}
          in
            pure $ (newR ≠ r) × replaceCardModel newCard d
        CM.Ace mode m →
          let
            wsStr ∷ String
            wsStr = P.printPath wsDir

            pat ∷ S.Pattern
            pat = S.Pattern wsStr

            tgtStr ∷ String
            tgtStr = either P.printPath P.printPath tgt

            replacement ∷ S.Replacement
            replacement = S.Replacement tgtStr

            srcLen ∷ Int
            srcLen = S.length wsStr

            tgtLen ∷ Int
            tgtLen = S.length tgtStr

            lenDiff ∷ Int
            lenDiff = tgtLen - srcLen

            sortRangeRecs ∷ Array RangeRec → Array RangeRec
            sortRangeRecs =
              Arr.sortBy \a b →
                compare a.startRow b.startRow
                ⊕ compare a.startColumn b.startColumn

            -- We don't care about endings
            eqRangeRec ∷ RangeRec → RangeRec → Boolean
            eqRangeRec a b =
              -- That's a bug workaround, modification of ace field for whatever reason
              -- removes one space left padding :(
              (a.startColumn ≡ b.startColumn
               ∨ a.startColumn + one ≡ b.startColumn
               ∨ a.startColumn - one ≡ b.startColumn)
              ∧ a.startRow ≡ b.startRow

            substrIndices
              ∷ S.Pattern
              → Array (Int × String)
              → Array RangeRec
            substrIndices needle =
              sortRangeRecs ∘ foldl foldRanges [ ]
              where
              findStartColumns ∷ Array Int → String → Array Int
              findStartColumns accum hay =
                case S.indexOf needle hay of
                  Nothing → accum
                  Just i → findStartColumns (Arr.cons i accum) $ S.drop (i + srcLen) hay

              foldRanges
                ∷ Array RangeRec
                → Int × String
                → Array RangeRec
              foldRanges accum (startRow × hay) =
                let
                  starts = findStartColumns [] hay
                  fromKWlen = 6
                  mkRange start =
                    [ { startColumn: start - fromKWlen
                      , endColumn: 0
                      , startRow
                      , endRow: startRow
                      } ]
                in
                 foldMap mkRange starts ⊕ accum

            initialRanges ∷ Array RangeRec
            initialRanges = substrIndices pat $ enumerate $ S.split (S.Pattern "\n") m.text

            -- inputs must be sorted
            filterRanges
              ∷ Array RangeRec
              → Array RangeRec
              → Array RangeRec
              → Array RangeRec
            filterRanges accum needles hays = fromMaybe accum do
              needles' ← Arr.uncons needles
              hays' ← Arr.uncons hays
              pure
                $ if eqRangeRec hays'.head needles'.head
                -- Note that we use stuff from hays, because it has endColumn and endRow
                  then
                    filterRanges
                      (Arr.snoc
                         accum
                         hays'.head{ endColumn = hays'.head.endColumn
                                                 + lenDiff
                                                 + hays'.head.startRow
                                                 - one
                                   , startColumn = hays'.head.startColumn
                                                   - hays'.head.startRow
                                                   - one
                                   })
                      needles'.tail
                      hays
                  else
                    filterRanges
                      (Arr.snoc accum hays'.head)
                      needles
                      hays'.tail

            newText ∷ String
            newText = S.replace pat replacement m.text

            newRanges ∷ Array RangeRec
            newRanges
              | newText ≠ m.text  =
                filterRanges [ ] initialRanges $ sortRangeRecs m.ranges
              | otherwise = m.ranges

            newCard = {cardId, model: CM.Ace mode {text: newText, ranges: newRanges}}
          in
            pure $ (newText ≠ m.text) × replaceCardModel newCard d

        _ → pure current
    in
      Arr.foldM foldFn (false × deck) deck.cards

delete
  ∷ ∀ f m
  . (Monad m, QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → m (Either QError (Maybe R.Resource))
delete resource =
  runExceptT $
    if R.isMount resource || alreadyInTrash resource
    then
      forceDelete resource $> Nothing
    else
      moveToTrash resource `catchError` \(err ∷ QError) →
        forceDelete resource $> Nothing

  where
  msg ∷ String
  msg = "cannot delete"

  moveToTrash
    ∷ R.Resource
    → ExceptT QError m (Maybe R.Resource)
  moveToTrash res = do
    let
      d = (res ^. R._root) </> P.dir Config.trashFolder
      path = (res # R._root .~ d) ^. R._path
    name ← ExceptT $ getNewName d (res ^. R._name)
    ExceptT $ move res (path # R._nameAnyPath .~ name)
    pure ∘ Just $ R.Directory d

  alreadyInTrash ∷ R.Resource → Boolean
  alreadyInTrash res =
    case res ^. R._path of
      Left path → alreadyInTrash' path
      Right _ → alreadyInTrash' (res ^. R._root)

  alreadyInTrash' ∷ DirPath → Boolean
  alreadyInTrash' d =
    if d == P.rootDir
    then false
    else maybe false go $ P.peel d

    where
    go ∷ Tuple DirPath (Either P.DirName P.FileName) → Boolean
    go (Tuple d' name) =
      case name of
        Right _ → false
        Left n →
          if n == P.DirName Config.trashFolder
          then true
          else alreadyInTrash' d'

forceDelete
  ∷ ∀ f m
  . (QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → ExceptT QError m Unit
forceDelete res =
  case res of
    R.Mount _ →
      ExceptT ∘ liftQuasar $ QF.deleteMount (R.getPath res)
    _ → do
      let path = R.getPath res
      traverse cleanViewMounts $ path ^? _Left
      ExceptT ∘ liftQuasar $ QF.deleteData path

cleanViewMounts
  ∷ ∀ f m
  . (Parallel f m, QuasarDSL m)
  ⇒ DirPath
  → ExceptT QError m Unit
cleanViewMounts =
  parTraverse_ deleteViewMount <=< ExceptT ∘ transitiveChildren
  where
  deleteViewMount ∷ R.Resource → ExceptT QError m Unit
  deleteViewMount =
    case _ of
      R.Mount (R.View vp) →
        ExceptT ∘ liftQuasar $ QF.deleteMount (Right vp)
      _ → pure unit

messageIfFileNotFound
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ FilePath
  → String
  → m (Either QError (Maybe String))
messageIfFileNotFound path defaultMsg =
  handleResult <$> liftQuasar (QF.fileMetadata path)
  where
  handleResult ∷ ∀ a. Either QF.QError a → Either QError (Maybe String)
  handleResult (Left QF.NotFound) = Right (Just defaultMsg)
  handleResult (Left err) = Left err
  handleResult (Right _) = Right Nothing

dirNotAccessible
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ DirPath
  → m (Maybe QF.QError)
dirNotAccessible path =
  either Just (const Nothing) <$> liftQuasar (QF.dirMetadata path)

fileNotAccessible
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ FilePath
  → m (Maybe QF.QError)
fileNotAccessible path =
  either Just (const Nothing) <$> liftQuasar (QF.fileMetadata path)

{-
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.Quasar.FS
  ( children
  , transitiveChildren
  , getNewName
  , move
  , listing
  , delete
  , messageIfFileNotFound
  , dirNotAccessible
  , fileNotAccessible
  , module Quasar.Error
  ) where

import SlamData.Prelude

import Control.Monad.Eff.Exception (error)

import Data.Array as Arr
import Data.Foldable as F
import Data.Lens ((.~), (^.), (^?), _Left)
import Data.List as List
import Data.Path.Pathy ((</>))
import Data.Path.Pathy as P
import Data.String as S

import Quasar.Advanced.QuasarAF as QF
import Quasar.Error (QError(..))
import Quasar.FS as QFS
import Quasar.FS.Mount as QFSM
import Quasar.FS.Resource as QR
import Quasar.Types (AnyPath, DirPath, FilePath)

import SlamData.Config as Config
import SlamData.FileSystem.Resource as R
import SlamData.Quasar.Class (class QuasarDSL, liftQuasar)
import SlamData.Quasar.Data as QD

import SlamData.Workspace.Model as WM
import SlamData.Workspace.Deck.Model as DM
import SlamData.Workspace.Card.Model as CM
import SlamData.Workspace.Deck.DeckId as DID
import SlamData.Workspace.Card.Draftboard.Pane as Pane

import Utils.Array (enumerate)
import Utils.Ace (RangeRec)

children
  ∷ ∀ m
  . (Monad m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
children dir = runExceptT do
  cs ← ExceptT $ listing dir
  let result = (R._root .~ dir) <$> cs
  -- TODO: do this somewhere more appropriate
  -- lift $ fromAff $ memoizeCompletionStrs dir result
  pure result

transitiveChildren
  ∷ ∀ f m
  . (Parallel f m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
transitiveChildren start = runExceptT do
  rs ← ExceptT $ children start
  cs ← parTraverse go rs
  pure $ rs <> join cs
  where
  go :: R.Resource → ExceptT QError m (Array R.Resource)
  go r = case R.getPath r of
    Left dir → do
      crs ← ExceptT $ transitiveChildren dir
      pure $ [r] <> crs
    Right _ → pure [r]

listing
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ DirPath
  → m (Either QError (Array R.Resource))
listing p =
  map (map toResource) <$> liftQuasar (QF.dirMetadata p)
  where
  toResource ∷ QFS.Resource → R.Resource
  toResource res = case res of
    QFS.File path → R.File path
    QFS.Directory path →
      let workspaceName
            = S.stripSuffix (S.Pattern $ "." <> Config.workspaceExtension)
            ∘ P.runDirName =<< P.dirName path
      in case workspaceName of
        Just name → R.Workspace (p </> P.dir name)
        Nothing → R.Directory path
    QFS.Mount m → R.Mount $ either R.Database R.View $ QFSM.getPath m

-- | Generates a new resource name based on a directory path and a name for the
-- | resource. If the name already exists in the path a number is appended to
-- | the end of the name.
getNewName
  ∷ ∀ m
  . (Monad m, QuasarDSL m)
  ⇒ DirPath
  → String
  → m (Either QError String)
getNewName parent name = do
  result ← liftQuasar (QF.dirMetadata parent)
  pure case result of
    Right items
      | exists name items → Right (getNewName' items 1)
      | otherwise → Right name
    Left QF.NotFound → Right name
    Left err → Left err
  where

  getNewName' ∷ Array QFS.Resource → Int → String
  getNewName' items i =
    let arr = S.split (S.Pattern ".") name
    in fromMaybe "" do
      body ← Arr.head arr
      suffixes ← Arr.tail arr
      let newName = S.joinWith "." $ Arr.cons (body <> " " <> show i) suffixes
      pure if exists newName items
           then getNewName' items (i + one)
           else newName

  exists ∷ String → Array QFS.Resource → Boolean
  exists n = F.any ((_ == n) ∘ printName ∘ QR.getName)

  printName ∷ Either (Maybe P.DirName) P.FileName → String
  printName = either (fromMaybe "" ∘ map P.runDirName) P.runFileName

-- | Will return `Just` in case the resource was successfully moved, and
-- | `Nothing` in case no resource existed at the requested source path.
move
  ∷ ∀ f m
  . (Monad m, QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → AnyPath
  → m (Either QError (Maybe AnyPath))
move src tgt = do
  let
    srcPath = R.getPath src

  runExceptT ∘ traverse cleanViewMounts $ srcPath ^? _Left

  runExceptT case src of
    R.Workspace wsDir → replacePathsInWorkspace wsDir
    _ → pure unit

  result ←
    case src of
      R.Mount _ → liftQuasar $ QF.moveMount srcPath tgt
      _ → liftQuasar $ QF.moveData srcPath tgt

  pure
    case result of
      Right _ → Right (Just tgt)
      Left QF.NotFound → Right Nothing
      Left err → Left err

  where
  replacePathsInWorkspace ∷ DirPath → ExceptT QError m Unit
  replacePathsInWorkspace wsDir = do
    mbDid ← getWorkspaceRoot wsDir
    for_ mbDid \did → do
      deck ← getDeck wsDir did
      (save × newDeck) ← replacePathsInDeck wsDir deck
      when save $ putDeck wsDir did newDeck

  getWorkspaceRoot ∷ DirPath → ExceptT QError m (Maybe DID.DeckId)
  getWorkspaceRoot wsDir = do
    wmJS ← ExceptT $ QD.load $ wsDir </> P.file "index"
    deck ← ExceptT $ pure $ lmap (Error ∘ error) $ WM.decode wmJS
    pure deck.root

  getDeck ∷ DirPath → DID.DeckId → ExceptT QError m DM.Deck
  getDeck wsDir did = do
    deckJS ← ExceptT $ QD.load $ wsDir </> P.dir (DID.toString did) </> P.file "index"
    ExceptT $ pure $ lmap (Error ∘ error) $ DM.decode deckJS

  putDeck ∷ DirPath → DID.DeckId → DM.Deck → ExceptT QError m Unit
  putDeck wsDir did deck =
    ExceptT
      $ QD.save
        (wsDir </> P.dir (DID.toString did) </> P.file "index")
        (DM.encode deck)

  replacePathsInDeck ∷ DirPath → DM.Deck → ExceptT QError m (Boolean × DM.Deck)
  replacePathsInDeck wsDir deck =
    let
      replaceCardModel ∷ CM.Model → DM.Deck → DM.Deck
      replaceCardModel card@{cardId} d =
        d { cards =
               Arr.sortBy (\{cardId: a} {cardId: b} → compare a b)
               $ Arr.cons card
               $ Arr.filter (not ∘ eq cardId ∘ _.cardId) d.cards
          }

      foldFn ∷ Boolean × DM.Deck → CM.Model → ExceptT QError m (Boolean × DM.Deck)
      foldFn current@(shouldSave × d) {cardId, model} = case model of
        CM.Draftboard m → do
          flip parTraverse_ (List.catMaybes $ Pane.toList m.layout) \did → do
            d' ← getDeck wsDir  did
            (save × newDeck) ← replacePathsInDeck wsDir d'
            when save $ putDeck wsDir did newDeck
          pure current
        CM.Cache m →
          let
            newM =
              S.replace
                (S.Pattern $ P.printPath wsDir)
                (S.Replacement $ either P.printPath P.printPath tgt)
                <$> m
            newCard = {cardId, model: CM.Cache newM}
          in
            pure $ true × replaceCardModel newCard d
        CM.Open r →
          let
            newR = fromMaybe R.root do
              rel ←
                bisequence
                  $ bimap (flip P.relativeTo wsDir) (flip P.relativeTo wsDir)
                  $ R.getPath r
              tgtDir ← either Just (const Nothing) tgt
              let
                newP =
                  bimap P.canonicalize P.canonicalize
                  $ bimap (tgtDir </> _) (tgtDir </> _) rel
              pure $ R.setPath r newP

            newCard = {cardId, model: CM.Open newR}
          in
            pure $ (newR ≠ r) × replaceCardModel newCard d
        CM.Ace mode m →
          let
            wsStr ∷ String
            wsStr = P.printPath wsDir

            pat ∷ S.Pattern
            pat = S.Pattern wsStr

            tgtStr ∷ String
            tgtStr = either P.printPath P.printPath tgt

            replacement ∷ S.Replacement
            replacement = S.Replacement tgtStr

            srcLen ∷ Int
            srcLen = S.length wsStr

            tgtLen ∷ Int
            tgtLen = S.length tgtStr

            lenDiff ∷ Int
            lenDiff = tgtLen - srcLen

            sortRangeRecs ∷ Array RangeRec → Array RangeRec
            sortRangeRecs =
              Arr.sortBy \a b →
                compare a.startRow b.startRow
                ⊕ compare a.startColumn b.startColumn

            -- We don't care about endings
            eqRangeRec ∷ RangeRec → RangeRec → Boolean
            eqRangeRec a b =
              -- That's a bug workaround, modification of ace field for whatever reason
              -- removes one space left padding :(
              (a.startColumn ≡ b.startColumn
               ∨ a.startColumn + one ≡ b.startColumn
               ∨ a.startColumn - one ≡ b.startColumn)
              ∧ a.startRow ≡ b.startRow

            substrIndices
              ∷ S.Pattern
              → Array (Int × String)
              → Array RangeRec
            substrIndices needle =
              sortRangeRecs ∘ foldl foldRanges [ ]
              where
              findStartColumns ∷ Array Int → String → Array Int
              findStartColumns accum hay =
                case S.indexOf needle hay of
                  Nothing → accum
                  Just i → findStartColumns (Arr.cons i accum) $ S.drop (i + srcLen) hay

              foldRanges
                ∷ Array RangeRec
                → Int × String
                → Array RangeRec
              foldRanges accum (startRow × hay) =
                let
                  starts = findStartColumns [] hay
                  fromKWlen = 6
                  mkRange start =
                    [ { startColumn: start - fromKWlen
                      , endColumn: 0
                      , startRow
                      , endRow: startRow
                      } ]
                in
                 foldMap mkRange starts ⊕ accum

            initialRanges ∷ Array RangeRec
            initialRanges = substrIndices pat $ enumerate $ S.split (S.Pattern "\n") m.text

            -- inputs must be sorted
            filterRanges
              ∷ Array RangeRec
              → Array RangeRec
              → Array RangeRec
              → Array RangeRec
            filterRanges accum needles hays = fromMaybe accum do
              needles' ← Arr.uncons needles
              hays' ← Arr.uncons hays
              pure
                $ if eqRangeRec hays'.head needles'.head
                -- Note that we use stuff from hays, because it has endColumn and endRow
                  then
                    filterRanges
                      (Arr.snoc
                         accum
                         hays'.head{ endColumn = hays'.head.endColumn
                                                 + lenDiff
                                                 + hays'.head.startRow
                                                 - one
                                   , startColumn = hays'.head.startColumn
                                                   - hays'.head.startRow
                                                   - one
                                   })
                      needles'.tail
                      hays
                  else
                    filterRanges
                      (Arr.snoc accum hays'.head)
                      needles
                      hays'.tail

            newText ∷ String
            newText = S.replace pat replacement m.text

            newRanges ∷ Array RangeRec
            newRanges
              | newText ≠ m.text  =
                filterRanges [ ] initialRanges $ sortRangeRecs m.ranges
              | otherwise = m.ranges

            newCard = {cardId, model: CM.Ace mode {text: newText, ranges: newRanges}}
          in
            pure $ (newText ≠ m.text) × replaceCardModel newCard d

        _ → pure current
    in
      Arr.foldM foldFn (false × deck) deck.cards

delete
  ∷ ∀ f m
  . (Monad m, QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → m (Either QError (Maybe R.Resource))
delete resource =
  runExceptT $
    if R.isMount resource || alreadyInTrash resource
    then
      forceDelete resource $> Nothing
    else
      moveToTrash resource `catchError` \(err ∷ QError) →
        forceDelete resource $> Nothing

  where
  msg ∷ String
  msg = "cannot delete"

  moveToTrash
    ∷ R.Resource
    → ExceptT QError m (Maybe R.Resource)
  moveToTrash res = do
    let
      d = (res ^. R._root) </> P.dir Config.trashFolder
      path = (res # R._root .~ d) ^. R._path
    name ← ExceptT $ getNewName d (res ^. R._name)
    ExceptT $ move res (path # R._nameAnyPath .~ name)
    pure ∘ Just $ R.Directory d

  alreadyInTrash ∷ R.Resource → Boolean
  alreadyInTrash res =
    case res ^. R._path of
      Left path → alreadyInTrash' path
      Right _ → alreadyInTrash' (res ^. R._root)

  alreadyInTrash' ∷ DirPath → Boolean
  alreadyInTrash' d =
    if d == P.rootDir
    then false
    else maybe false go $ P.peel d

    where
    go ∷ Tuple DirPath (Either P.DirName P.FileName) → Boolean
    go (Tuple d' name) =
      case name of
        Right _ → false
        Left n →
          if n == P.DirName Config.trashFolder
          then true
          else alreadyInTrash' d'

forceDelete
  ∷ ∀ f m
  . (QuasarDSL m, Parallel f m)
  ⇒ R.Resource
  → ExceptT QError m Unit
forceDelete res =
  case res of
    R.Mount _ →
      ExceptT ∘ liftQuasar $ QF.deleteMount (R.getPath res)
    _ → do
      let path = R.getPath res
      traverse cleanViewMounts $ path ^? _Left
      ExceptT ∘ liftQuasar $ QF.deleteData path

cleanViewMounts
  ∷ ∀ f m
  . (Parallel f m, QuasarDSL m)
  ⇒ DirPath
  → ExceptT QError m Unit
cleanViewMounts =
  parTraverse_ deleteViewMount <=< ExceptT ∘ transitiveChildren
  where
  deleteViewMount ∷ R.Resource → ExceptT QError m Unit
  deleteViewMount =
    case _ of
      R.Mount (R.View vp) →
        ExceptT ∘ liftQuasar $ QF.deleteMount (Right vp)
      _ → pure unit

messageIfFileNotFound
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ FilePath
  → String
  → m (Either QError (Maybe String))
messageIfFileNotFound path defaultMsg =
  handleResult <$> liftQuasar (QF.fileMetadata path)
  where
  handleResult ∷ ∀ a. Either QF.QError a → Either QError (Maybe String)
  handleResult (Left QF.NotFound) = Right (Just defaultMsg)
  handleResult (Left err) = Left err
  handleResult (Right _) = Right Nothing

dirNotAccessible
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ DirPath
  → m (Maybe QF.QError)
dirNotAccessible path =
  either Just (const Nothing) <$> liftQuasar (QF.dirMetadata path)

fileNotAccessible
  ∷ ∀ m
  . (Functor m, QuasarDSL m)
  ⇒ FilePath
  → m (Maybe QF.QError)
fileNotAccessible path =
  either Just (const Nothing) <$> liftQuasar (QF.fileMetadata path)


[PR Feedback] Use `fromMaybe` instead of `maybe _ id`

module DOM.BrowserFeatures.Detectors
  ( detectBrowserFeatures
  ) where

import Prelude
import Control.Monad.Eff
import Control.Monad.Eff.Exception

import qualified Data.Array as Arr
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Foldable (foldr)
import Data.Traversable (traverse)
import Data.Tuple

import DOM
import Data.BrowserFeatures
import qualified Data.BrowserFeatures.InputType as IT

foreign import _detectInputTypeSupport :: forall e. String -> Eff (dom :: DOM | e) Boolean

detectInputTypeSupport :: forall e. IT.InputType -> Eff (dom :: DOM | e) Boolean
detectInputTypeSupport = _detectInputTypeSupport <<< IT.renderInputType

detectInputTypeSupportMap :: forall e. Eff (dom :: DOM | e) (M.Map IT.InputType Boolean)
detectInputTypeSupportMap = M.fromList <$> traverse (\t -> Tuple t <$> detectInputTypeSupport t) inputTypes
  where
    inputTypes :: L.List IT.InputType
    inputTypes = foldr L.Cons L.Nil IT.allInputTypes

-- | Detect browser features by testing them using the DOM.
detectBrowserFeatures :: forall e. Eff (dom :: DOM | e) BrowserFeatures
detectBrowserFeatures = do
  inputTypeSupportMap <- detectInputTypeSupportMap
  pure { inputTypeSupported : fromMaybe false <<< flip M.lookup inputTypeSupportMap
       }

module DOM.BrowserFeatures.Detectors
  ( detectBrowserFeatures
  ) where

import Prelude
import Control.Monad.Eff
import Control.Monad.Eff.Exception

import qualified Data.Array as Arr
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (maybe)
import Data.Foldable (foldr)
import Data.Traversable (traverse)
import Data.Tuple

import DOM
import Data.BrowserFeatures
import qualified Data.BrowserFeatures.InputType as IT

foreign import _detectInputTypeSupport :: forall e. String -> Eff (dom :: DOM | e) Boolean

detectInputTypeSupport :: forall e. IT.InputType -> Eff (dom :: DOM | e) Boolean
detectInputTypeSupport = _detectInputTypeSupport <<< IT.renderInputType

detectInputTypeSupportMap :: forall e. Eff (dom :: DOM | e) (M.Map IT.InputType Boolean)
detectInputTypeSupportMap = M.fromList <$> traverse (\t -> Tuple t <$> detectInputTypeSupport t) inputTypes
  where
    inputTypes :: L.List IT.InputType
    inputTypes = foldr L.Cons L.Nil IT.allInputTypes

-- | Detect browser features by testing them using the DOM.
detectBrowserFeatures :: forall e. Eff (dom :: DOM | e) BrowserFeatures
detectBrowserFeatures = do
  inputTypeSupportMap <- detectInputTypeSupportMap
  pure { inputTypeSupported : maybe false id <<< flip M.lookup inputTypeSupportMap
       }


Fix pattern match

Fix pattern match

-- | Resolve ambiguities by combining the parsed usage section with any parsed
-- | Option sections, as well as some best effort guessing.
-- |
-- | ===
-- |
-- | Thoughts:
-- |    * It appears there is never a reason to fail hard. It would be nice if
-- |      we could produce warnings, however -> Write monad?

module Language.Docopt.Solver where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..), isJust, maybe, maybe', isNothing)
import Data.List (List(..), filter, head, foldM, concat, (:), singleton
                , catMaybes, toList, last, init, length)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Foldable (foldl)
import Control.MonadPlus (guard)
import Control.Plus (empty)
import Control.Alt ((<|>))
import Data.Monoid (mempty)
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.String as Str
import Data.StrMap as StrMap
import Data.StrMap (StrMap())

import Data.String.Ext ((^=))
import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Usage
import Language.Docopt.Parser.Desc (Desc(..))
import Language.Docopt.Value (Value(..))
import Language.Docopt.Option                as O
import Language.Docopt.Parser.Desc           as DE
import Language.Docopt.Parser.Usage          as U
import Language.Docopt.Parser.Usage.Argument as U
import Language.Docopt.Parser.Usage.Option   as UO

data Result = Consumed (List Argument) | Unconsumed (List Argument)

runResult :: Result -> List Argument
runResult (Consumed   xs) = xs
runResult (Unconsumed xs) = xs

solveBranch :: U.Branch                 -- ^ the usage branch
            -> List Desc                -- ^ the option descriptions
            -> Either SolveError Branch -- ^ the canonical usage branch
solveBranch as ds = Branch <$> go as
  where
    go :: U.Branch -> Either SolveError (List Argument)
    go Nil = return Nil
    go (Cons x Nil) = do runResult <$> do solveArgs x Nothing
    go (Cons x (Cons y xs)) = do
      m <- solveArgs x (Just y)
      case m of
        Unconsumed zs -> (zs ++) <$> go (y:xs)
        Consumed   zs -> (zs ++) <$> go xs

    -- | Solve two adjacent arguments.
    -- | Should the first argument be an option with an argument that
    -- | matches an adjacent command or positional, consume the adjacent
    -- | argument from the input (consume).
    solveArgs :: U.Argument
              -> Maybe U.Argument
              -> Either SolveError Result

    solveArgs (U.EOA) _ = Unconsumed <<< singleton <$> return (EOA)
    solveArgs (U.Stdin) _ = Unconsumed <<< singleton <$> return (Stdin)
    solveArgs (U.Command s) _ = Unconsumed <<< singleton <$> return (Command s)
    solveArgs (U.Positional s r) _ = Unconsumed <<< singleton <$> return (Positional s r)

    solveArgs (U.Group o bs r) _
      = Unconsumed <<< singleton <$> do
        flip (Group o) r <$> do
          flip solveBranch ds `traverse` bs

    -- | Resolve the refernce by expanding into real
    -- | options, as derived from the descriptions.
    -- |
    -- | XXX: Currently `r` is unused as all descriptions are in a flat list.
    -- |      once option descriptions are keyed, `r` can be used as the lookup
    -- |      into the map of `key => [Description]`
    solveArgs (U.Reference r) _ = do
      return $ Unconsumed (catMaybes $ convert <$> ds)

      where
        convert (DE.OptionDesc (DE.Option y)) =
          return $ Option
                 $ O.Option { flag:       DE.getFlag y.name
                            , name:       DE.getName y.name
                            , arg:        convertArg y.arg
                            , env:        y.env
                            , repeatable: false -- XXX: desc options must be
                                                --      able to indicate this!
                            }
          where
            convertArg (Just (DE.Argument arg))
              = return $ O.Argument arg
            -- For options that have been expanded through a reference, make
            -- options that are flags optional, by setting their default value
            -- to "false".
            convertArg _
              = return $ O.Argument {
                  name: ""
                , default: pure (BoolValue false)
                }

        convert _ = Nothing

    solveArgs (U.Option (UO.LOpt o)) y = do

      -- XXX: Is `head` the right thing to do here? What if there are more
      -- matches? That would indicate ambigiutiy and needs to be treated,
      -- possibly with an error?
      let x = O.runOption $ flip maybe' id
                (\_ -> O.Option $ O.empty { name       = pure o.name
                                          , arg        = toArg o.arg
                                          , repeatable = o.repeatable
                                          })
                (head $ catMaybes $ coerce <$> ds)

      -- Validate the argument matches
      if (argMatches o.arg x.arg)
        then return unit
        else throwError $ DescriptionError $ ArgumentMismatchError {
                option: O.Option x
              , description: {
                  arg: x.arg <#> O.runArgument >>> _.name
                }
              }

      -- Look ahead if any of the following arguments should be consumed.
      -- Return either `Nothing` to signify that nothing should be consumed
      -- or a value signifieng that it should be consumed, and the
      -- `isRepeated` should be inherited.
      let mr = do
            guard (not o.repeatable)
            arg' <- O.runArgument <$> x.arg
            case y of
              Just (U.Positional n r) | n == arg'.name -> return r
              Just (U.Command n)      | n == arg'.name -> return false
              _                                        -> Nothing

      return $ (maybe Unconsumed (const Consumed) mr)
             $ singleton
             $ Option
             $ O.Option (x { repeatable = maybe (x.repeatable) id mr })

      where
        coerce :: Desc -> Maybe O.Option
        coerce (DE.OptionDesc (DE.Option x))
          = coerce' x
            where
              coerce' { name = DE.Long n' }
                | n' ^= o.name
                = return $ O.Option { name:       pure o.name
                                    , flag:       Nothing
                                    , arg:        resolveOptArg o.arg x.arg
                                    , env:        x.env
                                    , repeatable: o.repeatable
                                    }
              coerce' { name = DE.Full f' n' }
                | n' ^= o.name
                = return $ O.Option { name:       pure o.name
                                    , flag:       pure f'
                                    , arg:        resolveOptArg o.arg x.arg
                                    , env:        x.env
                                    , repeatable: o.repeatable
                                    }
              coerce' _ = Nothing
        coerce _ = Nothing

    solveArgs (U.OptionStack (UO.SOpt o)) y = do

      -- Figure out trailing flag, in order to couple it with an adjacent
      -- option where needed.
      (Tuple xs x) <- do
          let fs = toList o.stack
              t  = case last fs of
                    Just f  -> Tuple (o.flag:(fromJust $ init fs)) f
                    Nothing -> Tuple Nil o.flag
          Tuple
            <$> (match false `traverse` (fst t))
            <*> (O.runOption <$> do match true (snd t))

      -- Validate the argument matches
      if (argMatches o.arg x.arg)
        then return unit
        else throwError $ DescriptionError $ ArgumentMismatchError {
                option: O.Option x
              , description: {
                  arg: x.arg <#> O.runArgument >>> _.name
                }
              }

      -- Look ahead if any of the following arguments should be consumed.
      -- Return either `Nothing` to signify that nothing should be consumed
      -- or a value signifieng that it should be consumed, and the
      -- `isRepeated` should be inherited.
      let mr = do
            guard (not x.repeatable)
            arg' <- O.runArgument <$> x.arg
            case y of
                Just (U.Positional n r) | n == arg'.name -> return r
                Just (U.Command n)      | n == arg'.name -> return false
                _                                        -> Nothing

      return $ (maybe Unconsumed (const Consumed) mr)
             $ (Option <$> xs)
                ++ (singleton $ Option $ O.Option $ x {
                      repeatable = maybe (x.repeatable) id mr
                    })

      where
        match :: Boolean -> Char -> Either SolveError O.Option
        match isTrailing f = return $
          flip maybe' id
                (\_ -> O.Option $ O.empty { flag = pure f
                                          , arg = toArg o.arg
                                          , repeatable = o.repeatable
                                          })
                (head $ catMaybes $ coerce f isTrailing <$> ds)

        coerce :: Char -> Boolean -> Desc -> Maybe O.Option
        coerce f isTrailing (DE.OptionDesc (DE.Option y))
          = coerce' y
            where
              coerce' { name = DE.Flag f' }
                | (f == f') && (isTrailing || isNothing y.arg)
                = return $ O.Option { flag:       pure f
                                    , name:       Nothing
                                    , arg:        resolveOptArg o.arg y.arg
                                    , env:        y.env
                                    , repeatable: o.repeatable
                                    }
              coerce' { name = DE.Full f' n' }
                | (f == f') && (isTrailing || isNothing y.arg)
                = return $ O.Option { flag:       pure f'
                                    , name:       pure n'
                                    , arg:        resolveOptArg o.arg y.arg
                                    , env:        y.env
                                    , repeatable: o.repeatable
                                  }
              coerce' _ = Nothing
        coerce _ _ _ = Nothing

    -- | Resolve an option's argument name against that given in the
    -- | description, returning the most complete argument known.
    resolveOptArg :: Maybe String
                  -> Maybe DE.Argument
                  -> Maybe O.Argument

    resolveOptArg (Just n) Nothing = do
      return $ O.Argument { name: n
                          , default: Nothing }
    resolveOptArg Nothing (Just (DE.Argument a))
      = return $ O.Argument { name: a.name
                            , default: a.default
                            }
    -- XXX: Do we need to guard that `an == a.name` here?
    resolveOptArg (Just an) (Just (DE.Argument a))
      = return $ O.Argument { name: a.name
                            , default: a.default
                            }
    resolveOptArg _ _ = Nothing

    toArg:: Maybe String -> Maybe O.Argument
    toArg a = do
      an <- a
      return $ O.Argument { name: an
                          , default: Nothing }

    argMatches :: Maybe String
               -> Maybe O.Argument
               -> Boolean
    argMatches a a'
      =  (isNothing a)
      || (isNothing a && isNothing a')
      || (maybe false id do
          an <- a
          (O.Argument { name: an' }) <- a'
          return (an ^= an')
        )

solveUsage :: U.Usage -> List Desc -> Either SolveError Usage
solveUsage (U.Usage _ bs) ds = Usage <$> do traverse (flip solveBranch ds) bs

solve :: (List U.Usage)
      -> (List Desc)
      -> Either SolveError (List Usage)
solve us ds = traverse (flip solveUsage ds) us

-- | Resolve ambiguities by combining the parsed usage section with any parsed
-- | Option sections, as well as some best effort guessing.
-- |
-- | ===
-- |
-- | Thoughts:
-- |    * It appears there is never a reason to fail hard. It would be nice if
-- |      we could produce warnings, however -> Write monad?

module Language.Docopt.Solver where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..), isJust, maybe, maybe', isNothing)
import Data.List (List(..), filter, head, foldM, concat, (:), singleton
                , catMaybes, toList, last, init, length)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Foldable (foldl)
import Control.MonadPlus (guard)
import Control.Plus (empty)
import Control.Alt ((<|>))
import Data.Monoid (mempty)
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.String as Str
import Data.StrMap as StrMap
import Data.StrMap (StrMap())

import Data.String.Ext ((^=))
import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Usage
import Language.Docopt.Parser.Desc (Desc(..))
import Language.Docopt.Value (Value(..))
import Language.Docopt.Option                as O
import Language.Docopt.Parser.Desc           as DE
import Language.Docopt.Parser.Usage          as U
import Language.Docopt.Parser.Usage.Argument as U
import Language.Docopt.Parser.Usage.Option   as UO

data Result = Consumed (List Argument) | Unconsumed (List Argument)

runResult :: Result -> List Argument
runResult (Consumed   xs) = xs
runResult (Unconsumed xs) = xs

solveBranch :: U.Branch                 -- ^ the usage branch
            -> List Desc                -- ^ the option descriptions
            -> Either SolveError Branch -- ^ the canonical usage branch
solveBranch as ds = Branch <$> go as
  where
    go :: U.Branch -> Either SolveError (List Argument)
    go Nil = return Nil
    go (Cons x Nil) = do runResult <$> do solveArgs x Nothing
    go (Cons x (Cons y xs)) = do
      m <- solveArgs x (Just y)
      case m of
        Unconsumed zs -> (zs ++) <$> go (y:xs)
        Consumed   zs -> (zs ++) <$> go xs

    -- | Solve two adjacent arguments.
    -- | Should the first argument be an option with an argument that
    -- | matches an adjacent command or positional, consume the adjacent
    -- | argument from the input (consume).
    solveArgs :: U.Argument
              -> Maybe U.Argument
              -> Either SolveError Result

    solveArgs (U.EOA) _ = Unconsumed <<< singleton <$> return (EOA)
    solveArgs (U.Stdin) _ = Unconsumed <<< singleton <$> return (Stdin)
    solveArgs (U.Command s) _ = Unconsumed <<< singleton <$> return (Command s)
    solveArgs (U.Positional s r) _ = Unconsumed <<< singleton <$> return (Positional s r)

    solveArgs (U.Group o bs r) _
      = Unconsumed <<< singleton <$> do
        flip (Group o) r <$> do
          flip solveBranch ds `traverse` bs

    -- | Resolve the refernce by expanding into real
    -- | options, as derived from the descriptions.
    -- |
    -- | XXX: Currently `r` is unused as all descriptions are in a flat list.
    -- |      once option descriptions are keyed, `r` can be used as the lookup
    -- |      into the map of `key => [Description]`
    solveArgs (U.Reference r) _ = do
      return $ Unconsumed (catMaybes $ convert <$> ds)

      where
        convert (DE.OptionDesc (DE.Option y)) =
          return $ Option
                 $ O.Option { flag:       DE.getFlag y.name
                            , name:       DE.getName y.name
                            , arg:        convertArg y.arg
                            , env:        y.env
                            , repeatable: false -- XXX: desc options must be
                                                --      able to indicate this!
                            }
          where
            convertArg (Just (DE.Argument arg))
              = return $ O.Argument arg
            -- For options that have been expanded through a reference, make
            -- options that are flags optional, by setting their default value
            -- to "false".
            convertArg _
              = return $ O.Argument {
                  name: ""
                , default: pure (BoolValue false)
                }

        convert _ = Nothing

    solveArgs (U.Option (UO.LOpt o)) y = do

      -- XXX: Is `head` the right thing to do here? What if there are more
      -- matches? That would indicate ambigiutiy and needs to be treated,
      -- possibly with an error?
      let x = O.runOption $ flip maybe' id
                (\_ -> O.Option $ O.empty { name       = pure o.name
                                          , arg        = toArg o.arg
                                          , repeatable = o.repeatable
                                          })
                (head $ catMaybes $ coerce <$> ds)

      -- Validate the argument matches
      if (argMatches o.arg x.arg)
        then return unit
        else throwError $ DescriptionError $ ArgumentMismatchError {
                option: O.Option x
              , description: {
                  arg: x.arg <#> O.runArgument >>> _.name
                }
              }

      -- Look ahead if any of the following arguments should be consumed.
      -- Return either `Nothing` to signify that nothing should be consumed
      -- or a value signifieng that it should be consumed, and the
      -- `isRepeated` should be inherited.
      let mr = do
            guard (not o.repeatable)
            arg' <- O.runArgument <$> x.arg
            case y of
              Just (U.Positional n r) | n == arg'.name -> return r
              Just (U.Command n)      | n == arg'.name -> return false
              _                                        -> Nothing

      return $ (maybe Unconsumed (const Consumed) mr)
             $ singleton
             $ Option
             $ O.Option (x { repeatable = maybe (x.repeatable) id mr })

      where
        coerce :: Desc -> Maybe O.Option
        coerce (DE.OptionDesc (DE.Option x))
          = coerce' x
            where
              coerce' { name = DE.Long n' }
                | n' ^= o.name
                = return $ O.Option { name:       pure o.name
                                    , flag:       Nothing
                                    , arg:        resolveOptArg o.arg x.arg
                                    , env:        x.env
                                    , repeatable: o.repeatable
                                    }
              coerce' { name = DE.Full f' n' }
                | n' ^= o.name
                = return $ O.Option { name:       pure o.name
                                    , flag:       pure f'
                                    , arg:        resolveOptArg o.arg x.arg
                                    , env:        x.env
                                    , repeatable: o.repeatable
                                    }
        coerce _ = Nothing

    solveArgs (U.OptionStack (UO.SOpt o)) y = do

      -- Figure out trailing flag, in order to couple it with an adjacent
      -- option where needed.
      (Tuple xs x) <- do
          let fs = toList o.stack
              t  = case last fs of
                    Just f  -> Tuple (o.flag:(fromJust $ init fs)) f
                    Nothing -> Tuple Nil o.flag
          Tuple
            <$> (match false `traverse` (fst t))
            <*> (O.runOption <$> do match true (snd t))

      -- Validate the argument matches
      if (argMatches o.arg x.arg)
        then return unit
        else throwError $ DescriptionError $ ArgumentMismatchError {
                option: O.Option x
              , description: {
                  arg: x.arg <#> O.runArgument >>> _.name
                }
              }

      -- Look ahead if any of the following arguments should be consumed.
      -- Return either `Nothing` to signify that nothing should be consumed
      -- or a value signifieng that it should be consumed, and the
      -- `isRepeated` should be inherited.
      let mr = do
            guard (not x.repeatable)
            arg' <- O.runArgument <$> x.arg
            case y of
                Just (U.Positional n r) | n == arg'.name -> return r
                Just (U.Command n)      | n == arg'.name -> return false
                _                                        -> Nothing

      return $ (maybe Unconsumed (const Consumed) mr)
             $ (Option <$> xs)
                ++ (singleton $ Option $ O.Option $ x {
                      repeatable = maybe (x.repeatable) id mr
                    })

      where
        match :: Boolean -> Char -> Either SolveError O.Option
        match isTrailing f = return $
          flip maybe' id
                (\_ -> O.Option $ O.empty { flag = pure f
                                          , arg = toArg o.arg
                                          , repeatable = o.repeatable
                                          })
                (head $ catMaybes $ coerce f isTrailing <$> ds)

        coerce :: Char -> Boolean -> Desc -> Maybe O.Option
        coerce f isTrailing (DE.OptionDesc (DE.Option y))
          = coerce' y
            where
              coerce' { name = DE.Flag f' }
                | (f == f') && (isTrailing || isNothing y.arg)
                = return $ O.Option { flag:       pure f
                                    , name:       Nothing
                                    , arg:        resolveOptArg o.arg y.arg
                                    , env:        y.env
                                    , repeatable: o.repeatable
                                    }
              coerce' { name = DE.Full f' n' }
                | (f == f') && (isTrailing || isNothing y.arg)
                = return $ O.Option { flag:       pure f'
                                    , name:       pure n'
                                    , arg:        resolveOptArg o.arg y.arg
                                    , env:        y.env
                                    , repeatable: o.repeatable
                                  }
              coerce' _ = Nothing
        coerce _ _ _ = Nothing

    -- | Resolve an option's argument name against that given in the
    -- | description, returning the most complete argument known.
    resolveOptArg :: Maybe String
                  -> Maybe DE.Argument
                  -> Maybe O.Argument

    resolveOptArg (Just n) Nothing = do
      return $ O.Argument { name: n
                          , default: Nothing }
    resolveOptArg Nothing (Just (DE.Argument a))
      = return $ O.Argument { name: a.name
                            , default: a.default
                            }
    -- XXX: Do we need to guard that `an == a.name` here?
    resolveOptArg (Just an) (Just (DE.Argument a))
      = return $ O.Argument { name: a.name
                            , default: a.default
                            }
    resolveOptArg _ _ = Nothing

    toArg:: Maybe String -> Maybe O.Argument
    toArg a = do
      an <- a
      return $ O.Argument { name: an
                          , default: Nothing }

    argMatches :: Maybe String
               -> Maybe O.Argument
               -> Boolean
    argMatches a a'
      =  (isNothing a)
      || (isNothing a && isNothing a')
      || (maybe false id do
          an <- a
          (O.Argument { name: an' }) <- a'
          return (an ^= an')
        )

solveUsage :: U.Usage -> List Desc -> Either SolveError Usage
solveUsage (U.Usage _ bs) ds = Usage <$> do traverse (flip solveBranch ds) bs

solve :: (List U.Usage)
      -> (List Desc)
      -> Either SolveError (List Usage)
solve us ds = traverse (flip solveUsage ds) us


WIP #1703 - buttons

WIP #1703 - buttons

{-
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.GlobalMenu.Component
  ( component
  , Query(..)
  , MenuOpen(..)
  , Message(..)
  , AuthenticateOrPresentHelp(..)
  , State
  , module SlamData.GlobalMenu.Bus
  ) where

import SlamData.Prelude

import Control.UI.Browser as Browser
import Control.Monad.Aff.AVar as AVar
import Control.Monad.Aff.Bus as Bus
import Control.Monad.Eff as Eff
import Control.Monad.Eff.Ref as Ref
import Control.Monad.Eff.Exception as Exception

import Halogen as H
import Halogen.Component.Utils (busEventSource)
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.Menu.Component as Menu
import Halogen.Query.EventSource as ES
import Halogen.HTML.Events as HE

import OIDC.Crypt as Crypt

import Quasar.Advanced.Types (ProviderR)

import SlamData.AuthenticationMode as AuthenticationMode
import SlamData.Workspace.Eval.Card as EvalCard
import SlamData.GlobalError (GlobalError)
import SlamData.GlobalError as GlobalError
import SlamData.GlobalMenu.Bus (SignInMessage(..))
import SlamData.Monad (Slam)
import SlamData.Quasar as Api
import SlamData.Quasar.Auth as Auth
import SlamData.Quasar.Auth.Authentication (AuthenticationError, toNotificationOptions)
import SlamData.Quasar.Auth.Store as AuthStore
import SlamData.Render.Icon as I
import SlamData.Wiring as Wiring
import SlamData.Workspace.Eval.Persistence as Persistence

data AuthenticateOrPresentHelp

data Query a
  = Authenticate (Maybe ProviderR) a
  | DismissSubmenu a
  | HandleGlobalError GlobalError a
  | Init a
  | PresentAttribution a
  | ToggleMenu MenuOpen a

data MenuOpen
 = SignInMenu
 | HelpMenu

derive instance eqMenuOpen ∷ Eq MenuOpen

type State =
  { email ∷ Maybe String
  , loggedIn ∷ Boolean
  , menuOpen ∷ Maybe MenuOpen
  , providers ∷ Maybe (Array ProviderR)
  }

data Message =
  PresentAttributionsDialog

type HTML = H.ParentHTML Query (Menu.Query AuthenticateOrPresentHelp) Unit Slam
type DSL = H.ParentDSL State Query (Menu.Query AuthenticateOrPresentHelp) Unit Message Slam

component ∷ H.Component HH.HTML Query Unit Message Slam
component =
  H.lifecycleParentComponent
    { initialState: \_ →
      { email: Nothing
      , loggedIn: false
      , menuOpen: Nothing
      , providers: Nothing
      }
    , render
    , eval
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    , receiver: const Nothing
    }

render ∷ State → HTML
render state =
  HH.div
    [ HP.classes $ [ HH.ClassName "sd-global-menu" ] ]
    $ menu state

eval ∷ Query ~> DSL
eval = case _ of
  Init next → do
    { bus } ← H.lift Wiring.expose
    H.subscribe $ busEventSource (flip HandleGlobalError ES.Listening) bus.globalError
    update
    pure next

  DismissSubmenu next → do
    _ ← H.query unit $ H.action $ Menu.DismissSubmenu
    pure next

  HandleGlobalError error next →
    case error of
      GlobalError.Unauthorized _ → update $> next
      _ → pure next

  Authenticate providerR next → do
    authenticate providerR
    pure next

  PresentAttribution next → do
    H.raise PresentAttributionsDialog
    pure next

  ToggleMenu which next → do
    menuOpen ← H.gets _.menuOpen
    let
      m = case menuOpen, which of
        Just HelpMenu, HelpMenu → Nothing
        Just SignInMenu, SignInMenu → Nothing
        _, _ → Just which
    H.modify _{ menuOpen = m }
    pure next

update ∷ DSL Unit
update = do
  maybeIdToken ← H.lift Auth.getIdToken
  case maybeIdToken of
    Just idToken → do
      either
        (const retrieveProvidersAndUpdateMenu)
        putEmailToMenu
        (Eff.runPure $ Exception.try $ Crypt.readPayload idToken)
    Nothing →
      retrieveProvidersAndUpdateMenu
  where
  putEmailToMenu ∷ Crypt.Payload → DSL Unit
  putEmailToMenu payload =
    H.modify _{ loggedIn = true, email = map unwrap $ Crypt.pluckEmail payload }

  retrieveProvidersAndUpdateMenu ∷ DSL Unit
  retrieveProvidersAndUpdateMenu = void do
    eProviders ← Api.retrieveAuthProviders
    case eProviders of
      Right p → H.modify _{ providers = p }
      _ → pure unit

    {- H.query unit
      $ H.action
      $ Menu.Set
          { chosen: Nothing
          , submenus: case eProviders of
              _ ->
              -- Right (Just providers) →
                let
                  makeSubmenuItem provider =
                    { label: "Sign in with " ⊕ provider.displayName
                    , shortcutLabel: Nothing
                    , value: Authenticate $ Just provider
                    }
                in
                  [ { label: "🔓 Sign in"
                    , submenu: makeSubmenuItem <$> mempty -- providers
                    }
                  ]
                ⊕
              -- _ → helpMenu
          }
                -}

menu :: forall a. State → Array (H.HTML a Query)
menu state =
  let
    container ∷ HH.ClassName
    container = HH.ClassName "menu-container"

    submenuItem = HP.classes $ HH.ClassName <$> [ "menu-item", "submenu-item" ]

    submenu ∷ Array (H.HTML a Query) → H.HTML a Query
    submenu = HH.ul [ HP.class_ $ HH.ClassName "submenu" ]

    -- wraps stiff in `li > button`
    sitem ∷ ProviderR → H.HTML a Query
    sitem provider =
      HH.li [ submenuItem ]
        [ HH.button
          [ HP.classes $ HH.ClassName <$> [ "menu-item-button", "submenu-item-button" ]
          , HE.onClick $ HE.input_ $ Authenticate $ pure provider
          ]
          [ HH.text $ "Sign in with " <> provider.displayName ]
        ]

    -- wraps stuff in `li > a`
    hitem attrs children =
      HH.li [ submenuItem ]
        [ HH.a
          ([ HP.classes $ HH.ClassName <$> [ "menu-item-link", "submenu-item-link" ] ] <> attrs)
          children
        ]

    signInMenu ∷ Array (H.HTML a Query)
    signInMenu =
      case state.providers of
        Nothing → []
        Just ps →
          [ HH.div
            [ HP.classes [ container, HH.ClassName "sign-in-menu-container" ] ] $
            -- if
            [ HH.button
                [ HP.class_ $ HH.ClassName "sign-in-menu-button "
                , HE.onClick $ HE.input_ $ ToggleMenu SignInMenu
                ]
                [ I.unlockSm, HH.text "Sign in" ]
            ] <>
              if state.menuOpen == Just SignInMenu then
                [ submenu $ sitem <$> ps ]
              else
                []
          ]

    helpMenu ∷ H.HTML a Query
    helpMenu =
      HH.div
        [ HP.classes [ container, HH.ClassName "help-menu-container" ] ] $
        [ HH.button
          [ HP.class_ $ HH.ClassName "help-menu-button"
          , HE.onClick $ HE.input_ $ ToggleMenu HelpMenu
          ]
          [ I.helpSm, HH.text "Help" ]
        ] <>
          if state.menuOpen == Just HelpMenu then
            [ submenu
              [ hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/users-guide.html" ]
                  [ HH.text "User guide" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/administration-guide.html" ]
                  [ HH.text "Administrator guide" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/developers-guide.html" ]
                  [ HH.text "Developer guide" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/helpful-tips.html" ]
                  [ HH.text "Helpful tips" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/sql-squared-reference.html" ]
                  [ HH.text "SQL² reference" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/slamdown-reference.html" ]
                  [ HH.text "SlamDown reference" ]
              , hitem
                  [ HP.href "http://docs.slamdata.com/en/v4.2/troubleshooting-faq.html" ]
                  [ HH.text "Troubleshooting FAQ" ]
              , HH.li [ submenuItem ]
                  [ HH.button
                    [ HP.classes $ HH.ClassName <$>
                        [ "menu-item-button", "submenu-item-button"
                    ]
                    , HE.onClick $ HE.input_ $ PresentAttribution
                    ]
                    [ HH.text $ "Attritubion" ]
                  ]
              ]
            ]
          else
            []

  in
    signInMenu <> [ helpMenu ]

authenticate ∷ Maybe ProviderR → DSL Unit
authenticate = maybe logOut logIn
  where
  keySuffix ∷ String
  keySuffix =
    AuthenticationMode.toKeySuffix AuthenticationMode.ChosenProvider

  logOut ∷ DSL Unit
  logOut = do
    AuthStore.removeIdToken keySuffix
    AuthStore.removeUnhashedNonce keySuffix
    AuthStore.removeProvider keySuffix
    update

  logIn ∷ ProviderR → DSL Unit
  logIn providerR = do
    { auth } ← H.lift Wiring.expose
    idToken ← H.liftAff AVar.makeVar
    H.liftAff $ Bus.write { providerR, idToken, prompt: true, keySuffix } auth.requestToken
    either signInFailure (const $ signInSuccess) =<< (H.liftAff $ AVar.takeVar idToken)

  signInSuccess ∷ DSL Unit
  signInSuccess = do
    wiring ← Wiring.expose
    update
    traverse_ (lift ∘ Persistence.queueEvalImmediate ∘ EvalCard.toAll)
      =<< (H.liftEff $ Ref.readRef wiring.auth.retryEval)
    whenM
      (H.liftEff $ Ref.readRef wiring.auth.retrySave)
      (void $ lift $ Persistence.saveWorkspace)
    H.liftAff $ Bus.write SignInSuccess wiring.auth.signIn

  signInFailure ∷ AuthenticationError → DSL Unit
  signInFailure error = do
    { auth, bus } ← H.lift Wiring.expose
    H.liftAff do
      maybe (pure unit) (flip Bus.write bus.notify) (toNotificationOptions error)
      Bus.write SignInFailure auth.signIn

presentHelp ∷ String → DSL Unit
presentHelp = H.liftEff ∘ Browser.newTab

{-
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.GlobalMenu.Component
  ( component
  , Query(..)
  , MenuOpen(..)
  , Message(..)
  , AuthenticateOrPresentHelp(..)
  , State
  , module SlamData.GlobalMenu.Bus
  ) where

import SlamData.Prelude

import Control.UI.Browser as Browser
import Control.Monad.Aff.AVar as AVar
import Control.Monad.Aff.Bus as Bus
import Control.Monad.Eff as Eff
import Control.Monad.Eff.Ref as Ref
import Control.Monad.Eff.Exception as Exception

import Halogen as H
import Halogen.Component.Utils (busEventSource)
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.Menu.Component as Menu
import Halogen.Query.EventSource as ES
import Halogen.HTML.Events as HE

import OIDC.Crypt as Crypt

import Quasar.Advanced.Types (ProviderR)

import SlamData.AuthenticationMode as AuthenticationMode
import SlamData.Workspace.Eval.Card as EvalCard
import SlamData.GlobalError (GlobalError)
import SlamData.GlobalError as GlobalError
import SlamData.GlobalMenu.Bus (SignInMessage(..))
import SlamData.Monad (Slam)
import SlamData.Quasar as Api
import SlamData.Quasar.Auth as Auth
import SlamData.Quasar.Auth.Authentication (AuthenticationError, toNotificationOptions)
import SlamData.Quasar.Auth.Store as AuthStore
import SlamData.Render.Icon as I
import SlamData.Wiring as Wiring
import SlamData.Workspace.Eval.Persistence as Persistence

data AuthenticateOrPresentHelp
  = Authenticate (Maybe ProviderR)
  | PresentHelp String
  | PresentAttribution

data Query a
  = DismissSubmenu a
  | HandleGlobalError GlobalError a
  | HandleMenuMessage (Menu.Message AuthenticateOrPresentHelp) a
  | ToggleMenu MenuOpen a
  | Init a

data MenuOpen
 = SignInMenu
 | HelpMenu

derive instance eqMenuOpen ∷ Eq MenuOpen

type State =
  { loggedIn ∷ Boolean
  , menuOpen ∷ Maybe MenuOpen
  }

data Message =
  PresentAttributionsDialog

type HTML = H.ParentHTML Query (Menu.Query AuthenticateOrPresentHelp) Unit Slam
type DSL = H.ParentDSL State Query (Menu.Query AuthenticateOrPresentHelp) Unit Message Slam

component ∷ H.Component HH.HTML Query Unit Message Slam
component =
  H.lifecycleParentComponent
    { initialState: \_ → { loggedIn: false, menuOpen: Nothing }
    , render
    , eval
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    , receiver: const Nothing
    }

render ∷ State → HTML
render state =
  HH.div
    [ HP.classes $ [ HH.ClassName "sd-global-menu" ] ]
    $ helpMenu state.menuOpen

eval ∷ Query ~> DSL
eval = case _ of
  Init next → do
    { bus } ← H.lift Wiring.expose
    H.subscribe $ busEventSource (flip HandleGlobalError ES.Listening) bus.globalError
    update
    pure next

  DismissSubmenu next → do
    _ ← H.query unit $ H.action $ Menu.DismissSubmenu
    pure next

  HandleGlobalError error next →
    case error of
      GlobalError.Unauthorized _ → update $> next
      _ → pure next

  HandleMenuMessage (Menu.Selected a) next → do
    case a of
      Authenticate providerR → authenticate providerR
      PresentHelp uri → presentHelp uri
      PresentAttribution → H.raise PresentAttributionsDialog
    pure next

  ToggleMenu which next → do
    menuOpen ← H.gets _.menuOpen
    let
      m = case menuOpen, which of
        Just HelpMenu, HelpMenu → Nothing
        Just SignInMenu, SignInMenu → Nothing
        _, _ → Just which
    H.modify _{ menuOpen = m }
    pure next

update ∷ DSL Unit
update = do
  maybeIdToken ← H.lift Auth.getIdToken
  case maybeIdToken of
    Just idToken → do
      either
        (const retrieveProvidersAndUpdateMenu)
        putEmailToMenu
        (Eff.runPure $ Exception.try $ Crypt.readPayload idToken)
    Nothing →
      retrieveProvidersAndUpdateMenu
  where
  putEmailToMenu ∷ Crypt.Payload → DSL Unit
  putEmailToMenu payload = do
    _ ← H.query unit
      $ H.action
      $ Menu.Set
        { chosen: Nothing
        , submenus:
            [ { label:
                fromMaybe "unknown user"
                $ map unwrap
                $ Crypt.pluckEmail
                $ payload
              , submenu:
                [ { label: "🔒 Sign out"
                  , shortcutLabel: Nothing
                  , value: Authenticate Nothing
                  }
                ]
              }
            ]
        }
    H.modify _{ loggedIn = true }

  retrieveProvidersAndUpdateMenu ∷ DSL Unit
  retrieveProvidersAndUpdateMenu = void do
    eProviders ← Api.retrieveAuthProviders
    pure unit

    {- H.query unit
      $ H.action
      $ Menu.Set
          { chosen: Nothing
          , submenus: case eProviders of
              _ ->
              -- Right (Just providers) →
                let
                  makeSubmenuItem provider =
                    { label: "Sign in with " ⊕ provider.displayName
                    , shortcutLabel: Nothing
                    , value: Authenticate $ Just provider
                    }
                in
                  [ { label: "🔓 Sign in"
                    , submenu: makeSubmenuItem <$> mempty -- providers
                    }
                  ]
                ⊕
              -- _ → helpMenu
          }
                -}

helpMenu :: forall a. Maybe MenuOpen → Array (H.HTML a Query)
helpMenu whichMenu =
  let
    container = HH.ClassName "menu-container"

    -- wraps stuff in an li > a
    item attrs children =
      HH.li [ HP.classes $ HH.ClassName <$> [ "menu-item", "submenu-item" ] ]
        [ HH.a
          ([ HP.classes $ HH.ClassName <$> [ "menu-item-link", "submenu-item-link" ] ] <> attrs)
          children
        ]
  in
    [ HH.div
        [ HP.classes [ container, HH.ClassName "sign-in-menu-container" ] ]
        [ HH.button
            [ HP.class_ $ HH.ClassName "sign-in-menu-button "
            , HE.onClick $ HE.input_ $ ToggleMenu SignInMenu
            ]
            [ I.unlockSm, HH.text "Sign in" ]
        ]
    , HH.div
        [ HP.classes [ container, HH.ClassName "help-menu-container" ] ] $
        [ HH.button
          [ HP.class_ $ HH.ClassName "help-menu-button"
          , HE.onClick $ HE.input_ $ ToggleMenu HelpMenu
          ]
          [ I.helpSm, HH.text "Help" ]
        ] <>
          if whichMenu == Just HelpMenu then
            [ HH.ul
              [ HP.class_ $ HH.ClassName "submenu" ]
              [ item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/users-guide.html" ]
                  [ HH.text "User guide" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/administration-guide.html" ]
                  [ HH.text "Administrator guide" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/developers-guide.html" ]
                  [ HH.text "Developer guide" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/helpful-tips.html" ]
                  [ HH.text "Helpful tips" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/sql-squared-reference.html" ]
                  [ HH.text "SQL² reference" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/slamdown-reference.html" ]
                  [ HH.text "SlamDown reference" ]
              , item
                  [ HP.href "http://docs.slamdata.com/en/v4.2/troubleshooting-faq.html" ]
                  [ HH.text "Troubleshooting FAQ" ]
              ]
            ]
          else
            []
    ]

authenticate ∷ Maybe ProviderR → DSL Unit
authenticate = maybe logOut logIn
  where
  keySuffix ∷ String
  keySuffix =
    AuthenticationMode.toKeySuffix AuthenticationMode.ChosenProvider

  logOut ∷ DSL Unit
  logOut = do
    AuthStore.removeIdToken keySuffix
    AuthStore.removeUnhashedNonce keySuffix
    AuthStore.removeProvider keySuffix
    update

  logIn ∷ ProviderR → DSL Unit
  logIn providerR = do
    { auth } ← H.lift Wiring.expose
    idToken ← H.liftAff AVar.makeVar
    H.liftAff $ Bus.write { providerR, idToken, prompt: true, keySuffix } auth.requestToken
    either signInFailure (const $ signInSuccess) =<< (H.liftAff $ AVar.takeVar idToken)

  signInSuccess ∷ DSL Unit
  signInSuccess = do
    wiring ← Wiring.expose
    update
    traverse_ (lift ∘ Persistence.queueEvalImmediate ∘ EvalCard.toAll)
      =<< (H.liftEff $ Ref.readRef wiring.auth.retryEval)
    whenM
      (H.liftEff $ Ref.readRef wiring.auth.retrySave)
      (void $ lift $ Persistence.saveWorkspace)
    H.liftAff $ Bus.write SignInSuccess wiring.auth.signIn

  signInFailure ∷ AuthenticationError → DSL Unit
  signInFailure error = do
    { auth, bus } ← H.lift Wiring.expose
    H.liftAff do
      maybe (pure unit) (flip Bus.write bus.notify) (toNotificationOptions error)
      Bus.write SignInFailure auth.signIn

presentHelp ∷ String → DSL Unit
presentHelp = H.liftEff ∘ Browser.newTab


Remove an unnecessary unsafePartial

Remove an unnecessary unsafePartial

Original commit f3c36de8d17d95d8cf6de18b6b913b6f46889ad3

module CSharp
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Char.Unicode (GeneralCategory(..), generalCategory)
import Data.Foldable (find, for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as M
import Data.Map (Map)
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.String.Util (camelCase, legalizeCharacters, startWithLetter, stringEscape, isLetterOrLetterNumber)
import Data.Tuple (Tuple(..))
import Utils (removeElement)

forbiddenNames :: Array String
forbiddenNames = ["Convert", "JsonConverter", "Type"]

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , extension: "cs"
    , doc: csharpDoc
    , transforms:
        { nameForClass: simpleNamer nameForClass
        , nextName: \s -> "Other" <> s
        , forbiddenNames
        , topLevelName: noForbidNamer csNameStyle
        , unions: Just
            { predicate: unionIsNotSimpleNullable
            , properName: simpleNamer (csNameStyle <<< combineNames)
            , nameFromTypes: simpleNamer (unionNameIntercalated csNameStyle "Or")
            }
        }
    }

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = csNameStyle $ combineNames names

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterOrLetterNumber c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isStartCharacter c

renderNullableToCSharp :: IRType -> Doc String
renderNullableToCSharp x = do
    rendered <- renderTypeToCSharp x
    pure if isValueType x then rendered <> "?" else rendered

renderUnionToCSharp :: IRUnionRep -> Doc String
renderUnionToCSharp ur =
    case nullableFromSet $ unionToSet ur of
    Just x -> renderNullableToCSharp x
    Nothing -> lookupUnionName ur

renderTypeToCSharp :: IRType -> Doc String
renderTypeToCSharp = case _ of
    IRNothing -> pure "object" -- we can have arrays of nothing
    IRNull -> pure "object"
    IRInteger -> pure "long"
    IRDouble -> pure "double"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderTypeToCSharp a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderTypeToCSharp t
        pure $ "Dictionary<string, " <> rendered <> ">"
    IRUnion ur -> renderUnionToCSharp ur

csNameStyle :: String -> String
csNameStyle = legalizeCharacters isPartCharacter >>> camelCase >>> startWithLetter isStartCharacter true

getDecoderHelperPrefix :: String -> Doc String
getDecoderHelperPrefix topLevelName = getForSingleOrMultipleTopLevels "" topLevelName

csharpDoc :: Doc Unit
csharpDoc = do
    module_ <- getModuleName csNameStyle
    oneOfThese <- getForSingleOrMultipleTopLevels "" " one of these"
    line $ "// To parse this JSON data, add NuGet 'Newtonsoft.Json' then do" <> oneOfThese <> ":"
    forEachTopLevel_ \topLevelName topLevelType -> do
        prefix <- getDecoderHelperPrefix topLevelName
        line "//"
        line $ "//    var data = " <> module_ <> ".Convert." <> prefix <> "FromJson(jsonString);"
    line "//"
    line $ "namespace " <> module_
    line "{"
    indent do
        line """using System;
using System.Net;
using System.Collections.Generic;

using Newtonsoft.Json;"""
        forEachClass_ \className properties -> do
            blank
            renderCSharpClass className properties
        forEachUnion_ \unionName unionTypes -> do
            blank
            renderCSharpUnion unionName unionTypes
        blank
        renderJsonConverter
    line "}"

stringIfTrue :: Boolean -> String -> String
stringIfTrue true s = s
stringIfTrue false _ = ""

renderJsonConverter :: Doc Unit
renderJsonConverter = do
    unionNames <- getUnionNames
    let haveUnions = not $ M.isEmpty unionNames
    let names = M.values unionNames
    line $ "public class Convert" <> stringIfTrue haveUnions " : JsonConverter"
    line "{"
    indent do
        line "// Serialize/deserialize helpers"
        forEachTopLevel_ \topLevelName topLevelType -> do
            blank
            topLevelTypeRendered <- renderTypeToCSharp topLevelType
            fromJsonPrefix <- getDecoderHelperPrefix topLevelName
            line
                $ "public static "
                <> topLevelTypeRendered
                <> " "
                <> fromJsonPrefix
                <> "FromJson(string json) => JsonConvert.DeserializeObject<"
                <> topLevelTypeRendered
                <> ">(json, Settings);"
            line
                $ "public static string ToJson("
                <> topLevelTypeRendered
                <> " o) => JsonConvert.SerializeObject(o, Settings);"

        blank
        line "// JsonConverter stuff"

        when haveUnions do
            blank
            line "public override bool CanConvert(Type t)"
            line "{"
            indent $ line $ "return " <> intercalate " || " (map (\n -> "t == typeof(" <> n <> ")") names) <> ";"
            line "}"
            blank
            line "public override object ReadJson(JsonReader reader, Type t, object existingValue, JsonSerializer serializer)"
            line "{"
            indent do
                -- FIXME: call the constructor via reflection?
                for_ names \name -> do
                    line $ "if (t == typeof(" <> name <> "))"
                    indent $ line $ "return new " <> name <> "(reader, serializer);"
                line "throw new Exception(\"Unknown type\");"
            line "}"
            blank
            line "public override void WriteJson(JsonWriter writer, object value, JsonSerializer serializer)"
            line "{"
            indent do
                line "var t = value.GetType();"
                for_ names \name -> do
                    line $ "if (t == typeof(" <> name <> ")) {"
                    indent do
                        line $ "((" <> name <> ")value).WriteJson(writer, serializer);"
                        line "return;"
                    line "}"
                line "throw new Exception(\"Unknown type\");"
            line "}"

        blank
        line "static JsonSerializerSettings Settings = new JsonSerializerSettings"
        line "{"
        indent do
            line "MetadataPropertyHandling = MetadataPropertyHandling.Ignore,"
            line "DateParseHandling = DateParseHandling.None,"
            when haveUnions do
                line "Converters = { new Convert() },"
        line "};"
    line "}"

tokenCase :: String -> Doc Unit
tokenCase tokenType =
    line $ "case JsonToken." <> tokenType <> ":"

renderNullDeserializer :: Set IRType -> Doc Unit
renderNullDeserializer types =
    when (S.member IRNull types) do
        tokenCase "Null"
        indent do
            line "break;"

unionFieldName :: IRType -> Doc String
unionFieldName t = csNameStyle <$> getTypeNameForUnion t

deserialize :: String -> String -> Doc Unit
deserialize fieldName typeName = do
    line $ fieldName <> " = serializer.Deserialize<" <> typeName <> ">(reader);"
    line "break;"

deserializeType :: IRType -> Doc Unit
deserializeType t = do
    fieldName <- unionFieldName t
    renderedType <- renderTypeToCSharp t
    deserialize fieldName renderedType

renderPrimitiveDeserializer :: List String -> IRType -> Set IRType -> Doc Unit
renderPrimitiveDeserializer tokenTypes t types =
    when (S.member t types) do
        for_ tokenTypes \tokenType -> do
            tokenCase tokenType
        indent do
            deserializeType t

renderDoubleDeserializer :: Set IRType -> Doc Unit
renderDoubleDeserializer types =
    when (S.member IRDouble types) do
        unless (S.member IRInteger types) do
            tokenCase "Integer"
        tokenCase "Float"
        indent do
            deserializeType IRDouble

renderGenericDeserializer :: (IRType -> Boolean) -> String -> Set IRType -> Doc Unit
renderGenericDeserializer predicate tokenType types =
    case find predicate types of
    Nothing -> pure unit
    Just t -> do
        tokenCase tokenType
        indent do
            deserializeType t

renderCSharpUnion :: String -> Set IRType -> Doc Unit
renderCSharpUnion name allTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    line $ "public struct " <> name
    line "{"
    indent do
        for_ nonNullTypes \t -> do
            typeString <- renderNullableToCSharp t
            field <- unionFieldName t
            line $ "public " <> typeString <> " " <> field <> ";"
        blank
        line $ "public " <> name <> "(JsonReader reader, JsonSerializer serializer)"
        line "{"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                line $ fieldName <> " = null;"
            blank
            line "switch (reader.TokenType)"
            line "{"
            indent do
                renderNullDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Integer") IRInteger allTypes
                renderDoubleDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Boolean") IRBool allTypes
                renderPrimitiveDeserializer ("String" : "Date" : L.Nil) IRString allTypes
                renderGenericDeserializer isArray "StartArray" allTypes
                renderGenericDeserializer isClass "StartObject" allTypes
                renderGenericDeserializer isMap "StartObject" allTypes
                line $ "default: throw new Exception(\"Cannot convert " <> name <> "\");"
            line "}"
        line "}"
        blank
        line $ "public void WriteJson(JsonWriter writer, JsonSerializer serializer)"
        line "{"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                line $ "if (" <> fieldName <> " != null) {"
                indent do
                    line $ "serializer.Serialize(writer, " <> fieldName <> ");"
                    line "return;"
                line "}"
            when (isJust emptyOrNull) do
                line "writer.WriteNull();"
            when (isNothing emptyOrNull) do
                line "throw new Exception(\"Union must not be null\");"
        line "}"
    line "}"

renderCSharpClass :: String -> Map String IRType -> Doc Unit
renderCSharpClass className properties = do
    let propertyNames = transformPropertyNames (simpleNamer csNameStyle) ("Other" <> _) [className] properties
    line $ "public class " <> className
    -- TODO fix this manual indentation
    string "    {"
    indent do
        for_ (M.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            blank
            line $ "[JsonProperty(\"" <> stringEscape pname <> "\")]"
            rendered <- renderTypeToCSharp ptype
            let csPropName = lookupName pname propertyNames
            line $ "public " <> rendered <> " " <> csPropName <> " { get; set; }"
    line "}"

module CSharp
    ( renderer
    ) where

import Doc
import IRGraph
import Prelude

import Data.Char.Unicode (GeneralCategory(..), generalCategory)
import Data.Foldable (find, for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as M
import Data.Map (Map)
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.String.Util (camelCase, legalizeCharacters, startWithLetter, stringEscape, isLetterOrLetterNumber)
import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)
import Utils (removeElement)

forbiddenNames :: Array String
forbiddenNames = ["Convert", "JsonConverter", "Type"]

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , extension: "cs"
    , doc: csharpDoc
    , transforms:
        { nameForClass: simpleNamer nameForClass
        , nextName: \s -> "Other" <> s
        , forbiddenNames
        , topLevelName: noForbidNamer csNameStyle
        , unions: Just
            { predicate: unionIsNotSimpleNullable
            , properName: simpleNamer (csNameStyle <<< combineNames)
            , nameFromTypes: simpleNamer (unionNameIntercalated csNameStyle "Or")
            }
        }
    }

nameForClass :: IRClassData -> String
nameForClass (IRClassData { names }) = csNameStyle $ combineNames names

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

isStartCharacter :: Char -> Boolean
isStartCharacter c =
    isLetterOrLetterNumber c || c == '_'

isPartCharacter :: Char -> Boolean
isPartCharacter c =
    case generalCategory c of
    Just DecimalNumber -> true
    Just ConnectorPunctuation -> true
    Just NonSpacingMark -> true
    Just SpacingCombiningMark -> true
    Just Format -> true
    _ -> isStartCharacter c

renderNullableToCSharp :: IRType -> Doc String
renderNullableToCSharp x = do
    rendered <- renderTypeToCSharp x
    pure if isValueType x then rendered <> "?" else rendered

renderUnionToCSharp :: IRUnionRep -> Doc String
renderUnionToCSharp ur =
    case nullableFromSet $ unionToSet ur of
    Just x -> renderNullableToCSharp x
    Nothing -> lookupUnionName ur

renderTypeToCSharp :: IRType -> Doc String
renderTypeToCSharp = case _ of
    IRNothing -> pure "object" -- we can have arrays of nothing
    IRNull -> pure "object"
    IRInteger -> pure "long"
    IRDouble -> pure "double"
    IRBool -> pure "bool"
    IRString -> pure "string"
    IRArray a -> do
        rendered <- renderTypeToCSharp a
        pure $ rendered <> "[]"
    IRClass i -> lookupClassName i
    IRMap t -> do
        rendered <- renderTypeToCSharp t
        pure $ "Dictionary<string, " <> rendered <> ">"
    IRUnion ur -> renderUnionToCSharp ur

csNameStyle :: String -> String
csNameStyle = legalizeCharacters isPartCharacter >>> camelCase >>> startWithLetter isStartCharacter true

getDecoderHelperPrefix :: String -> Doc String
getDecoderHelperPrefix topLevelName = getForSingleOrMultipleTopLevels "" topLevelName

csharpDoc :: Doc Unit
csharpDoc = do
    module_ <- getModuleName csNameStyle
    oneOfThese <- getForSingleOrMultipleTopLevels "" " one of these"
    line $ "// To parse this JSON data, add NuGet 'Newtonsoft.Json' then do" <> oneOfThese <> ":"
    forEachTopLevel_ \topLevelName topLevelType -> do
        prefix <- getDecoderHelperPrefix topLevelName
        line "//"
        line $ "//    var data = " <> module_ <> ".Convert." <> prefix <> "FromJson(jsonString);"
    line "//"
    line $ "namespace " <> module_
    line "{"
    indent do
        line """using System;
using System.Net;
using System.Collections.Generic;

using Newtonsoft.Json;"""
        forEachClass_ \className properties -> do
            blank
            renderCSharpClass className properties
        forEachUnion_ \unionName unionTypes -> do
            blank
            renderCSharpUnion unionName unionTypes
        blank
        renderJsonConverter
    line "}"

stringIfTrue :: Boolean -> String -> String
stringIfTrue true s = s
stringIfTrue false _ = ""

renderJsonConverter :: Doc Unit
renderJsonConverter = do
    unionNames <- getUnionNames
    let haveUnions = not $ M.isEmpty unionNames
    let names = M.values unionNames
    line $ "public class Convert" <> stringIfTrue haveUnions " : JsonConverter"
    line "{"
    indent do
        line "// Serialize/deserialize helpers"
        forEachTopLevel_ \topLevelName topLevelType -> do
            blank
            topLevelTypeRendered <- renderTypeToCSharp topLevelType
            fromJsonPrefix <- getDecoderHelperPrefix topLevelName
            line
                $ "public static "
                <> topLevelTypeRendered
                <> " "
                <> fromJsonPrefix
                <> "FromJson(string json) => JsonConvert.DeserializeObject<"
                <> topLevelTypeRendered
                <> ">(json, Settings);"
            line
                $ "public static string ToJson("
                <> topLevelTypeRendered
                <> " o) => JsonConvert.SerializeObject(o, Settings);"

        blank
        line "// JsonConverter stuff"

        when haveUnions do
            blank
            line "public override bool CanConvert(Type t)"
            line "{"
            indent $ line $ "return " <> intercalate " || " (map (\n -> "t == typeof(" <> n <> ")") names) <> ";"
            line "}"
            blank
            line "public override object ReadJson(JsonReader reader, Type t, object existingValue, JsonSerializer serializer)"
            line "{"
            indent do
                -- FIXME: call the constructor via reflection?
                for_ names \name -> do
                    line $ "if (t == typeof(" <> name <> "))"
                    indent $ line $ "return new " <> name <> "(reader, serializer);"
                line "throw new Exception(\"Unknown type\");"
            line "}"
            blank
            line "public override void WriteJson(JsonWriter writer, object value, JsonSerializer serializer)"
            line "{"
            indent do
                line "var t = value.GetType();"
                for_ names \name -> do
                    line $ "if (t == typeof(" <> name <> ")) {"
                    indent do
                        line $ "((" <> name <> ")value).WriteJson(writer, serializer);"
                        line "return;"
                    line "}"
                line "throw new Exception(\"Unknown type\");"
            line "}"

        blank
        line "static JsonSerializerSettings Settings = new JsonSerializerSettings"
        line "{"
        indent do
            line "MetadataPropertyHandling = MetadataPropertyHandling.Ignore,"
            line "DateParseHandling = DateParseHandling.None,"
            when haveUnions do
                line "Converters = { new Convert() },"
        line "};"
    line "}"

tokenCase :: String -> Doc Unit
tokenCase tokenType =
    line $ "case JsonToken." <> tokenType <> ":"

renderNullDeserializer :: Set IRType -> Doc Unit
renderNullDeserializer types =
    when (S.member IRNull types) do
        tokenCase "Null"
        indent do
            line "break;"

unionFieldName :: IRType -> Doc String
unionFieldName t = csNameStyle <$> getTypeNameForUnion t

deserialize :: String -> String -> Doc Unit
deserialize fieldName typeName = do
    line $ fieldName <> " = serializer.Deserialize<" <> typeName <> ">(reader);"
    line "break;"

deserializeType :: IRType -> Doc Unit
deserializeType t = do
    fieldName <- unionFieldName t
    renderedType <- renderTypeToCSharp t
    deserialize fieldName renderedType

renderPrimitiveDeserializer :: List String -> IRType -> Set IRType -> Doc Unit
renderPrimitiveDeserializer tokenTypes t types =
    when (S.member t types) do
        for_ tokenTypes \tokenType -> do
            tokenCase tokenType
        indent do
            deserializeType t

renderDoubleDeserializer :: Set IRType -> Doc Unit
renderDoubleDeserializer types =
    when (S.member IRDouble types) do
        unless (S.member IRInteger types) do
            tokenCase "Integer"
        tokenCase "Float"
        indent do
            deserializeType IRDouble

renderGenericDeserializer :: (IRType -> Boolean) -> String -> Set IRType -> Doc Unit
renderGenericDeserializer predicate tokenType types = unsafePartial $
    case find predicate types of
    Nothing -> pure unit
    Just t -> do
        tokenCase tokenType
        indent do
            deserializeType t

renderCSharpUnion :: String -> Set IRType -> Doc Unit
renderCSharpUnion name allTypes = do
    let { element: emptyOrNull, rest: nonNullTypes } = removeElement (_ == IRNull) allTypes
    line $ "public struct " <> name
    line "{"
    indent do
        for_ nonNullTypes \t -> do
            typeString <- renderNullableToCSharp t
            field <- unionFieldName t
            line $ "public " <> typeString <> " " <> field <> ";"
        blank
        line $ "public " <> name <> "(JsonReader reader, JsonSerializer serializer)"
        line "{"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                line $ fieldName <> " = null;"
            blank
            line "switch (reader.TokenType)"
            line "{"
            indent do
                renderNullDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Integer") IRInteger allTypes
                renderDoubleDeserializer allTypes
                renderPrimitiveDeserializer (L.singleton "Boolean") IRBool allTypes
                renderPrimitiveDeserializer ("String" : "Date" : L.Nil) IRString allTypes
                renderGenericDeserializer isArray "StartArray" allTypes
                renderGenericDeserializer isClass "StartObject" allTypes
                renderGenericDeserializer isMap "StartObject" allTypes
                line $ "default: throw new Exception(\"Cannot convert " <> name <> "\");"
            line "}"
        line "}"
        blank
        line $ "public void WriteJson(JsonWriter writer, JsonSerializer serializer)"
        line "{"
        indent do
            for_ (L.fromFoldable nonNullTypes) \field -> do
                fieldName <- unionFieldName field
                line $ "if (" <> fieldName <> " != null) {"
                indent do
                    line $ "serializer.Serialize(writer, " <> fieldName <> ");"
                    line "return;"
                line "}"
            when (isJust emptyOrNull) do
                line "writer.WriteNull();"
            when (isNothing emptyOrNull) do
                line "throw new Exception(\"Union must not be null\");"
        line "}"
    line "}"

renderCSharpClass :: String -> Map String IRType -> Doc Unit
renderCSharpClass className properties = do
    let propertyNames = transformPropertyNames (simpleNamer csNameStyle) ("Other" <> _) [className] properties
    line $ "public class " <> className
    -- TODO fix this manual indentation
    string "    {"
    indent do
        for_ (M.toUnfoldable properties :: Array _) \(Tuple pname ptype) -> do
            blank
            line $ "[JsonProperty(\"" <> stringEscape pname <> "\")]"
            rendered <- renderTypeToCSharp ptype
            let csPropName = lookupName pname propertyNames
            line $ "public " <> rendered <> " " <> csPropName <> " { get; set; }"
    line "}"