PU2: Current date

Signed-off-by: Skyball2000 <thomas3654william@gmail.com>

aufgaben/src/Date.elm

@@ -1,94 +1,203 @@
 module Date exposing (..)
 
+import String exposing (fromInt)
+
+type Weekday
+    = Mon
+    | Tue
+    | Wed
+    | Thu
+    | Fri
+    | Sat
+    | Sun
+
+
 type alias Day =
     Int
 
+
 type alias Month =
     Int
 
+
 type alias Year =
     Int
 
+
 type alias Date =
     ( Day, Month, Year )
 
 
--- 1 Punkt:
 year : Date -> Year
-year (_, _, c) = c
+year ( _, _, y ) =
+    y
+
+
 month : Date -> Month
-month (_, b, _) = b
+month ( _, m, _ ) =
+    m
+
+
 day : Date -> Day
-day (a, _, _) = a
+day ( d, _, _ ) =
+    d
+
 
--- 1 Punkt:
 lt : Date -> Date -> Bool
-lt date1 date2 =
+lt ( d1, m1, y1 ) ( d2, m2, y2 ) =
-    let (d1, m1, y1) = date1
+    (y1 < y2) || (y1 == y2 && m1 < m2) || (y1 == y2 && m1 == m2 && d1 < d2)
-        (d2, m2, y2) = date2
+
-    in y1 < y2 || (y1 == y2 && (m1 < m2 || (m1 == m2 && d1 < d2)))
+
 eq : Date -> Date -> Bool
-eq date1 date2 =
+eq ( d1, m1, y1 ) ( d2, m2, y2 ) =
-    let (d1, m1, y1) = date1
+    y1 == y2 && m1 == m2 && d1 == d2
-        (d2, m2, y2) = date2
+
-    in y1 == y2 && m1 == m2 && d1 == d2
+
 gt : Date -> Date -> Bool
-gt date1 date2 =
+gt ( d1, m1, y1 ) ( d2, m2, y2 ) =
-    let (d1, m1, y1) = date1
+    (y1 > y2) || (y1 == y2 && m1 > m2) || (y1 == y2 && m1 == m2 && d1 > d2)
-        (d2, m2, y2) = date2
+
-    in y1 > y2 || (y1 == y2 && (m1 > m2 || (m1 == m2 && d1 > d2)))
 
--- 1 Punkt:
 toString : Date -> String
