Skip to content

Commit

Permalink
fix date, csv, host string
Browse files Browse the repository at this point in the history
  • Loading branch information
@averagehat
averagehat committed May 1, 2016
1 parent dce941c commit 3770683
Show file tree
Hide file tree
Showing 3 changed files with 92 additions and 41 deletions.
2 changes: 0 additions & 2 deletions bower.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,5 @@
"purescript-globals" : "^0.2.2",
"purescript-random" : "^0.2.3",
"purescript-sets" : "^0.5.6",
"purescript-eulalie" : "^1.0.0"

}
}
44 changes: 30 additions & 14 deletions src/Form.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ import Data.Int as Int
import Data.Set as Set
import Data.List.Lazy as List
import Data.Maybe.Unsafe (fromJust)
import Control.Monad.Eff.Exception.Unsafe (unsafeThrow)
import Control.Monad.Eff.Class (liftEff)
--import Data.Unfoldable (replicateA)
import Control.Monad.Eff.Random as Rand
Expand All @@ -20,7 +21,6 @@ import Pux.Html.Attributes as At
import Data.StrMap as M
import Pux.Html.Attributes (type_, value, name, download, href, checked, disabled, color, size)
import Pux.Html.Events (FormEvent, onChange, onSubmit, onClick, SelectionEvent, onSelect)
import Unsafe.Coerce (unsafeCoerce)
import Data.Maybe (Maybe(Nothing, Just), fromMaybe, maybe)
import App.Seq as Seq
import App.Seq (Format(Fasta,CSV), Host(..), readFormat)
Expand All @@ -43,6 +43,7 @@ type State = { name :: Maybe String
, country :: Maybe String
, segment :: Maybe Seq.Segment
, host :: Maybe Seq.Host
, hostString :: Maybe String
, serotype :: Maybe Seq.Serotype
, result :: Array Seq.State
, genotype :: Maybe Seq.Genotype
Expand All @@ -62,6 +63,7 @@ data Action =
| MaxDateChange FormEvent
| CountryChange FormEvent
| HostChange FormEvent
| HostStringChange FormEvent
| SerotypeChange FormEvent
| SegmentChange FormEvent
| GenotypeChange FormEvent
Expand All @@ -86,7 +88,8 @@ init = { name: Nothing, country: Nothing
, format : Fasta, genotype : Nothing
, minDate : Nothing, maxDate : Nothing
, errors : M.empty
, db : seqs}
, db : seqs
, hostString : Nothing }
-- In order to give Seq.State an Eq instance, it must be wrapped in NewType


