peeking.purs

module FileSystem where

import Prelude

import Control.Monad.Aff (runAff, forkAff, Aff())
import Control.Monad.Aff.AVar (makeVar)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (throwException, EXCEPTION())
import Control.UI.Browser (setLocation)
import Data.Either (Either(..), either)
import Data.Functor (($>))
import Data.Functor.Coproduct (Coproduct(), runCoproduct)
import Data.Functor.Coproduct (runCoproduct, coproduct)
import Data.Maybe (Maybe(..))
import Data.Path.Pathy (rootDir)
import Data.Path.Utils (DirPath())
import Data.Salt (Salt(..), newSalt)
import Data.Sort (Sort(..), notSort)
import Optic.Core ((^.), LensP(), lens, (..))
import Css.Geometry (marginLeft)
import Css.Size
import Css.String

import Halogen
import Halogen.Util (appendToBody)
import Halogen.Query (liftH)
import Halogen.Component (EvalP(), installedState)
import Halogen.Component.ChildPath (ChildPath(), cpL, cpR, (:>))
import qualified Halogen.HTML as H
import qualified Halogen.HTML.Elements as H
import qualified Halogen.HTML.Properties as P
import qualified Halogen.Themes.Bootstrap3 as B
import qualified Halogen.HTML.CSS as CSS
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.HTML.CSS as CSS


import Render.Common
import qualified Render.CssClasses as Rc
import FileSystem.Common (browseURL, Target())
import FileSystem.Routing
import FileSystem.Effects
import FileSystem.Item (Item())
import qualified FileSystem.Search as Search
import qualified FileSystem.Breadcrumbs as Breadcrumbs
import qualified FileSystem.Items as Items
import qualified FileSystem.Item as Item


type ChildStates p = Either (Items.StateInstalled p)
                     (Either Search.State Breadcrumbs.State)
type ChildInputs = Coproduct Items.InputInstalled
                   (Coproduct Search.Input Breadcrumbs.Input)
type ChildSlots = Either Items.Slot (Either Search.Slot Breadcrumbs.Slot)

cpBreadcrumbs :: forall p. ChildPath
                 Breadcrumbs.State (ChildStates p)
                 Breadcrumbs.Input ChildInputs
                 Breadcrumbs.Slot ChildSlots
cpBreadcrumbs = cpR :> cpR

cpSearch :: forall p. ChildPath
            Search.State (ChildStates p)
            Search.Input ChildInputs
            Search.Slot ChildSlots
cpSearch = cpR :> cpL

cpItems :: forall p. ChildPath
           (Items.StateInstalled p) (ChildStates p)
           Items.InputInstalled ChildInputs
           Items.Slot ChildSlots
cpItems = cpL

type StateRec =
  { path :: DirPath
  , salt :: Salt
  , sort :: Sort
  , version :: Maybe String
  , items :: Array Item
  }

newtype State = State StateRec

_State :: LensP State StateRec
_State  = lens (\(State obj) -> obj) (const State)

_version :: LensP State (Maybe String)
_version = _State .. lens _.version _{version = _}

_sort :: LensP State Sort
_sort = _State .. lens _.sort _{sort = _}

_salt :: LensP State Salt
_salt = _State .. lens _.salt _{salt = _}

_path :: LensP State DirPath
_path = _State .. lens _.path _{path = _}

_items :: LensP State (Array Item)
_items = _State .. lens _.items _{items = _}

initialState :: State
initialState =
  State { path: rootDir
        , salt: Salt ""
        , sort: Asc
        , version: Nothing
        , items: []
        }

newtype Input a
  = Resort a


filesystemComponent :: forall p. ParentComponentP
                       State (ChildStates p)
                       Input ChildInputs
                       Target
                       ChildSlots p
filesystemComponent = component' render eval peek
  where
  render :: Render State Input ChildSlots
  render state@(State r) =
    H.div_ [ navbar
             [  H.div [ P.classes [ Rc.header, B.clearfix ] ]
                [ icon B.glyphiconFolderOpen Config.homeHash
                , logo (state ^. _version)
                , H.slot' cpSearch $ Search.Slot
                ]
             ]
           , content
             [ H.div [ P.class_ B.clearfix ]
               [ H.slot' cpBreadcrumbs $ Breadcrumbs.Slot r.path
                 -- toolbar
               ]
             , row [ sorting state ]
             , H.slot' cpItems $ Items.Slot
             ]
--           , modal state
           ]

  eval :: EvalP Input State (ChildStates p) Input ChildInputs Target ChildSlots p
  eval (Resort next) = do
    searchValue <- query' cpSearch Search.Slot (request Search.GetValue)
    state <- get
    liftH $ liftEff' $ goto $ browseURL (searchValue >>= id)
      (notSort (state ^. _sort)) (state ^. _salt) (state ^. _path)
    pure next

  peek :: Peek State (ChildStates p) Input ChildInputs Target ChildSlots p
  peek (ChildF p q) =
    case runCoproduct q of
      Left l -> do
        case runCoproduct l of
          Left _ -> pure unit
          Right (ChildF (Item.Slot ix) (Item.Toggle _)) ->
            pure unit
        traceAnyA p
        traceAnyA q
        pure unit
      Right q' -> case runCoproduct q' of
        Left (Search.Clear _) -> do
          salt <- liftH $ liftEff' newSalt
          (State state) <- get
          liftH $ liftEff' $ goto
            $ browseURL Nothing state.sort salt state.path
        _ -> pure unit
    where
    newSalt' :: Aff FileSystemEffects Salt
    newSalt' = liftEff newSalt
  goto :: String -> Eff FileSystemEffects Unit
  goto = setLocation

import Debug.Trace

sorting :: forall p. Render State Input p
sorting state =
  H.div [ P.classes [ B.colXs4, Rc.toolbarSort ] ]
  [ H.a [ E.onClick (\_ -> E.preventDefault $> action Resort) ]
    [ H.text "Name"
    , H.i [ chevron (state ^. _sort)
          , CSS.style (marginLeft $ px 10.0)
          ] [ ]
    ]
  ]
  where
  chevron Asc = P.classes [ B.glyphicon, B.glyphiconChevronUp ]
  chevron Desc = P.classes [ B.glyphicon, B.glyphiconChevronDown ]

ui :: forall p. InstalledComponent
      State (ChildStates p)
      Input ChildInputs
      Target
      ChildSlots p
ui = installWithState' filesystemComponent installer
  where
  installer (State s) =
    either (installItems s) (either (installSearch s) (installBreadcrumbs s))
  installItems s Items.Slot =
    createChild' cpItems Items.comp
    $ installedState $ Items.initialState
  installSearch s Search.Slot =
    createChild' cpSearch Search.comp
    $ Search.initialState s.sort  s.salt
  installBreadcrumbs s (Breadcrumbs.Slot path)  =
    createChild' cpBreadcrumbs Breadcrumbs.breadcrumbsComponent
    $ Breadcrumbs.mkBreadcrumbs path s.sort s.salt

main :: forall e. Eff FileSystemEffects Unit
main = runAff throwException (const (pure unit)) do
  halogen <- runUI ui (installedState initialState)
  appendToBody halogen.node
--  forkAff $ routeSignal (WithState >>> action >>> halogen.driver)