-toString (a,b,c) = (if a < 10 then "0" ++ String.fromInt(a) else String.fromInt(a)) ++ "."
+toString ( d, m, y ) =
-                    ++ (if b < 10 then "0" ++ String.fromInt(b) else String.fromInt(b)) ++ "."
+    let
-                    ++ (if c < 10 then  "000" ++ String.fromInt(c)
+        d0 =
-                    else if c < 100 then  "00" ++ String.fromInt(c)
+            if (d // 10) == 0 then
-                    else if   c < 1000 then  "0" ++ String.fromInt(c)
+                "0"
-                    else String.fromInt(c))
 
-
--- https://web.archive.org/web/20170507133619/https://alcor.concordia.ca/~gpkatch/gdate-algorithm.html
-
-convertDateToDayNumber : Date -> Int
-convertDateToDayNumber (a, b, c) =
-    let m = (modBy 12 (b + 9))
-        y = c - m // 10
-    in 365 * y + y // 4 - y // 100 + y // 400 + (m * 306 + 5) // 10 + ( a - 1 )
-
-convertDayNumberToDate : Int -> Date
-convertDayNumberToDate g =
-    let y = (10000 * g + 14780) // 3652425
-        ddd = g - (365 * y + y // 4 - y // 100 + y // 400)
-    in
-        if (ddd < 0) then
-            let y2 = y - 1 -- y = y2
-                ddd2 = g - (365 * y2 + y2 // 4 - y2 // 100 + y2 // 400)  -- ddd = ddd2
-                mi = (100 * ddd2 + 52) // 3060
-                mm = (modBy (12) (mi + 2)) + 1
-                y3 = y2 + (mi + 2) // 12  -- y = y3
-                dd = ddd2 - (mi * 306 + 5) // 10 + 1
-            in (dd, mm, y3)
             else
-            let mi = (100 * ddd + 52) // 3060
+                ""
-                mm = (modBy (12) (mi + 2)) + 1
-                y2 = y + (mi + 2) // 12  -- y = y2
-                dd = ddd - (mi * 306 + 5) // 10 + 1
-            in (dd, mm, y2)
 
--- 1 Punkt:
+        m0 =
-leapyear : Year -> Bool
+            if (m // 10) == 0 then
-leapyear y = ((modBy 4 y == 0) && (modBy 100 y /= 0)) || (modBy 400 y == 0)
+                "0"
+
+            else
+                ""
+    in
+    d0 ++ fromInt d ++ "." ++ m0 ++ fromInt m ++ "." ++ fromInt y
 
 
--- 2 Punkte:
 next : Date -> Date
-next date = convertDayNumberToDate ((convertDateToDayNumber date) + 1)
+next ( d, m, y ) =
+    case ( d, m, y ) of
+        ( 31, 12, _ ) ->
+            ( 1, 1, y + 1 )
+
+        ( 30, 11, _ ) ->
+            ( 1, 12, y )
+
+        ( 31, 10, _ ) ->
+            ( 1, 11, y )
+
+        ( 30, 9, _ ) ->
+            ( 1, 10, y )
+
+        ( 31, 8, _ ) ->
+            ( 1, 9, y )
+
+        ( 31, 7, _ ) ->
+            ( 1, 8, y )
+
+        ( 30, 6, _ ) ->
+            ( 1, 7, y )
+
+        ( 31, 5, _ ) ->
+            ( 1, 6, y )
+
+        ( 30, 4, _ ) ->
+            ( 1, 5, y )
+
+        ( 31, 3, _ ) ->
+            ( 1, 4, y )
+
+        ( 29, 2, _ ) ->
+            ( 1, 3, y )
+
+        ( 28, 2, _ ) ->
+            if leapyear y then
+                ( 29, 2, y )
+
+            else
+                ( 1, 3, y )
+
+        ( 31, 1, _ ) ->
+            ( 1, 2, y )
+
+        _ ->
+            ( d + 1, m, y )
+
 
--- 2 Punkte:
 prev : Date -> Date
-prev date = convertDayNumberToDate ((convertDateToDayNumber date) - 1)
+prev ( d, m, y ) =
+    case ( d, m, y ) of
+        ( 1, 12, _ ) ->
+            ( 30, 11, y )
+
+        ( 1, 11, _ ) ->
+            ( 31, 10, y )
+
+        ( 1, 10, _ ) ->
+            ( 30, 9, y )
+
+        ( 1, 9, _ ) ->
+            ( 31, 8, y )
+
+        ( 1, 8, _ ) ->
+            ( 31, 7, y )
+
+        ( 1, 7, _ ) ->
+            ( 30, 6, y )
+
+        ( 1, 6, _ ) ->
+            ( 31, 5, y )
+
+        ( 1, 5, _ ) ->
+            ( 30, 4, y )
+
+        ( 1, 4, _ ) ->
+            ( 31, 3, y )
+
+        ( 1, 3, _ ) ->
+            if leapyear y then
+                ( 29, 2, y )
+
+            else
+                ( 28, 2, y )
+
+        ( 1, 2, _ ) ->
+            ( 31, 1, y )
+
+        ( 1, 1, _ ) ->
+            ( 31, 12, y - 1 )
+
+        _ ->
+            ( d - 1, m, y )
+
+
+leapyear : Year -> Bool
+leapyear y =
+    (modBy 4 y == 0) && ((modBy 100 y /= 0) || (modBy 400 y == 0))
+
 
--- 2 Punkte:
 sub : Date -> Date -> Int
-sub date1 date2 = convertDateToDayNumber date1 - convertDateToDayNumber date2
+sub d1 d2 =
+    subHelp 0 d1 d2
+
+
+
+{- um optimierbare End-Rekursion zu erreichen: Akkumulator als Argument -}
+
+
+subHelp : Int -> Date -> Date -> Int
+subHelp diff d1 d2 =
+    if gt d1 d2 then
+        subHelp (diff + 1) d1 (next d2)
+
+    else if lt d1 d2 then
+        subHelp (diff - 1) d1 (prev d2)
+
+    else
+        diff
+
+

aufgaben/src/Main.elm

@@ -1,41 +1,213 @@
-module Main exposing (main)
+module Main exposing (..)
 
+import Html exposing (..)
+import Html.Attributes exposing (..)
 import Browser
-import Html exposing (Html, button, div, text)
+import Html.Events exposing (..)
-import Html.Events exposing (onClick)
+import List
+
+import Date exposing (..)
+import String
 
 
--- MAIN
+type alias Model =
-main = Browser.sandbox { init = init, update = update, view = view }
+    {
+    arbeit : Arbeit
+    , beginndatum : Date
+    , besprechungsWochentag : Weekday
+    , anzahlWochenZwischenBesprechung : Int
+    }
+
+
+type Msg
+    = SetStartDate String
+    | SetInterval String
+    | SetDegree String
+    | SetBesprechundsWochentag String
+
+type Arbeit
+    = Bachelor
+    | Master
+
+initModel : Model
+initModel  =
+    {
+    arbeit = Bachelor
+    , beginndatum = (21, 12, 2022)
+    , besprechungsWochentag = Mon
+    , anzahlWochenZwischenBesprechung = 1
+    }
+
+getWeekday : Date -> Weekday
+getWeekday date =
+        addWeekdays (Date.sub date (21, 12, 2022)) Wed
+
+addWeekdays : Int -> Weekday -> Weekday
+addWeekdays count day =
+    if count < 0
+    then
+    case count of
+        0 -> day
+        _ -> addWeekdays (count + 1) (prevWeekDay day)
+    else
+    if count == 0
+    then
+    case count of
+        0 -> day
+        _ -> addWeekdays (count - 1) (nextWeekDay day)
+    else day
+
+nextWeekDay : Weekday -> Weekday
+nextWeekDay day =
+    case day of
+        Mon -> Tue
+        Tue -> Wed
+        Wed -> Thu
+        Thu -> Fri
+        Fri -> Sat
+        Sat -> Sun
+        Sun -> Mon
+
+prevWeekDay : Weekday -> Weekday
+prevWeekDay day =
+    case day of
+        Mon -> Tue
+        Tue -> Wed
+        Wed -> Thu
+        Thu -> Fri
+        Fri -> Sat
+        Sat -> Sun
+        Sun -> Mon
+
+getMonthLength : Date -> Int
+getMonthLength date =
+    case Date.month date of
+        1 -> 31
+        2 -> if Date.leapyear (Date.year date) then 28 else 29
+        3 -> 31
+        4 -> 30
+        5 -> 31
+        6 -> 30
+        7 -> 31
+        8 -> 31
+        9 -> 30
+        10 -> 31
+        11 -> 30
+        12 -> 31
+        _ -> 30
+
+
+addMonths : Int -> Date -> Date
+addMonths count date =
+    if count > 0
+    then addMonths (count - 1) (addDays (getMonthLength date) date)
+    else date
+
+addDays : Int -> Date -> Date
+addDays count date =
+    if count > 0
+    then addDays (count - 1) (Date.next date)
+    else date
+
+addMonthsLiterally : Int -> Date -> Date
+addMonthsLiterally count date =
+    let newMonth = (Date.month date) + count
+        newDate = (Date.day date, if newMonth > 12 then (modBy newMonth 12) else newMonth, if newMonth > 12 then (Date.year date) + 1 else Date.year date)
+        newDateMonthLength = getMonthLength newDate
+    in (Date.day date, newMonth, Date.year date)
+    {-in if Date.day newDate > newDateMonthLength then (Date.day date, newDateMonthLength, Date.year date) else newDate-}
+
+calculateAbgabeEndDate : Arbeit -> Date -> Date
+calculateAbgabeEndDate arbeit date =
+    case arbeit of
+        Bachelor -> Date.prev (addMonthsLiterally 3 date)
+        Master -> Date.prev (addMonthsLiterally 6 date)
+
+validiereModel : Model -> Result String String
+validiereModel model =
+    case model.besprechungsWochentag of
+        Sat -> Err "Datum darf kein Samstag sein"
+        Sun -> Err "Datum darf kein Sonntag sein"
+        _ -> Ok "Alles klärchen"
 
 
 
--- MODEL
+berechneDaten : Model -> List String
-type alias Model = Int
+berechneDaten model = [] {- TODO -}
-
-init : Model
-init =
-  0
-
-
--- UPDATE
-type Msg = Increment | Decrement
 
 update : Msg -> Model -> Model
 update msg model =
     case msg of
-    Increment ->
+        SetStartDate date ->
-      model + 1
+            {model | beginndatum = (
-
+                case (String.split " " date) of
-    Decrement ->
+                    ["asap"] -> (21, 12, 2022) {- TODO -}
-      model - 1
+                    ["ASAP"] -> (21, 12, 2022) {- TODO -}
+                    [d, m, y] -> case [String.toInt d, String.toInt m, String.toInt y] of
+                                    [Just a, Just b, Just c] -> (a, b, c)
+                                    _ -> (21, 12, 2022)
+                    _ ->(21, 12, 2022)
+            ) }
+        SetDegree arbeits ->
+            if arbeits == "Bachelor" then
+                {model | arbeit = Bachelor }
+            else
+                {model | arbeit = Master }
+        SetInterval str ->
+            {model | anzahlWochenZwischenBesprechung = String.toInt str |> Maybe.withDefault 0}
+        SetBesprechundsWochentag weekday ->
+            {model | besprechungsWochentag = case weekday of
+                                                "Montag" -> Mon
+                                                "Dienstag" -> Tue
+                                                "Mittwoch" -> Wed
+                                                "Donnerstag" -> Thu
+                                                "Freitag" -> Fri
+                                                _ -> Mon
+            }
+
 
 
--- VIEW
 view : Model -> Html Msg
 view model =
     div []
-    [ button [ onClick Decrement ] [ text "-" ]
+    [
-    , div [] [ text (String.fromInt model) ]
+    select [onInput SetDegree]
-    , button [ onClick Increment ] [ text "+" ]
+    [
+        option [value "Bachelor"] [text "Bachelor"]
+        , option [value "Master"] [text "Master"]
     ]
+    , input [onInput SetStartDate, placeholder "21 12 2022"] []
+    , select [onInput SetBesprechundsWochentag]
+    [
+          option [value "Montag"] [text "Montag"]
+        , option [value "Dienstag"] [text "Dienstag"]
+        , option [value "Mittwoch"] [text "Mittwoch"]
+        , option [value "Donnerstag"] [text "Donnerstag"]
+        , option [value "Freitag"] [text "Freitag"]
+    ]
+    , select [onInput SetInterval]
+    [
+              option [value "1"] [text "1 Woche"]
+            , option [value "2"] [text "2 Wochen"]
+            , option [value "3"] [text "3 Wochen"]
+            , option [value "4"] [text "4 Wochen"]
+
+    ]
+    , br [] []
+    , ul []
+        (model
+        |> berechneDaten
+        |> List.map (\datum -> li [] [text datum]))
+    , text (Debug.toString model.besprechungsWochentag), br[][]
+    , text (Debug.toString model.beginndatum), br[][]
+    , text (Debug.toString model.arbeit), br[][]
+    , text (Debug.toString model.anzahlWochenZwischenBesprechung), br[][]
+    , text (Debug.toString (getWeekday model.beginndatum)), br[][]
+    , text (Debug.toString (calculateAbgabeEndDate Bachelor model.beginndatum)), br[][]
+    , text (Debug.toString (calculateAbgabeEndDate Master model.beginndatum)), br[][]
+    , text (Debug.toString (getMonthLength model.beginndatum)), br[][]
+    , text (Debug.toString (Date.sub model.beginndatum (21, 12, 2022))), br[][]
+    ]
+
+
+main = Browser.sandbox { init = initModel, update = update, view = view }

pu2/elm.json

@@ -8,11 +8,11 @@
         "direct": {
             "elm/browser": "1.0.2",
             "elm/core": "1.0.5",
-            "elm/html": "1.0.0"
+            "elm/html": "1.0.0",
+            "elm/time": "1.0.0"
         },
         "indirect": {
             "elm/json": "1.1.3",
-            "elm/time": "1.0.0",
             "elm/url": "1.0.0",
             "elm/virtual-dom": "1.0.3"
         }

pu2/src/Main.elm

@@ -5,9 +5,11 @@ import Html.Attributes exposing (..)
 import Browser
 import Html.Events exposing (..)
 import List
+import String
+import Task exposing (..)
+import Time exposing (Posix)
 
 import Date exposing (..)
-import String
 
 
 type alias Model =
@@ -16,6 +18,8 @@ type alias Model =
     , beginndatum : Date
     , besprechungsWochentag : Weekday
     , anzahlWochenZwischenBesprechung : Int
+    , zone : Time.Zone
+    , time : Time.Posix
     }
 
 
@@ -24,19 +28,38 @@ type Msg
     | SetInterval String
     | SetDegree String
     | SetBesprechundsWochentag String
+    | Tick Posix
+    | AdjustTimeZone Time.Zone
 
 type Arbeit
     = Bachelor
     | Master
 
-initModel : Model
+init : () -> (Model, Cmd Msg)
-initModel  =
+init _ = (
     {
         arbeit = Bachelor
         , beginndatum = (21, 12, 2022)
         , besprechungsWochentag = Mon
         , anzahlWochenZwischenBesprechung = 1
-    }
+        , zone = Time.utc
+        , time = Time.millisToPosix 0
+    } , Task.perform AdjustTimeZone Time.here
+    )
+
+{- not for actual solution requested -}
+addMonths : Int -> Date -> Date
+addMonths count date =
+    if count > 0
+    then addMonths (count - 1) (addDays (getMonthLength date) date)
+    else date
+
+addDays : Int -> Date -> Date
+addDays count date =
+    if count > 0
+    then addDays (count - 1) (Date.next date)
+    else date
+{- end -}
 
 getWeekday : Date -> Weekday
 getWeekday date =
@@ -96,19 +119,6 @@ getMonthLength date =
         12 -> 31
         _ -> 30
 
-
-addMonths : Int -> Date -> Date
-addMonths count date =
-    if count > 0
-    then addMonths (count - 1) (addDays (getMonthLength date) date)
-    else date
-
-addDays : Int -> Date -> Date
-addDays count date =
-    if count > 0
-    then addDays (count - 1) (Date.next date)
-    else date
-
 addMonthsLiterally : Int -> Date -> Date
 addMonthsLiterally count date =
     let newMonth = (Date.month date) + count
@@ -122,6 +132,7 @@ calculateAbgabeEndDate arbeit date =
         Bachelor -> Date.prev (addMonthsLiterally 3 date)
         Master -> Date.prev (addMonthsLiterally 6 date)
 
+
 validiereModel : Model -> Result String String
 validiereModel model =
     case model.besprechungsWochentag of
@@ -132,24 +143,50 @@ validiereModel model =
 berechneDaten : Model -> List String
 berechneDaten model = [] {- TODO -}
 
-update : Msg -> Model -> Model
+monthToIndex : Time.Month -> Int
+monthToIndex month =
+    case month of
+        Time.Jan -> 1
+        Time.Feb -> 2
+        Time.Mar -> 3
+        Time.Apr -> 4
+        Time.May -> 5
+        Time.Jun -> 6
+        Time.Jul -> 7
+        Time.Aug -> 8
+        Time.Sep -> 9
+        Time.Oct -> 10
+        Time.Nov -> 11
+        Time.Dec -> 12
+
+getCurrentDate : Model -> Date
+getCurrentDate model =
+    let date = Time.now
+    in
+        (
+          Time.toDay model.zone model.time
+        , monthToIndex (Time.toMonth model.zone model.time)
+        , Time.toYear model.zone model.time
+        )
+
+update : Msg -> Model -> (Model, Cmd Msg)
 update msg model =
-    case msg of
+    (case msg of
         SetStartDate date ->
             {model | beginndatum = (
                 case (String.split " " date) of
-                    ["asap"] -> (21, 12, 2022) {- TODO -}
+                    ["asap"] -> getCurrentDate model
-                    ["ASAP"] -> (21, 12, 2022) {- TODO -}
+                    ["ASAP"] -> getCurrentDate model
                     [d, m, y] -> case [String.toInt d, String.toInt m, String.toInt y] of
                                     [Just a, Just b, Just c] -> (a, b, c)
                                     _ -> (21, 12, 2022)
                     _ ->(21, 12, 2022)
             ) }
         SetDegree arbeits ->
-            if arbeits == "Bachelor" then
+            case arbeits of
-                {model | arbeit = Bachelor }
+                "Bachelor" -> {model | arbeit = Bachelor}
-            else
+                "Master" -> {model | arbeit = Master}
-                {model | arbeit = Master }
+                _ -> model
         SetInterval str ->
             {model | anzahlWochenZwischenBesprechung = String.toInt str |> Maybe.withDefault 0}
         SetBesprechundsWochentag weekday ->
@@ -161,6 +198,9 @@ update msg model =
                                                 "Freitag" -> Fri
                                                 _ -> Mon
             }
+        Tick newTime -> { model | time = newTime }
+        AdjustTimeZone newZone -> { model | zone = newZone }
+    , Cmd.none)
 
 
 
@@ -206,5 +246,13 @@ view model =
     , text (Debug.toString (Date.sub model.beginndatum (21, 12, 2022))), br[][]
     ]
 
+subscriptions : Model -> Sub Msg
+subscriptions model =
+  Time.every 1000 Tick
 
-main = Browser.sandbox { init = initModel, update = update, view = view }
+main = Browser.element {
+          init = init
+        , update = update
+        , view = view
+        , subscriptions = subscriptions
+    }