Expand All @@ -99,6 +102,7 @@ update (RunQuery) state = noEffects $ state { result = nubBy Seq.sta
update (NameChange ev) state = noEffects $ state { name = strToMaybe ev.target.value }
update (CountryChange ev) state = noEffects $ state { country = strToMaybe ev.target.value }
update (HostChange ev) state = noEffects $ state { host = Seq.readHost ev.target.value }
update (HostStringChange ev) state = noEffects $ state { hostString = strToMaybe ev.target.value }
update (SerotypeChange ev) state = noEffects $ state { serotype = Seq.readSerotype ev.target.value }
update (GenotypeChange ev) state = noEffects $ state { genotype = Seq.readGenotype ev.target.value }
update (SegmentChange ev) state = noEffects $ state { segment = Seq.readSegment ev.target.value }
Expand Down Expand Up @@ -143,24 +147,24 @@ strInt k state ev f g z = if (ev.target.value == "") then (f z) else withError (
withError f k Nothing state = state { errors = (M.insert k (k <> " must be a number.") state.errors ) }
withError f k (Just x) state = (f x) { errors = (M.delete k state.errors) }

makeInput :: forall a. String -> (State -> Maybe String) -> (Seq.State -> String) ->
(FormEvent -> Action) -> State -> (Html Action)
makeInput name stateAttr dbAttr action state = label [] [ text (name ++ ":")
, input [ type_ "text"
, value $ fromMaybe "" (stateAttr state)
, onChange action
, At.list name ] []
, autoCompleteList name $ map dbAttr state.db ]
view :: State -> Html Action
view state = div []
[form
[ name "Search"
, onSubmit (const RunQuery)
]
[ label [] [ text "Name:"], input [ type_ "text"
, value $ fromMaybe "" state.name
, onChange NameChange
, At.list "nameList" ] []
, autoCompleteList "nameList" $ map _.name state.db
, label [] [ text "Country:"], input
[ type_ "text"
, value $ fromMaybe "" state.country
, onChange CountryChange
, At.list "countryList" ] []
, autoCompleteList "countryList" $ map _.country state.db
[makeInput "Name" _.name _.name NameChange state
, makeInput "Country" _.country _.country CountryChange state
, br [] []
, makeInput "Host" _.hostString _.hostString HostStringChange state
, label [] [ text "Host Species:"], select [value $ fromMaybe "Any" $ show <$> state.host, onChange HostChange ] (toOptions [Seq.Human, Seq.Mosquito])
, label [] [ text "Segment (optional):"], select [value $ fromMaybe "Any" $ show <$> state.segment, onChange SegmentChange ] (toOptions Seq.segments)
, label [] [ text "Serotype:"], select [value $ fromMaybe "Any" $ show <$> state.serotype, onChange SerotypeChange] (toOptions Seq.serotypes), br [] []
Expand Down Expand Up @@ -189,7 +193,7 @@ view state = div []
, option [value "Fasta"] [text "Fasta"]], br [] []
, div [] $ toArray $ map (\x -> font [size 3, color "red"] [text $ x, br [] [] ]) (M.values state.errors) ]

autoCompleteList id' xs = H.datalist [At.id_ id'] $ toArray $ map (\x -> H.option [At.label x, At.value x] []) xs
autoCompleteList id' xs = H.datalist [At.id_ id'] $ toArray $ map (\x -> H.option [At.label x, At.value x] []) $ A.nub xs

toArray xs = foldr (:) [] xs
toOptions xs = [(option [value "Any"] [text "Any"])] <> (map (\x -> option [value $ show x] [ text $ show x]) xs)
Expand Down Expand Up @@ -234,6 +238,10 @@ example = {
, segment : Nothing
, checked : false
, genotype : Nothing
, month : Nothing
, day : Nothing
, hostString : "Foohhost"
, date : fromJust $ Date.fromString "08/12/12"
}

example2 :: Seq.State
Expand All @@ -248,15 +256,23 @@ example2 = {
, segment : Nothing
, checked : false
, genotype : Nothing
, month : Nothing
, day : Nothing
, hostString : "Foohhost"
, date : fromJust $ Date.fromString "08/12/12"
}

example3 :: Seq.State
example3 = {
name : "Influenza99"
, acc : "Acc"
, year : 1999
, month : Nothing
, day : Nothing
, date : fromJust $ Date.fromString "08/12/12"
, country : "USA"
, host : Seq.Human
, hostString : "Foohhost"
, serotype : Seq.HN1
, sequence : "GGGGG"
, segment : Just Seq.PB1
Expand Down
87 changes: 62 additions & 25 deletions src/Seq.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,15 @@ import Control.Monad.Eff.Exception.Unsafe (unsafeThrow)
import Data.Array.Unsafe (last)
import Data.Array (zip)
import Data.String (split)
import Data.Traversable (sequence)
import Data.Date as Date
import Data.Either
import App.Routes (Route(Home, NotFound))
import Pux.Html (Html, div, p, text, table, tr, td, input)
import Pux.Html.Attributes (className, checked, value, type_)
import Prelude --(id, const, ($), show, (<>), (<$>), Eq, (==), (&&), not, (<<<), map, Show)
import Pux.Html.Events (onClick)
import Data.Foldable (Foldable)
import Data.Foldable (Foldable, intercalate)
import Data.Generic
import Data.Maybe (Maybe, fromMaybe)
--import Text.Parsing.CSV (defaultParsers, makeParsers)
Expand Down Expand Up @@ -82,46 +85,80 @@ type Year = Int
type State = {
name :: String
, acc :: String
, year :: Year
, country :: String
, host :: Host
, serotype :: Serotype
, sequence :: String
, segment :: Maybe Segment
, genotype :: Maybe Genotype
, sequence :: String
, hostString :: String
, checked :: Boolean
, date :: Date.Date
, month :: Maybe Int
, year :: Int
, day :: Maybe Int
}

--columns = map fst [("name", id') , ("acc", id') , ("country", id') , ("year", Int.fromString) , ("host", readHost) , ("seortype", readSegment) , ("segment", maybe' readSegment) , ("genotype", maybe' readGenotype)]

-- TODO: include Dates
toEither _ (Just x) = Right x
toEither z Nothing = Left z

columns :: Array String
columns = ["name", "acc", "country", "year", "host", "serotype", "segment", "genotype"]
columns = ["name", "acc", "country", "year", "host", "serotype", "segment", "genotype", "month", "day", "sequence"]
-- applyRow row = zipWith ($) funcs row
-- funcs = map snd $ A.sortBy headerOrder columns
readCSV :: String -> String -> Maybe (Array State)
readCSV sep s = process <$> (A.head lines') <*> (A.tail lines')
--readCSV :: String -> String -> Maybe (Array State)
readCSV :: String -> String -> Either Error (Array State)
--readCSV sep s = process <$> (toEither "no head" $ A.head lines') <*> (toEither "no tail" $ A.tail lines')
readCSV sep s = do
head <- (toEither "no head" $ A.head lines')
rows <- (toEither "no tail" $ A.tail lines')
process head rows
where
lines' = map (S.split sep) $ lines s
lines = S.split "\n"

process :: Array String -> Array (Array String) -> Array State
process header rows = map process' rows

type Error = String
process :: Array String -> Array (Array String) -> Either Error (Array State)
process header rows = sequence $ map process' rows
where
process' :: Array String -> State
process' row = {
name : (row `at` 0)
, acc : (row `at` 1)
, country : (row `at` 2)
, year : fromMaybe 0 $ Int.fromString (row `at` 3)
, host : fromMaybe Human $ readHost (row `at` 3)
, serotype : fromMaybe DENV4 $ readSerotype (row `at` 4)
, segment : readSegment (row `at` 5)
, genotype : readGenotype (row `at` 6)
, checked : false
, sequence : "DummySeq"
}
where at = unsafeIndex
--process' row | (A.length row) < (A.length columns) = Left ("Row not have expected length " ++ (show $ A.length columns) ++ " found length " ++ (show $ A.length row) )
process' :: Array String -> Either Error State
process' row = do
name <- Right $ row `at` "name"
acc <- Right $ row `at` "acc"
country <- Right $ row `at` "country"
year <- toEither "bad year" $ Int.fromString (row `at` "year")
host <- toEither "Bad host" $ readHost (row `at` "host")
serotype <- toEither "Bad serotype" $ readSerotype (row `at` "serotype")
let hostString = (row `at` "host")
let segment = readSegment $ (row `at` "segement")
let genotype = readGenotype $ (row `at` "genotype")
let month = (Int.fromString (row `at` "month"))
let day = Int.fromString (row `at` "day")
sequence' <- Right $ row `at` "sequence"
date <- toEither "bad date parse" $ Date.fromString ((show year) ++ "/" ++ (fromMaybe "6" $ show <$> month) ++ "/" ++ (fromMaybe "15" $ show <$> day))
pure { name : name
, acc : acc
, country : country
, date : date
, host : host
, serotype : serotype
, segment : segment
, genotype : genotype
, sequence : sequence'
, checked : false
, month : month
, year : year
, day : day
, hostString : hostString
}
where
at xs col = fromMaybe ("Bad column " ++ col ) $ do
i <- A.elemIndex col header
xs A.!! i
order row = A.sortBy headerOrder row
headerOrder x y = compare (fromMaybe 9999 (A.elemIndex x header)) (fromMaybe 9999 (A.elemIndex y header))

Expand All @@ -148,7 +185,7 @@ view state = table []
[input [type_ "checkbox", checked state.checked, value "selected" , onClick $ const ToggleCheck] [] ]
, td [className "name"] [ text $ "Name: " <> state.name ]
, td [className "acc"] [ text $ "Accession: " <> state.acc ]
, td [className "year"] [ text $ "Year: " <> show state.year ]
, td [className "date"] [ text $ "Date: " <> dateString state]
, td [className "country"] [ text $ "Country: " <> state.country ] ]
, tr [] [ td [] [ text $ "Host: " <> show state.host ]
, td [] [ text $ "Serotype: " <> show state.serotype ]
Expand All @@ -158,7 +195,7 @@ view state = table []
update :: Action -> State -> State
update ToggleCheck state = state { checked = not state.checked }
update _ state = state

dateString state = intercalate "/" [(fromMaybe "?" $ show <$> state.month), (fromMaybe "?" $ show <$> state.day), (show state.year)]
init :: State -> State
init = id

Expand Down

0 comments on commit 3770683

Please sign in to comment.